File Coverage

blib/lib/Apache/Voodoo/Install/Distribution.pm

Criterion	Covered	Total	%
statement	24	129	18.6
branch	0	42	0.0
condition	0	18	0.0
subroutine	8	17	47.0
pod	0	8	0.0
total	32	214	14.9

################################################################################
#
# Apache::Voodoo::Install::Updater
#
# This package provides the methods that do pre/post/upgrade commands as specified
# by the various .xml files in an application.
#
################################################################################
package Apache::Voodoo::Install::Distribution;

$VERSION = "3.0200";

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;

################################################################################
# Copyright (c) 2005-2010 Steven Edwards ([e-mail]).
# All rights reserved.
#
# You may use and distribute Apache::Voodoo under the terms described in the
# LICENSE file include in this package. The summary is it's a legalese version
# of the Artistic License :)
#
################################################################################