File::Copy::Vigilant - Copy and move files with verification and retries

    use File::Copy::Vigilant;

    copy_vigilant( $source, $destination );
    move_vigilant( $source, $destination );

    copy_vigilant(
        $source, $destination,
        [ check => (checktype), ]
        [ retires => (number of retries), ]
    );

  md5     - Get the MD5 sum of the source before copying, and compare it to
            the MD5 of the destination after copying (default)
  size    - Get the size of the source before copying, and compare it to the
            size of the destination after copying
  compare - Perform a byte-for-byte comparison of the source and destination
            after copying
  none    - Do not perform a check of the source to the destination

  0          - No retries are performed
  integer    - The number of retries to perform (if a 1 is passed, then the
               copy will be attempted a maximum of 2 times).  Must be a
               positive, whole number.
  'infinite' - The string 'infinite' (and all other strings for that matter)
               will cause it to retry continuously until success

  use File::Copy::Vigilant qw(cp mv);

  cp( $source, $destination );

  use File::Copy::Vigilant qw(copy move);

  copy( $source, $destination );

    perldoc File::Copy::Vigilant

package File::Copy::Vigilant;

use warnings;
use strict;

use base qw(Exporter);
our @EXPORT    = qw(copy_vigilant move_vigilant);
our @EXPORT_OK = qw(copy move cp mv);

use File::Copy qw();    # Don't import copy / move into the local namespace
use File::Compare;
use Digest::MD5::File qw(file_md5_hex);

our $VERSION = '1.01';

sub copy_vigilant
{

	my ( $source, $dest, %params ) = @_;

	my @errors  = ();
	my $success = eval {

		my $retries = defined( $params{'retries'} ) ? $params{'retries'} : 2;
		if ( $retries !~ m/^\d+$/x )
		{
			$retries = 'infinite';
		}    # Blank = continuous

		my $check
			= defined( $params{'check'} ) ? lc( $params{'check'} ) : 'md5';
		if ( $check !~ m/^md5|size|compare|none$/x ) { $check = 'md5'; }

		# This hook allows us to do some whitebox testing by modifying the
		# results of the copy.  You probably don't want this unless you're
		# testing this module.
		my $postcopy = $params{'_postcopy'};
		if ( defined($postcopy) && ref($postcopy) ne 'CODE' )
		{
			$postcopy = undef;
		}

		my $check_error = _check_files( $source, $dest );
		if ($check_error)
		{
			push @errors, "Pre-copy check failed: $check_error\n";
			return 0;
		}

		my $attempt = 0;
		while ( ( $retries eq 'infinite' ) || ( $attempt++ <= $retries ) )
		{

			my $copy_error = _try_copy( $source, $dest, $check, $postcopy );

			if ($copy_error)
			{
				push @errors, "Copy attempt $attempt failed: $copy_error\n";
			}
			else
			{
				return 1;
			}

		}

		# If we got here, then we looped as many times as
		# we were allowed without a success
		return 0;

	};

	if ($@)
	{
		$success = 0;
		push @errors, "Internal error in copy_vigilant: $@\n";
	}

	return wantarray ? ( $success, @errors ) : $success;

} ## end sub copy_vigilant

# Syntax borrowed from core module File::Copy
sub cp;
*cp = \&copy_vigilant;

sub copy;
*copy = \&copy_vigilant;

sub _check_files
{

	my ( $source, $dest ) = @_;

	if ( ref $source )
	{
		if ( ref($source) eq 'GLOB' ||
			eval { $source->isa('GLOB') } ||
			eval { $source->isa('IO::Handle') } )
		{
			return "can't use filehandle for source";
		}
	}
	elsif ( ref( \$source ) eq 'GLOB' )
	{
		return "can't use filehandle for source";
	}

	if ( ref $dest )
	{
		if ( ref($dest) eq 'GLOB' ||
			eval { $dest->isa('GLOB') } ||
			eval { $dest->isa('IO::Handle') } )
		{
			return "Can't use filehandle for desination";
		}
	}
	elsif ( ref( \$dest ) eq 'GLOB' )
	{
		return "can't use filehandle for destination";
	}

	unless ( stat $source )
	{
		return "unable to stat source file $source";
	}

	if ( -d $source )
	{
		return "unable to copy directory source $source";
	}

	unless ( -f $source || -l $source )
	{
		return "unable to copy non-file source $source";
	}

	# If we got this far then both the source and dest look OK
	return '';
} ## end sub _check_files

sub _try_copy
{

	my ( $source, $dest, $check, $postcopy ) = @_;

	my $source_md5  = undef;
	my $source_size = undef;
	if ( $check eq 'md5' )
	{
		$source_md5 = file_md5_hex($source);
	}
	if ( ( $check eq 'md5' ) || ( $check eq 'size' ) )
	{
		$source_size = ( stat $source )[7];
	}

	unless ( File::Copy::copy( $source, $dest ) )
	{
		return "copy failed: $!";
	}

	defined($postcopy) && $postcopy->(@_);

	my $dest_size = undef;
	if ( $check eq 'md5' || $check eq 'size' )
	{
		$dest_size = ( stat $dest )[7];
	}

	if ( $check eq 'md5' )
	{
		if ( $source_size != $dest_size )
		{
			return "pre-md5 size check failed";
		}
		my $dest_md5 = file_md5_hex($dest);
		if ( $source_md5 ne $dest_md5 )
		{
			return "md5 check failed";
		}
	}
	elsif ( $check eq 'size' )
	{
		if ( $source_size != $dest_size )
		{
			return "size check failed";
		}
	}
	elsif ( $check eq 'compare' )
	{
		if ( File::Compare::compare( $source, $dest ) )
		{
			return "file compare failed";
		}
	}

	# If we got this far then the copy was a success!
	return '';
} ## end sub _try_copy

sub move_vigilant
{

	my ( $source, $dest, %params ) = @_;

	my ( $copy_success, @copy_errors )
	  = copy_vigilant( $source, $dest, %params );

	unless ($copy_success)
	{
		return wantarray ? ( 0, @copy_errors ) : 0;
	}

	my @errors  = ();
	my $success = eval {
		if ( unlink $source )
		{
			return 1;
		}
		else
		{
			push @errors, "Unable to remove source $source "
			  . "(destination file $dest has been left in place)\n";
			return 0;
		}
	};

	if ($@)
	{
		$success = 0;
		push @errors, "Internal error in move_vigilant: $@\n";
	}

	return wantarray ? ( $success, @errors ) : $success;

}

# Syntax borrowed from core module File::Copy
sub mv;
*mv = \&move_vigilant;

sub move;
*move = \&move_vigilant;

1; # End of File::Copy::Vigilant