File Coverage

lib/Conan/Deploy.pm

Criterion	Covered	Total	%
statement	51	69	73.9
branch	10	26	38.4
condition	1	3	33.3
subroutine	8	8	100.0
pod	3	4	75.0
total	73	110	66.3

package Conan::Deploy;

use Carp;
use File::Rsync;

sub __config {
	my @config_files = glob '/etc/conan.cfg ~/.conanrc';

	my %config_options;

	for( @config_files ){
		next unless -f $_;
		print "D: Parsing [$_]\n" if -f $_;

		my $fd;
		open $fd, "<$_";

		next unless $fd;

		my @lines = <$fd>;
		chomp for @lines;

		s/#.*// for @lines;

		@lines = grep { /^\S/ } @lines;

		my %r = map { ($1,$2) if /^(\S+)=(\S+)/ } @lines;

		for ( keys %r ){
			$config_options{"$_"} = $r{"$_"};
		}
	}
	return %config_options;
}

sub new {
	my $class = shift;

	my %config_options = __config @_;

	my $args = {
		%config_options,
		@_,
	};

	return bless $args => $class;
}

# Call for the "promot image" call
sub promote_image {
	my $self = shift;
	my $image = shift;
	my $orig_image = $image;

	unless( defined $self->{srcimagebase} ){
		croak "Must supply a srcimagebase to the Conan::Deploy constructor";
	}

	unless( -d "$self->{srcimagebase}" ){
		croak "$self->{srcimagebase} doesn't exist";
	}

	unless( $self->{targetimagebase} ){
		croak "Must supply a targetimagebase to the Conan::Deploy constructor";
	}


	unless( -d "$self->{targetimagebase}" ){
		croak "$self->{targetimagebase} doesn't exist";
	}

	# Check if the source image has a / in it
	unless( $image =~ /\// ){
		$image = $self->{srcimagebase} . "/" . $image;
	}

	unless( -d $image || -f $image ){
		croak "$image doesn't exist";
	}

	printf "D: Copying [%s] to [%s]\n", $image, $self->{targetimagebase};

	my $obj = File::Rsync->new( { archive => 1, compress => 1 } );

	$obj->exec( { src => $image, dest => $self->{targetimagebase} } ) or croak "rsync failed";

	$self->md5( $orig_image );
}

sub md5 {
	my $self = shift;
	my $image = shift;

	sub md5dir {
		my ($base, $image) = @_;

		my $cmd = 'find ' . $base . "/" . $image . " -type f | xargs md5sum";
		print "D: Running [$cmd]\n";

		open $fd, "$cmd |";

		my @lines = <$fd>;

		close $fd;

		chomp for @lines;

		use Data::Dumper;

		s/\s+$base\// / for @lines;
		s/\s+$image/ / for @lines;

		my %r = map { ($2,$1) if /^(\S+)\s+(\S+)/ } @lines;
		return %r;
	}

	my %t = md5dir( $self->{targetimagebase}, $image );
	my %s = md5dir( $self->{srcimagebase}, $image );

	for my $file ( keys %s ){
		# Check that the md5s match
		croak "Mismatch between target and source on [$file]"
			if( $t{"$file"} ne $s{"$file"} );
	}

	return 1;
}

1;

__END__