Permalink
Browse files

fixed windows update script

  • Loading branch information...
lstein committed Mar 23, 2007
1 parent 7c5bc6b commit 7cfd6454b9a0b87d33c8f82322b8197eafdb60db
Showing with 238 additions and 123 deletions.
  1. +6 −1 Makefile.PL
  2. +186 −112 bin/windows_install.pl
  3. +23 −6 cgi-bin/das.PLS
  4. +1 −1 docs/pod/CONFIGURE_HOWTO.pod
  5. +9 −0 docs/pod/DAS_HOWTO.pod
  6. +7 −2 docs/tutorial/tutorial.html
  7. +6 −1 lib/Bio/Graphics/Browser/Util.pm
View
@@ -265,7 +265,6 @@ sub biographics_patch_version {
return 1.654; # what is in bioperl 1.5.2
}
sub interpolate {
my $path = shift;
my ($to_expand,$homedir);
@@ -283,6 +282,12 @@ sub interpolate {
return $path;
}
sub MY::dist {
package MY;
my $inherited = shift->SUPER::dist(@_);
$inherited;
}
sub MY::clean {
package MY;
my $inherited = shift->SUPER::clean(@_);
View
@@ -1,112 +1,186 @@
#!/usr/bin/perl
# This script should do a Windows install from the command line.
use warnings;
use strict;
use Config;
use File::Temp qw(tempdir);
use LWP::Simple;
use Archive::Zip ':ERROR_CODES';
use Archive::Tar;
use File::Copy 'cp';
use CPAN '!get';
use constant GBROWSE=>'http://gmod.cshl.edu/Generic-Genome-Browser-1.66.tar.gz';
#use constant BIOPERL=>'http://gmod.cshl.edu/bioperl-1.52.tar.gz';
use constant BIOPERL=>'http://bioperl.org/DIST/current_core_unstable.tar.gz';
use constant NMAKE =>'http://download.microsoft.com/download/vc15/patch/1.52/w95/en-us/nmake15.exe';
my $binaries = $Config{'binexp'};
my $make = $Config{'make'};
my $tmpdir = tempdir(CLEANUP=>1) or die "Could not create temporary directory: $!";
if ($Config{osname} =~ /mswin/i && !-e "$binaries/${make}.exe") {
print STDERR "Installing make utility...\n";
-w $binaries or die "$binaries directory is not writeable. Please re-login as Admin.\n";
chdir $tmpdir;
my $rc = mirror(NMAKE,"nmake.zip");
die "Could not download nmake executable from Microsoft web site."
unless $rc == RC_OK or $rc == RC_NOT_MODIFIED;
my $zip = Archive::Zip->new('nmake.zip') or die "Couldn't open nmake zip file for decompression: $!";
$zip->extractTree == AZ_OK or die "Couldn't unzip file: $!";
-e 'NMAKE.EXE' or die "Couldn't extract nmake.exe";
cp('NMAKE.EXE',"$binaries/${make}.EXE") or die "Couldn't install nmake.exe: $!";
#cp('NMAKE.ERR',"$binaries/${make}.EXE") or die "Couldn't install nmake.err: $!";
}
if ($Config{osname} =~ /mswin/i) {
unless ( eval "use GD 2.31; 1" ) {
print STDERR "Installing GD via ppm and the Theory repository at UWinnipeg;\n";
print STDERR "(This may take a while...\n";
system("ppm rep delete Theory");
system("ppm rep off 1");
system("ppm rep add Theory http://theoryx5.uwinnipeg.ca/ppms/");
system("ppm install GD");
system("ppm rep on 1");
}
}
else {
print STDERR "Installing GD via CPAN...\n";
CPAN::Shell->install('GD') unless eval "use GD 2.31; 1";
}
print STDERR "Installing other prerequisites via CPAN...\n";
CPAN::Shell->install('Module::Build');
CPAN::Shell->install('GD::SVG');
CPAN::Shell->install('IO::String');
CPAN::Shell->install('Text::Shellwords');
CPAN::Shell->install('CGI::Session');
CPAN::Shell->install('File::Temp');
CPAN::Shell->install('Class::Base');
CPAN::Shell->install('Digest::MD5');
unless (eval "use Bio::Perl 1.005002; 1") {
print STDERR "Installing BioPerl...\n";
do_install(BIOPERL,'current_core_unstable.tar.gz','bioperl-1.5.2_100','Build');
}
else {
print STDERR "BioPerl is up to date.\n";
}
print STDERR "Installing Generic-Genome-Browser...\n";
do_install(GBROWSE,'gbrowse.tgz','Generic-Genome-Browser-1.66','make');
exit 0;
sub do_install {
my ($download,$local_name,$distribution,$method) = @_;
chdir $tmpdir;
print STDERR "Downloading $download...\n";
my $rc = mirror($download,$local_name);
die "Could not download $distribution distribution from $download."
unless $rc == RC_OK or $rc == RC_NOT_MODIFIED;
print STDERR "Unpacking $local_name...\n";
my $z = Archive::Tar->new($local_name,1)
or die "Couldn't open $distribution archive: $@";
$z->extract()
or die "Couldn't extract $distribution archive: $@";
chdir $distribution
or die "Couldn't enter $distribution directory: $@";
if ($method eq 'make') {
system("perl Makefile.PL") == 0
or die "Couldn't run perl Makefile.PL command\n";
system("$make install") == 0 ;# or die "Couldn't install\n";
}
elsif ($method eq 'Build') {
system("perl Build.PL") == 0
or die "Couldn't run perl Build.PL command\n";
system("Build install") == 0;
}
}
#!/usr/bin/perl
# This script should do a Windows install from the command line.
use warnings;
use strict;
use Config;
use File::Temp qw(tempdir);
use LWP::Simple;
use Archive::Zip ':ERROR_CODES';
use Archive::Tar;
use File::Copy 'cp';
use CPAN '!get';
use constant BIOPERL_VERSION => 'bioperl-1.5.2_102';
use constant BIOPERL_REQUIRES => '1.005002'; # sorry for the redundancy
use constant GBROWSE_DEFAULT => '1.66';
use constant SOURCEFORGE_MIRROR => 'http://easynews.dl.sourceforge.net/sourceforge/gmod/';
use constant SOURCEFORGE_GBROWSE => 'http://sourceforge.net/project/showfiles.php?group_id=27707&package_id=34513';
use constant BIOPERL => 'http://bioperl.org/DIST/'.BIOPERL_VERSION.'.tar.gz';
use constant NMAKE => 'http://download.microsoft.com/download/vc15/patch/1.52/w95/en-us/nmake15.exe';
my %REPOSITORIES = ('BioPerl-Release-Candidates' => 'http://bioperl.org/DIST/RC',
'BioPerl-Regular-Releases' => 'http://bioperl.org/DIST',
'Kobes' => 'http://theoryx5.uwinnipeg.ca/ppms',
'Bribes' => 'http://www.Bribes.org/perl/ppm');
my $binaries = $Config{'binexp'};
my $make = $Config{'make'};
# this is so that ppm can be called in a pipe
$ENV{COLUMNS} = 80; # why do we have to do this?
$ENV{LINES} = 24;
my $tmpdir = tempdir(CLEANUP=>1) or die "Could not create temporary directory: $!";
my $windows = $Config{osname} =~ /mswin/i;
if ($windows && !-e "$binaries/${make}.exe") {
print STDERR "Installing make utility...\n";
-w $binaries or die "$binaries directory is not writeable. Please re-login as Admin.\n";
chdir $tmpdir;
my $rc = mirror(NMAKE,"nmake.zip");
die "Could not download nmake executable from Microsoft web site."
unless $rc == RC_OK or $rc == RC_NOT_MODIFIED;
my $zip = Archive::Zip->new('nmake.zip') or die "Couldn't open nmake zip file for decompression: $!";
$zip->extractTree == AZ_OK or die "Couldn't unzip file: $!";
-e 'NMAKE.EXE' or die "Couldn't extract nmake.exe";
cp('NMAKE.EXE',"$binaries/${make}.EXE") or die "Couldn't install nmake.exe: $!";
cp('NMAKE.ERR',"$binaries/${make}.ERR"); # or die "Couldn't install nmake.err: $!"; # not fatal
}
setup_ppm() if $windows;
unless ( eval "use GD 2.31; 1" ) {
if ($windows) {
print STDERR "Installing GD via ppm.\n";
print STDERR "(This may take a while...\n";
system("ppm install GD");
}
else {
print STDERR "Installing GD via CPAN...\n";
CPAN::Shell->install('GD') unless eval "use GD 2.31; 1";
}
}
print STDERR "Installing other prerequisites via CPAN...\n";
CPAN::Shell->install('GD::SVG');
CPAN::Shell->install('IO::String');
CPAN::Shell->install('Text::Shellwords');
CPAN::Shell->install('CGI::Session');
CPAN::Shell->install('File::Temp');
CPAN::Shell->install('Class::Base');
CPAN::Shell->install('Digest::MD5');
my $version = BIOPERL_REQUIRES;
unless (eval "use Bio::Perl $version; 1") {
print STDERR "Installing BioPerl...\n";
if ($windows) {
my $bioperl_index = find_bioperl_ppm();
system("ppm install $bioperl_index");
} else {
CPAN::SHELL->install('Module::Build');
do_install(BIOPERL,'bioperl.tgz',BIOPERL_VERSION,'Build');
}
}
else {
print STDERR "BioPerl is up to date.\n";
}
print STDERR "Installing Generic-Genome-Browser...\n";
my $latest_version = find_gbrowse_latest();
my $gbrowse = SOURCEFORGE_MIRROR.$latest_version.'.tar.gz';
do_install($gbrowse,'gbrowse.tgz',$latest_version,'make');
exit 0;
END {
open STDERR,">/dev/null"; # windows has an annoying message when cleaning up temp file
}
sub do_install {
my ($download,$local_name,$distribution,$method) = @_;
chdir $tmpdir;
print STDERR "Downloading $download...\n";
my $rc = mirror($download,$local_name);
die "Could not download $distribution distribution from $download."
unless $rc == RC_OK or $rc == RC_NOT_MODIFIED;
print STDERR "Unpacking $local_name...\n";
my $z = Archive::Tar->new($local_name,1)
or die "Couldn't open $distribution archive: $@";
$z->extract()
or die "Couldn't extract $distribution archive: $@";
chdir $distribution
or die "Couldn't enter $distribution directory: $@";
if ($method eq 'make') {
system("perl Makefile.PL") == 0
or die "Couldn't run perl Makefile.PL command\n";
system("$make install") == 0 ;# or die "Couldn't install\n";
}
elsif ($method eq 'Build') {
system("perl Build.PL") == 0
or die "Couldn't run perl Build.PL command\n";
system("Build install") == 0;
}
}
# make sure ppm repositories are correct!
sub setup_ppm {
open S,"ppm repo list --csv|" or die "Couldn't open ppm for listing: $!";
my %repository;
while (<S>) {
chomp;
my($index,$package_count,$name) = split /,/;
$repository{$name} = $index;
}
close S;
print STDERR "Adding needed PPM repositories. This may take a while....\n";
for my $name (keys %REPOSITORIES) {
next if $repository{$name};
system("ppm rep add $name $REPOSITORIES{$name}");
}
}
sub find_bioperl_ppm {
print STDERR "Finding most recent bioperl...";
open S,"ppm search bioperl |" or die "Couldn't open ppm for listing: $!";
local $/ = ''; # paragraph mode
my ($blessed_one,$blessed_version);
my $best = 0;
while (<S>) {
chomp;
my ($number) = /^(\d+): bioperl/m;
my ($version) = /^\s+Version: (.+)/m;
my ($repository) = /^\s+Repo: (.+)/m;
my $multiplier = 1000000;
my $magnitude = 0;
# this dumb thing converts 1.5.1 into a real number
foreach (split /[._]/,$version) {
$magnitude += $_ * ($multiplier/=10);
}
($blessed_one,$best,$blessed_version) = ($number,$magnitude,$version) if $best < $magnitude;
}
close S;
print STDERR $blessed_version ? "found $blessed_version\n" : "not found\n";
return $blessed_one;
}
sub find_gbrowse_latest {
print STDERR "Looking up most recent version...";
my $download_page = get(SOURCEFORGE_GBROWSE);
my @versions = sort {$b<=>$a} $download_page =~ /GBrowse-(\d+\.\d+)/g;
my $version = $versions[0] || '1.67';
print STDERR $version,"\n";
return "Generic-Genome-Browser-$version";
}
View
@@ -44,7 +44,7 @@ $startperl -w
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
#$Id: das.PLS,v 1.6.8.1.2.3 2007-03-20 23:30:51 lstein Exp $
#$Id: das.PLS,v 1.6.8.1.2.4 2007-03-23 17:02:00 lstein Exp $
use Bio::DB::GFF;
use File::Basename 'basename';
@@ -55,9 +55,9 @@ use Bio::Graphics::Browser::Util;
use Text::Shellwords;
use vars qw($DB $DSN $HEADER %ERRCODES $CONFIG
$VERSION $DAS_VERSION $CONF_DIR
%CACHED_TYPES %FORCED_GROUP);
%CACHED_TYPES %FORCED_GROUP %NO_PARENT);
#$Id: das.PLS,v 1.6.8.1.2.3 2007-03-20 23:30:51 lstein Exp $ das.PLS,v 1.32 2004/01/02 14:52:15 lstein Exp can probably be a reference server too
#$Id: das.PLS,v 1.6.8.1.2.4 2007-03-23 17:02:00 lstein Exp $ das.PLS,v 1.32 2004/01/02 14:52:15 lstein Exp can probably be a reference server too
# minimal DAS annotation/reference server
$DAS_VERSION = 'DAS/1.50';
@@ -83,6 +83,7 @@ use constant CAPABILITIES => join '; ',qw(error-segment/1.0 unknown-segment/1.0
$CONFIG = open_config($CONF_DIR) or error_header('Could not read config files'=> 500);
$HEADER = 0;
%FORCED_GROUP = ();
%NO_PARENT = ();
my ($junk,$dsn,$operation) = split '/',path_info();
$DSN = $dsn;
@@ -324,8 +325,8 @@ sub dump_segment {
if (@$filter) {
my $iterator = $seq->features(-types=>$filter,-merge=>1,-iterator=>1);
while (my $f = $iterator->next_seq) {
my @subparts = $f->get_SeqFeatures;
print_feature($f,undef,$type2category,\%agg_map); # unless @subparts;
my @subparts = $f->get_SeqFeatures;
print_feature($f,undef,$type2category,\%agg_map) unless (@subparts && no_parent_wanted($f));
my $count = 0;
print_feature($_,$f,$type2category,\%agg_map,++$count) foreach @subparts;
}
@@ -785,7 +786,7 @@ END
for my $attribute (keys %style) {
(my $name = $attribute) =~ s/^-//;
$name =~ s/\s/_/g;
next if $name =~ /glyph|category/;
next if $name =~ /glyph|category|das/;
my $value = escapeHTML($style{$attribute});
print qq( <\U$name\E>$value<\U/$name\E>\n);
}
@@ -839,6 +840,22 @@ sub forced_group {
return $FORCED_GROUP{$type} = $forced_group;
}
sub no_parent_wanted {
my $feature = shift;
return unless $feature;
my $type = $feature->type;
return $NO_PARENT{$type} if exists $NO_PARENT{$type};
my $no_parent;
my $label = $CONFIG->type2label($type);
unless ($label) {
$type =~ s/:\w+//;
$label = $CONFIG->type2label($type);
}
$no_parent = $CONFIG->setting($label => 'das flatten') ||
$CONFIG->setting('TRACK DEFAULTS' => 'das flatten') if $label;
return $NO_PARENT{$type} = $no_parent;
}
# -----------------------------------------------------------------
sub get_url {
my $url = url(-path=>1, -query=>1);
Oops, something went wrong.

0 comments on commit 7cfd645

Please sign in to comment.