=pod ########################################################################### =head1 NAME Apache::Voodoo::Install::Updater =head1 VERSION $Id: Distribution.pm 6538 2008-02-04 19:11:38Z medwards $ =head1 SYNOPSIS This package provides the methods that do pre/post/upgrade commands as specified by the various .xml files in an application. =cut ########################################################################### package Apache::Voodoo::Install::Distribution; use strict; use warnings; use base("Apache::Voodoo::Install"); use Apache::Voodoo::Constants; use File::Spec; use Config::General; use ExtUtils::Install; sub new { my $class = shift; my %params = @_; my $self = {%params}; $self->{'distribution'} = File::Spec->rel2abs($self->{'distribution'}); unless (-e $self->{'distribution'} && -f $self->{'distribution'}) { die "ERROR: No such file or directory\n"; } $self->{'app_name'} = $self->{'distribution'}; $self->{'app_name'} =~ s/\.tar\.(bz2|gz)$//i; $self->{'app_name'} =~ s/-[\d.]*(-beta\d+)?$//; $self->{'app_name'} =~ s/.*\///; unless ($self->{'app_name'} =~ /^[a-z][\w-]*$/i) { die "ERROR: Distribution file names must follow the format: AppName-Version.tar.(gz|bz2)\n"; } my $ac = Apache::Voodoo::Constants->new(); $self->{'ac'} = $ac; $self->{'install_path'} = File::Spec->catfile($ac->install_path(),$self->{'app_name'}); $self->{'conf_file'} = File::Spec->catfile($self->{'install_path'},$ac->conf_file()); $self->{'conf_path'} = File::Spec->catfile($self->{'install_path'},$ac->conf_path()); $self->{'updates_path'} = File::Spec->catfile($self->{'install_path'},$ac->updates_path()); $self->{'apache_uid'} = $ac->apache_uid(); $self->{'apache_gid'} = $ac->apache_gid(); bless $self,$class; return $self; } sub app_name { my $self = shift; $self->{'app_name'} = $_[0] if $_[0]; return $self->{'app_name'}; } sub existing { my $self = shift; return $self->{'is_existing'}; } ################################################################################ # Handles installer cleanup tasks. ################################################################################ sub DESTROY { my $self = shift; if ($self->{'unpack_dir'}) { system("rm", "-rf", $self->{'unpack_dir'}); } } sub do_install { my $self = shift; $self->unpack_distribution(); my $new_conf = File::Spec->catfile($self->{'unpack_dir'},$self->{'ac'}->conf_file()); my $pm_dir = $self->{distribution}; $pm_dir =~ s/(\.tar(\.gz|\.bz2)?|\.tgz)$//; $pm_dir =~ s/^.*\///; $pm_dir = File::Spec->catfile($self->{'unpack_dir'},$pm_dir); if (-e $new_conf) { $self->check_existing(); $self->update_conf_file(); $self->install_files(); } elsif (-e File::Spec->catfile($pm_dir,'Makefile.PL') || -e File::Spec->catfile($pm_dir,'Build.PL')) { $self->info("This appears to be a standard Perl module. Calling CPAN to install it...\n"); eval { use CPAN; CPAN::Shell->install(File::Spec->catfile($pm_dir,".")); }; exit; } else { print "This distribution doesn't follow a format that I know how to handle. Giving up.\n"; exit; } } ################################################################################ # Unpacks a tar.gz to a temporary directory. # Returns the path to the directory. ################################################################################ sub unpack_distribution { my $self = shift; my $file = $self->{'distribution'}; my $unpack_dir = "/tmp/av_unpack_$$"; if (-e $unpack_dir) { die "ERROR: $unpack_dir already exists\n"; } mkdir($unpack_dir,0700) || die "Can't create directory $unpack_dir: $!"; chdir($unpack_dir) || die "Can't change to direcotyr $unpack_dir: $!"; $self->info("- Unpacking distribution to $unpack_dir"); if ($file =~ /\.gz$/) { system("tar","xzf",$file) && die "Can't unpack $file: $!"; } else { system("tar","xjf",$file) && die "Can't unpack $file: $!"; } $self->{'unpack_dir'} = $unpack_dir; } ################################################################################ # Checks for an existing installation of the app. If it exists, it saves # it's site specific config data, and returns it's version number. ################################################################################ sub check_existing { my $self = shift; my $conf_file = $self->{'conf_file'}; if (-e $conf_file) { $self->{'is_existing'} = 1; $self->info("Found one. We will be performing an upgrade"); my $old_config = Config::General->new($conf_file); my %old_cdata = $old_config->getall(); # save old (maybe customized?) config variables foreach ('session_dir','devel_mode','debug','devel_mode','cookie_name','database') { $self->{'old_conf_data'}->{$_} = $old_cdata{$_}; } my $dbhost = $old_cdata{'database'}->{'connect'}; my $dbname = $old_cdata{'database'}->{'connect'}; $dbhost =~ s/.*\bhost=//; $dbhost =~ s/[^\w\.-]+.*$//; $dbname =~ s/.*\bdatabase=//; $dbname =~ s/[^\w\.-]+.*$//; $self->{'dbhost'} ||= $dbhost; $self->{'dbname'} ||= $dbname; $self->{'dbuser'} ||= $old_cdata{'database'}->{'username'}; $self->{'dbpass'} ||= $old_cdata{'database'}->{'password'}; } else { $self->info("not found. This will be a fresh install."); } } sub update_conf_file { my $self = shift; my $new_conf = File::Spec->catfile($self->{'unpack_dir'},$self->{'ac'}->conf_file()); my $config = Config::General->new($new_conf); my %cdata = $config->getall(); foreach (keys %{$self->{'old_conf_data'}}) { $self->debug("Merging config data: $_"); $cdata{$_} = $self->{'old_conf_data'}->{$_}; } $self->debug("Merging database config"); $cdata{'database'}->{'username'} = $self->{'dbuser'} if $self->{'dbuser'}; $cdata{'database'}->{'password'} = $self->{'dbpass'} if $self->{'dbpass'}; $cdata{'database'}->{'connect'} =~ s/\bdatabase=[^;"]+/database=$self->{'dbname'}/ if $self->{'dbname'}; $cdata{'database'}->{'connect'} =~ s/\bhost=[^;"]+/host=$self->{'dbhost'}/ if $self->{'dbhost'}; $self->{'pretend'} || $config->save_file($new_conf,\%cdata); } sub install_files { my $self = shift; my $unpack_dir = $self->{'unpack_dir'}; my $install_path = $self->{'install_path'}; if ($self->{'verbose'} >= 0) { $self->mesg("\n* Preparing to install. Press ctrl-c to abort *\n"); $self->mesg("* Installing in "); foreach (5,4,3,2,1) { $self->mesg("$_"); $self->{'pretend'} || sleep(1); } $self->mesg("\n"); $self->mesg("- Installing files:"); } $self->{'pretend'} || ExtUtils::Install::install({$unpack_dir => $install_path}); } 1; =pod ################################################################################ =head1 AUTHOR Maverick, /\/\averick@smurfbaneDOTorg =head1 COPYRIGHT Copyright (c) 2005 Steven Edwards. All rights reserved. You may use and distribute Voodoo under the terms described in the LICENSE file include in this package or L. The summary is it's a legalese version of the Artistic License :) =cut ################################################################################