Verby::Action::Untar - Action to un-tar an archive.

	use Verby::Action::Untar;

#!/usr/bin/perl

package Verby::Action::Untar;
use Moose;

with qw/Verby::Action::Run/;

our $VERSION = "0.04";

use Archive::Tar;
use File::Spec;
use File::stat;

sub do {
	my ( $self, $c ) = @_;

	my $tarball = $c->tarball;
	my $dest    = $c->dest;
	
	$c->logger->info("untarring '$tarball' into '$dest'");

	$self->create_poe_session(
		c       => $c,
		program => sub {
			chdir $dest;

			$self->tar_archive($c)->extract
				or $c->logger->log_and_die("Archive::Tar->extract did not return a true value");
		},
		program_debug_string => "Archive::Tar child",
	);
}

sub finished {
	my ( $self, $c ) = @_;
	$c->logger->info("finished untarring");
	$self->confirm($c);
}

sub verify {
	my ( $self, $c ) = @_;

	my $dest = $c->dest;

	my $main_dir; # the main directory in the archive, if any

	my $i;

	my $tarball = $self->tar_archive( $c );

	foreach my $spec ( $tarball->list_files([qw/name size mtime/]) ) {
		my ( $name, $size, $mtime ) = @{ $spec }{qw/name size mtime/};

		# determine the top level unpack directory
		my $top_dir = (File::Spec->splitdir($name))[0];
		if ( defined $main_dir ) {
			if ( $top_dir ne $main_dir ) {
				$c->logger->warn("Archive has no main directory");
				$main_dir = '';
			}
		} else {
			$main_dir = $top_dir;
		}

		my $destfile = File::Spec->catfile($dest, $name);
		my $existing = stat($destfile);
		unless ( $existing and ( -d $destfile or $existing->size == $size && $existing->mtime == $mtime ) ) {
			$c->logger->warn("file '$name' requires re-extraction") if $i; # it's ok only for the first file to be missing
			return undef;
		}

		$i++;
	}

	$c->main_dir(File::Spec->catdir($dest, $main_dir));

	return 1;
}

sub tar_archive {
	my ( $self, $c ) = @_;
	$c->archive_object || $c->archive_object(Archive::Tar::LogError->new($c->tarball));
}

package Archive::Tar::LogError;
use base qw(Archive::Tar);

use Log::Dispatch::Config;

sub _error {
    Log::Dispatch::Config->instance->log_and_die( level => "error", message => $_[1] );
}

__PACKAGE__

__END__