#! /usr/bin/perl

=head1 NAME

FileMirror - class to help write file copying and moving scripts

=head1 SYNOPSIS

 use FileMirror;

 # class methods
 $fm = FileMirror->new( '/tmp/sourcedir', '/tmp/destdir' );

 # object data methods
 
 # get versions
 $fm->sourcedir;
 $fm->destdir;
 $fm->os; # what the class thinks the OS is

 # set versions
 $fm->sourcedir( '/tmp/sourcedir' );
 $fm->destdir( '/tmp/destdir' );
 
 # methods
 $fm->copy( '/tmp/sourcedir/filename' );
 $fm->move( '/tmp/sourcedir/filename' );
 $fm->delete_original( '/tmp/sourcedir/filename' );
 $destination_path = $fm->dest_from_source( '/tmp/sourcedir/filename' );

 # example
 my $fm = FileMirror->new( '/tmp/s', '/tmp/d' );
 $fm->move( '/tmp/s/path/to/a.txt' ); # moves a.txt into /tmp/d/path/to

=head1 DESCRIPTION

FileMirror helps you write file copying scripts to move or copy
files from one file hierarchy to another, while retaining the
directory structure.  It includes features to reduce the risk of
data loss, by checking to see that the file appears to be copied
over correctly, before deleting the original.

File path manipulation is done within the class, saving you the
effort of altering the paths yourself.

 To use the methods correctly, follow these two principles:
  * specify full paths to the source and destination;
  * specify full paths to the copy() and move() methods.

Behavior for using relative paths is undefined at this time.  

For maximum saftey, you should not use chdir or relative paths.  
This is a good principle, even when you're not using this class.

=head1 BUGS

The behavior of using relative paths is undefined.  They will probably
work, relative to $CWD, but, if you do a chdir, it could all fall 
apart.

=cut


# vim:set ts=4 sw=4:

package FileMirror;
use strict;
use File::Basename;

#
# constructor
#
sub new
{
	my $class = shift;
	my $self = {};
	$self->{SOURCEDIR} = shift;
	$self->{DESTDIR} = shift;
	$self->{OS} = $^O;
	bless( $self, $class );

	# if it looks like DOS, set file flag to MSWin32
	if ($self->{SOURCEDIR} =~ /\\/ or $self->{DESTDIR} =~ /\\/)
	{
		fileparse_set_fstype('MSWin32'); 
		$self->os('MSWin32');
	}
	
	return $self;
}
#
# All files are copied from this root.
#
sub sourcedir
{
	my $self = shift;
	if (@_) { $self->{SOURCEDIR} = shift; }
	return $self->{SOURCEDIR};
}
#
# The root directory of the destination.
#
sub destdir
{
	my $self = shift;
	if (@_) { $self->{DESTDIR} = shift; }
	return $self->{DESTDIR};
}
#
# This value is set if the OS value changes.
#
sub os
{
	my $self = shift;
	if (@_) { $self->{OS} = shift; }
	return $self->{OS};
}
#
# Copies the file, building up the source path at the destination.
#
sub copy
{
	my $self = shift;
	my $pth = shift;
	my $dest = $self->dest_from_source( $pth );
	my ($file,$path) = fileparse($dest);
	if (! -e $path)
	{
		use File::Path;
		mkpath($path,1);
	}
	if (-e $dest)
	{
		print "copy failed, $dest exists\n";
		return;
	}
	use File::Copy;
	File::Copy::copy($pth, $dest);
	#print "Copy $pth -> $dest\n";
}
#
# Deletes the source file, iff the dest file exists and is the same size.
#
sub delete_original
{
	my $self = shift;
	my $pth = shift;
	my $dest;
    $dest = $self->dest_from_source( $pth );
	if (-e $dest)
	{
		use File::stat;
		my $pst = stat($pth);
		my $dst = stat($dest);
		if ($pst->size == $dst->size)
		{
			unlink($pth);
		}
		else
		{
			print "delete failed $pth\n";
		}
	}
	else
	{
		print "delete failed, no $dest\n";
	}
}
sub move
{
	my $self = shift;
	my $pth = shift;
	# print "Move $pth\n";
	$self->copy($pth);
	$self->delete_original($pth);
}
#
# Given a full source path, returns full destination path
# Note: don't use regex here, because file paths might clash with regex syntax.
#
sub dest_from_source
{
	my $self = shift;
	my $sourcepath = shift;
	my $sourcedir = $self->sourcedir;
	if ( index($sourcepath,$sourcedir)==0 )
	{
		my $destdir = $self->destdir;
		my $tail = substr($sourcepath, length($sourcedir));
		$sourcepath = $destdir . $tail;
	}
	return $sourcepath;
}

1;