#!/usr/bin/perl -w
# After PPM downloads and installs the contents of blib, this script
# prompts the user for the location of htdocs, conf, and cgi-bin
# and installs them.
use strict;
use Config;
use LWP::Simple;
use PPM::Archive;
use File::Basename 'dirname';
use ExtUtils::MakeMaker 'prompt'; # love it!
use constant SUPPORT_FILES => 'gbrowse_ppm_support_files-2.00pre1.tar.gz';
use constant PPM_REPOSITORY => 'http://www.gmod.org/ggb/ppm';
my $startperl = $Config{startperl} ne '#!perl'
? $Config{startperl}
: "#!$Config{perlpath}";
# fetch the support files
print "Fetching GBrowse support files...\n";
my $file = SUPPORT_FILES;
my $url = join '/',PPM_REPOSITORY,SUPPORT_FILES;
my $rc = mirror($url,$file);
if (is_error($rc)) {
die "Sorry, couldn't fetch $file from ",PPM_REPOSITORY,". HTTP code: $rc.\n";
}
# unpack them
print "Unpacking support files...\n";
my $a = PPM::Archive->new($file);
my @files = $a->list_files;
foreach (@files) {
$a->extract($_);
}
undef $a;
die "Unexpected error. There should be an install_util directory here, but there isn't!\n" unless -d "install_util";
eval <<'END'
use lib './install_util';
use GBrowseGuessDirectories;
END
;
# now we get to prompt the user endlessly for the pathnames
print STDERR "\n** Installing GBrowse CGI and config files **\n";
print STDERR "** Please indicate the location of the following Web Server directories:\n";
my $prefix = $^O =~ /mswin/i ? 'C:/Program Files/Apache Group/Apache2'
: '/usr/local/apache';
my $conf = prompt_for_directory('conf', GBrowseGuessDirectories->conf || "$prefix/conf");
$prefix = dirname($conf); # update
my $htdocs = prompt_for_directory('htdocs', GBrowseGuessDirectories->htdocs || "$prefix/htdocs");
my $cgibin = prompt_for_directory('cgi-bin',GBrowseGuessDirectories->cgibin || "$prefix/cgi-bin");
fixup($_,"$conf/gbrowse.conf") foreach grep {-T} @files;
my @args = (
"'APACHE=$prefix'",
"'CGIBIN=$cgibin'",
"'CONF=$conf'",
"'HTDOCS=$htdocs'"
);
for my $inst ("cgi_install.pl","htdocs_install.pl","conf_install.pl") {
system("perl","install_util/$inst",@args); #==0
# or die "The install script, $inst, failed. I don't know why\n";;
}
print STDERR "\n** GBrowse installation complete.\n";
print STDERR "** Now go to http://your.server/gbrowse for further setup instructions.\n";
exit 0;
sub prompt_for_directory {
my ($prompt,$default) = @_;
my $dir;
while (!$dir) {
$dir = prompt("\t\"$prompt\" directory ([q]uit)",$default);
if ($dir eq 'q') {
print STDERR "ABORTED: your installation is NOT complete\n\n";
exit 0;
}
$dir = interpolate($dir);
if (!-d $dir) {
print STDERR "$dir doesn't exist. Please try again.\n";
redo;
} elsif (!-w $dir) {
print STDERR "warning: $dir isn't writable. Installation may fail.\n";
}
}
return $dir;
}
sub interpolate {
my $path = shift;
my ($to_expand,$homedir);
return $path unless $path =~ m!^~([^/]*)!;
eval {
if ($to_expand = $1) {
$homedir = (getpwnam($to_expand))[7];
} else {
$homedir = (getpwuid($<))[7];
}
return $path unless $homedir;
$path =~ s!^~[^/]*!$homedir!;
};
return $path;
}
# horrible -- fix line endings for proper architecture
sub fixup {
my $file = shift;
my $conf = shift;
return unless -f $file;
local $/ = "\012";
open F,$file or die "Can't open $file: $!";
open OUT,">$file.new" or die "Can't open $file.new: $!";
while (<F>) {
chomp;
s/^\#!.+/$startperl -w/;
s/^\$CONF_DIR\s*=\s*\'.+/\$CONF_DIR = '$conf';/;
print OUT $_,"\n";
}
close F;
close OUT;
rename "$file.new",$file;
}