File Coverage

blib/lib/Xtract/Publish.pm

Criterion	Covered	Total	%
statement	121	133	90.9
branch	51	64	79.6
condition	7	9	77.7
subroutine	25	25	100.0
pod	1	14	7.1
total	205	245	83.6

package Xtract::Publish;

use 5.008005;
use strict;
use Carp                      ();
use File::Copy              0 ();
use File::Remove         1.42 ();
use Params::Util         0.35 ();
use IO::Compress::Gzip  2.008 ();
use IO::Compress::Bzip2 2.008 ();
use Xtract::LZMA              ();

our $VERSION = '0.16';

use Mouse 0.93;

has 'sqlite' => (
	is        => 'ro',
	isa       => 'Str',
	required  => 1,
);

has 'from' => (
	is        => 'ro',
	isa       => 'Str',
	required  => 0,
	predicate => 'has_from',
);

sub flag ($$) {
	has $_[0] => (
		is       => 'rw',
		isa      => 'Bool',
		required => 1,
		default  => $_[1],
	);
}

flag 'raw'    => 1;
flag 'gz'     => 1;
flag 'bz2'    => 0;
flag 'lz'     => 0;
flag 'atomic' => 0;
flag 'trace'  => 0;

no Mouse;





######################################################################
# Constructor and Accessors

sub new {
	my $self = shift->SUPER::new(@_);

	# Check params
	if ( $self->has_from and not -f $self->from ) {
		Carp::croak("Source file '" . $self->from . "' does not exist");
	}

	return $self;
}

sub sqlite_gz {
	$_[0]->sqlite . '.gz';
}

sub sqlite_bz2 {
	$_[0]->sqlite . '.bz2';
}

sub sqlite_lz {
	$_[0]->sqlite . '.lz';
}






######################################################################
# Main Methods

sub run {
	my $self = shift;

	# Copy the source SQLite database
	my $sqlite = $self->write_sqlite;
	if ( defined $sqlite ) {
		$self->remove($sqlite);
		$self->copy( $self->from => $sqlite );
	}

	# Where to we create the archives from?
	$sqlite = defined($sqlite) ? $sqlite : $self->sqlite;

	# Create the GZip archive
	my $gz = $self->write_gz;
	if ( defined $gz ) {
		$self->remove($gz);
		$self->say("Compressing '$sqlite' into '$gz'");
		my $rv = IO::Compress::Gzip::gzip(
			$sqlite   => $gz,
			AutoClose => 1,
			BinModeIn => 1,
		);
		unless ( $rv ) {
			Carp::croak("Failed to create gzip archive '$gz'");
		}
	}

	# Create the BZip2 archive
	my $bz2 = $self->write_bz2;
	if ( defined $bz2 ) {
		$self->remove($bz2);
		$self->say("Compressing '$sqlite' into '$bz2'");
		my $rv = IO::Compress::Bzip2::bzip2(
			$sqlite   => $bz2,
			AutoClose => 1,
			BinModeIn => 1,
		);
		unless ( $rv ) {
			Carp::croak("Failed to create bzip2 archive '$bz2'");
		}
	}

	# Create the LZMA archive
	my $lz = $self->write_lz;
	if ( defined $lz ) {
		$self->remove($lz);
		$self->say("Compressing '$sqlite' into '$lz'");
		Xtract::LZMA->compress( $sqlite => $lz );
	}

	# Atomically overwrite the original archives
	if ( $self->atomic ) {
		if ( $sqlite ne $self->sqlite ) {
			$self->move( $sqlite => $self->sqlite );
		}
		if ( defined $gz ) {
			$self->move( $gz => $self->sqlite_gz );
		}
		if ( defined $bz2 ) {
			$self->move( $bz2 => $self->sqlite_bz2 );
		}
		if ( defined $lz ) {
			$self->move( $lz => $self->sqlite_lz );
		}
	}

	# Remove any archives we may have had previously that we don't any more
	unless ( defined $gz ) {
		$self->remove( $self->sqlite_gz );
	}
	unless ( defined $bz2 ) {
		$self->remove( $self->sqlite_bz2 );
	}
	unless ( defined $lz ) {
		$self->remove( $self->sqlite_lz );
	}
	if ( $self->from and not $self->raw ) {
		$self->remove( $self->sqlite );
	}

	return 1;
}

sub write_sqlite {
	my $self = shift;
	if ( defined $self->from and $self->sqlite ne $self->from ) {
		if ( $self->atomic ) {
			return $self->sqlite . '.tmp';
		} else {
			return $self->sqlite;
		}
	}
	return undef;
}

sub write_gz {
	my $self = shift;
	if ( $self->gz ) {
		if ( $self->atomic ) {
			return $self->sqlite . '.tmp.gz';
		} else {
			return $self->sqlite_gz;
		}
	}
	return undef;
}

sub write_bz2 {
	my $self = shift;
	if ( $self->bz2 ) {
		if ( $self->atomic ) {
			return $self->sqlite . '.tmp.bz2';
		} else {
			return $self->sqlite_bz2;
		}
	}
	return undef;
}

sub write_lz {
	my $self = shift;
	if ( $self->lz ) {
		if ( $self->atomic ) {
			return $self->sqlite . '.tmp.lz';
		} else {
			return $self->sqlite_lz;
		}
	}
	return undef;
}





######################################################################
# Support Methods

sub say {
	if ( Params::Util::_CODE($_[0]->trace) ) {
		$_[0]->say( @_[1..$#_] );
	} elsif ( $_[0]->trace ) {
		my $t = scalar localtime time;
		print map { "[$t] $_\n" } @_[1..$#_];
	}
}

sub copy {
	my $self = shift;
	$self->say("Copying '$_[0]' to '$_[1]'");
	unless ( File::Copy::copy(@_) ) {
		Carp::croak("Failed to copy '$_[0]' to '$_[1]'");
	}
	return 1;
}

sub move {
	my $self = shift;
	if ( -f $_[1] ) {
		$self->say("Moving '$_[0]' over existing '$_[1]'");
	} else {
		$self->say("Moving '$_[0]' to '$_[1]'");
	}
	$self->say("Copying '$_[0]' to '$_[1]'");
	unless ( File::Copy::move(@_) ) {
		Carp::croak("Failed to move '$_[0]' to '$_[1]'");
	}
	return 1;
}

sub remove {
	my $self = shift;
	my $file = shift;

	# Flush any existing file
	if ( -f $file ) {
		$self->say("Removing '$file'");
		unless ( File::Remove::remove( $file ) ) {
			Carp::croak("Failed to remove existing '$file'");
		}
	}

	return 1;
}

1;