view release on metacpan or  search on metacpan

lib/Conan/Deploy.pm  view on Meta::CPAN

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;