GBrowse
view release on metacpan or search on metacpan
install_util/GBrowseInstall.pm view on Meta::CPAN
use IO::Dir;
use File::Compare 'compare';
use File::Copy 'copy','cp';
use GBrowseGuessDirectories;
use Carp 'cluck';
use overload '""' => 'asString',
fallback => 1;
use constant REGISTRATION_SERVER => 'http://modencode.oicr.on.ca/cgi-bin/gbrowse_registration';
my @OK_PROPS = (conf => 'Directory for GBrowse\'s config and support files?',
htdocs => 'Directory for GBrowse\'s static images & HTML files?',
tmp => 'Directory for GBrowse\'s temporary data',
persistent => 'Directory for GBrowse\'s sessions, uploaded tracks and other persistent data',
databases => 'Directory for GBrowse\'s example databases',
cgibin => 'Directory for GBrowse\'s CGI script executables?',
portdemo => 'Internet port to run demo web site on (for demo)?',
apachemodules => 'Apache loadable module directory (for demo)?',
wwwuser => 'User account under which Apache daemon runs?',
installconf => 'Automatically update Apache config files to run GBrowse?',
installetc => 'Automatically update system config files to run gbrowse-slave?',
);
my %OK_PROPS = @OK_PROPS;
# TO FIX: this contains much of the same code as in the non-demo build
# and should be refactored.
sub ACTION_demo {
my $self = shift;
$self->depends_on('config_data');
$self->depends_on('build');
my $dir = tempdir(
'GBrowse_demo_XXXX',
TMPDIR=>1,
CLEANUP=>0,
);
my $port = $self->config_data('portdemo')
|| GBrowseGuessDirectories->portdemo();
my $modules = $self->config_data('apachemodules')
|| GBrowseGuessDirectories->apachemodules;
my $db = $self->config_data('databases')
|| GBrowseGuessDirectories->databases;
my $cgiurl = $self->cgiurl;
my $persistent = $self->config_data('persistent');
mkdir "$dir/conf";
mkdir "$dir/htdocs";
mkdir "$dir/logs";
mkdir "$dir/locks";
mkdir "$dir/tmp";
# make copies of htdocs and conf
open my $saveout,">&STDOUT";
open STDOUT,">/dev/null";
my $f = IO::File->new('MANIFEST');
while (<$f>) {
chomp;
if (m!^(conf|htdocs)!) {
$self->copy_if_modified($_ => $dir);
} elsif (m!cgi-bin!) {
$self->copy_if_modified(from => $_,to_dir => "$dir/cgi-bin/gb2",flatten=>1);
chmod 0755,$_ foreach (glob "$dir/cgi-bin/gb2/*");
} elsif (m!^sample_data!) {
chdir $self->base_dir();
my ($subdir) = m!^sample_data/([^/]+)/!;
$self->copy_if_modified(from => $_,
to_dir => "$dir/htdocs/databases/$subdir",
flatten => 1,
);
}
}
close $f;
chdir $self->base_dir;
open STDOUT,"<&",$saveout;
# fix GBrowse.conf to point to correct directories
for my $f ("$dir/conf/GBrowse.conf",
"$dir/conf/yeast_simple.conf",
"$dir/conf/yeast_chr1+2.conf",
"$dir/conf/pop_demo.conf",
"$dir/conf/yeast_renderfarm.conf",
"$dir/htdocs/index.html") {
my $in = IO::File->new($f) or die "$dir/conf/$f: $!";
my $out = IO::File->new("$f.new",'>') or die $!;
while (<$in>) {
s!\$CONF!$dir/conf!g;
s!\$HTDOCS!$dir/htdocs!g;
s!\$DATABASES!$dir/htdocs/databases!g;
s!\$PERSISTENT!$dir/$persistent!g;
s!\$TMP!$dir/tmp!g;
s/\$CGIURL/$cgiurl/g;
s!\$VERSION!$self->dist_version!eg;
s/\$CAN_USER_ACCOUNTS_OPENID/$self->has_openid/eg;
s/\$CAN_USER_ACCOUNTS_REG/$self->has_smtp/eg;
s/\$CAN_USER_ACCOUNTS/$self->has_mysql_or_sqlite/eg;
s/\$USER_ACCOUNT_DB/$self->guess_user_account_db/eg;
s/\$SMTP_GATEWAY/$self->guess_smtp_gateway/eg;
s!^url_base\s*=.+!url_base = /!g;
s!^user_accounts[^=]+=.*!user_accounts = 0!;
$out->print($_);
}
close $out;
rename "$f.new",$f;
}
my $conf_data = $self->httpd_conf($dir,$port);
my $conf = IO::File->new("$dir/conf/httpd.conf",'>')
or die "$dir/conf/httpd.conf: $!";
$conf->print($conf_data);
$conf->close;
$conf_data = $self->gbrowse_demo_conf($port,$dir);
$conf = IO::File->new("$dir/conf/apache_gbrowse.conf",'>')
or die "$dir/conf/apache_gbrowse.conf: $!";
$conf->print($conf_data);
$conf->close;
$conf_data = $self->mime_conf();
my $mime = IO::File->new("$dir/conf/mime.types",'>')
or die "$dir/conf/mime.types: $!";
$mime->print($conf_data);
$mime->close;
my $apache = GBrowseGuessDirectories->apache
or die "Could not find apache executable on this system. Can't run demo";
install_util/GBrowseInstall.pm view on Meta::CPAN
}
if (Module::Build->y_n(
"It is recommended that you restart Apache. Shall I try this for you?",'y'
)) {
system "sudo /etc/init.d/apache2 restart";
}
print STDERR "\n***INSTALLATION COMPLETE***\n";
print STDERR "Load http://localhost/$base for demo and documentation.\n";
print STDERR "Visit the http://gmod.org for more information on setting up databases for users and custom tracks.\n";
}
sub ACTION_install_slave {
my $self = shift;
my $prefix = $self->install_base || $self->prefix ||'';
GBrowseGuessDirectories->prefix($prefix);
$self->install_path->{'etc'} ||= GBrowseGuessDirectories->etc;
$self->SUPER::ACTION_install();
}
sub ACTION_debian {
my $self = shift;
system "debuild";
}
sub fix_selinux {
my $self = shift;
return unless -e '/proc/filesystems';
my $f = IO::File->new('/proc/filesystems') or return;
return unless grep /selinux/i,<$f>;
my $enabled = IO::File->new('/selinux/enforce') or return;
return unless grep /1/,<$enabled>;
print STDERR "\n*** SELinux detected -- fixing permissions ***\n";
my $htdocs = $self->config_data('htdocs');
my $conf = $self->config_data('conf');
my $tmp = $self->config_data('tmp');
my $db = $self->config_data('databases');
system "/usr/bin/chcon -R -t httpd_sys_content_t $conf";
system "/usr/bin/chcon -R -t httpd_sys_content_t $htdocs";
system "/usr/bin/chcon -R -t httpd_sys_content_rw_t $tmp";
system "/usr/bin/chcon -R -t httpd_sys_content_rw_t $db";
}
sub process_conf_files {
my $self = shift;
my $f = IO::File->new('MANIFEST');
my $prefix = $self->install_base || $self->prefix || '';
GBrowseGuessDirectories->prefix($prefix);
my $install_path = $self->config_data('conf') || GBrowseGuessDirectories->conf;
while (<$f>) {
next unless m!^conf/!;
chomp;
my $base = $_;
my $copied = $self->copy_if_modified($_=>'blib');
if ($copied || !$self->up_to_date('_build/config_data',"blib/$_")) {
$self->substitute_in_place("blib/$_");
$self->check_installed($install_path,$base);
}
}
}
sub check_installed {
my $self = shift;
my ($install_path,$blib_file) = @_;
my $skip = $self->{skip} ||= IO::File->new('>>INSTALL.SKIP') or die "INSTALL.SKIP: $!";
(my $base = $blib_file) =~ s!^[^/]+/!!;
my $staged = File::Spec->catfile('./blib',$blib_file);
my $installed = File::Spec->catfile($install_path,$base);
if (-e $installed && (compare($staged,$installed) != 0)) {
my ($confirmed,$keep);
if ($ENV{AUTOMATED_TESTING} || !(-t STDIN)) {
$confirmed++;
$keep++;
}
while (!$confirmed) {
print STDERR "$installed has changed. Should \"Build install\" [R]eplace with new version or [K]eep currently installed version [K]? ";
my $line = <>;
chomp($line);
$line ||= '';
if ($line =~ /^[Kk]/) {
$keep++;
$confirmed++;
} elsif ($line =~ /^[Rr]/) {
$confirmed++;
} elsif ($line =~ /^$/) {
$keep++;
$confirmed++;
}
}
if ($keep) {
print STDERR "\"Build install\" will keep original $installed. New version can be found in ${installed}.new\n\n";
cp($staged,"${staged}.new");
print $skip '^',"blib/",quotemeta($blib_file),'$',"\n";
} else {
print STDERR "\"Build install\" will replace original $installed. Original version can be found in ${installed}.orig\n\n";
cp($installed,"${staged}.orig");
}
}
}
sub process_htdocs_files {
my $self = shift;
my $f = IO::File->new('MANIFEST');
my $install_path = $self->install_path->{'htdocs'} || GBrowseGuessDirectories->htdocs;
my %doneit;
while (<$f>) {
next unless m!^htdocs/!;
chomp;
my $base = $_;
my $copied = $self->copy_if_modified($base=>'blib');
if ($copied or !$self->up_to_date('_build/config_data',"blib/$base")) {
$self->substitute_in_place("blib/$base");
$self->check_installed($install_path,$base) if $copied;
}
}
# hacky thing for getting the cloud index.html right
if (eval "require Bio::Graphics::Browser2::Render::Slave::AWS_Balancer;1") {
if (Bio::Graphics::Browser2::Render::Slave::AWS_Balancer->running_as_instance) {
warn "Cloud instance detected; renaming index.html";
rename "blib/htdocs/index.html","blib/htdocs/index_default.html";
rename "blib/htdocs/cloud_index.html","blib/htdocs/index.html";
}
}
}
sub process_cgibin_files {
my $self = shift;
my $f = IO::File->new('MANIFEST');
while (<$f>) {
next unless m!^cgi-bin/!;
chomp;
my $copied = $self->copy_if_modified($_=>'blib');
my $path = File::Spec->catfile('blib',$_);
if ($copied) {
$self->fix_shebang_line($path);
chmod 0755,$path;
}
}
}
sub process_etc_files {
my $self = shift;
my $prefix = $self->install_base || $self->prefix || '';
GBrowseGuessDirectories->prefix($prefix);
my $install_path = $self->install_path->{'etc'} || GBrowseGuessDirectories->etc;
if ($self->config_data('installetc') =~ /^[yY]/) {
my $f = IO::File->new('MANIFEST');
while (<$f>) {
next unless m!^etc/!;
chomp;
my $base = $_;
my $copied = $self->copy_if_modified($_=>'blib');
if ($copied or !$self->up_to_date('_build/config_data',"blib/$_")) {
$self->substitute_in_place("blib/$_");
$self->check_installed($install_path,$base);
}
}
}
# generate the apache config data
my $includes = GBrowseGuessDirectories->apache_includes || '';
# the following workaround checks for perl.conf (which must load before gbrowse.conf on modperl envs)
# and renames the file so that it is loaded after perl.conf
my $file = -e "${includes}/perl.conf"
? 'z_gbrowse2.conf'
: 'gbrowse2.conf';
my $target = "blib${includes}/$file";
if ($includes && !$self->up_to_date('_build/config_data',$target)) {
if ($self->config_data('installconf') =~ /^[yY]/ && !-e "${includes}/$file") {
warn "Creating include file for Apache config: $target\n";
my $dir = dirname($target);
mkpath([$dir]);
if (my $f = IO::File->new("blib${includes}/$file",'>')) {
$f->print($self->apache_conf);
$f->close;
}
} else {
print STDERR
-e "${includes}/$file"
? "${includes}/$file is already installed. "
: "Automatic Apache config disabled. ";
print STDERR "Please run ./Build apache_conf to see this file's recommended contents.\n";
}
}
if (!$self->config_data('installetc') =~ /^[yY]/) {
warn "Not configuring your system to run gbrowse-slave automatically. Please reconfigure with this option enabled if you wish to do this.";
}
}
sub process_database_files {
my $self = shift;
my $f = IO::File->new('MANIFEST');
while (<$f>) {
next unless m!^sample_data/!;
chomp;
my $dest = $_; $dest =~ s|^sample_data/||;
$self->copy_if_modified(from => $_,
to => "blib/databases/$dest",
);
}
}
sub substitute_in_place {
my $self = shift;
my $path = shift;
return if $path =~ /\.\w+$/ && $path !~ /\.(html|txt|conf)$/;
my $in = IO::File->new($path) or return;
my $out = IO::File->new("$path.$$",'>') or return;
print STDERR "Performing variable substitutions in $path\n";
my $htdocs = $self->config_data('htdocs');
my $conf = $self->config_data('conf');
my $cgibin = $self->config_data('cgibin');
my $persistent = $self->config_data('persistent');
my $databases = $self->config_data('databases');
my $tmp = $self->config_data('tmp');
my $wwwuser = $self->config_data('wwwuser');
my $perl5lib = $self->perl5lib || '';
my $installscript = $self->install_destination('script');
my $etc = $self->install_path->{'etc'} ||= GBrowseGuessDirectories->etc;
my $cgiurl = $self->cgiurl;
$persistent ||= $databases;
while (<$in>) {
s/\$INSTALLSCRIPT\b/$installscript/g;
s/\$ETC\b/$etc/g;
s/\$PERL5LIB\b/$perl5lib/g;
s/\$HTDOCS\b/$htdocs/g;
s/\$CONF\b/$conf/g;
s/\$CGIBIN\b/$cgibin/g;
s/\$CGIURL\b/$cgiurl/g;
s/\$WWWUSER\b/$wwwuser/g;
s/\$DATABASES\b/$databases/g;
s/\$PERSISTENT\b/$persistent/g;
s/\$VERSION\b/$self->dist_version/eg;
s/\$CAN_USER_ACCOUNTS_OPENID\b/$self->has_openid/eg;
s/\$CAN_USER_ACCOUNTS_REG\b/$self->has_smtp/eg;
s/\$CAN_USER_ACCOUNTS\b/$self->has_mysql_or_sqlite/eg;
s/\$USER_ACCOUNT_DB\b/$self->guess_user_account_db/eg;
s/\$SMTP_GATEWAY\b/$self->guess_smtp_gateway/eg;
s/\$TMP\b/$tmp/g;
$out->print($_);
}
$in->close;
$out->close;
rename("$path.$$",$path);
}
sub has_mysql_or_sqlite {
my $self = shift;
return eval "require DBD::mysql; 1" || eval "require DBD::SQLite; 1" || 0;
}
sub has_smtp {
my $self = shift;
( run in 1.723 second using v1.01-cache-2.11-cpan-2e0ccfb7a10 )