File Coverage

blib/lib/Net/UploadMirror.pm

Criterion	Covered	Total	%
statement	80	148	54.0
branch	11	52	21.1
condition	12	28	42.8
subroutine	18	19	94.7
pod	10	10	100.0
total	131	257	50.9

#*** UploadMirror.pm ***#
# Copyright (C) 2005 - 2008 by Torsten Knorr
# [e-mail]
# All rights reserved!
#-------------------------------------------------
 use strict;
#------------------------------------------------
 package Net::UploadMirror::FileName;
 use Storable;
 sub TIESCALAR{ my ($class, $obj) = @_; return bless(\$obj, $class || ref($class)); }
 sub STORE
 	{
 	if(-f $_[1])
 		{
 		${$_[0]}->{_last_modified} = retrieve($_[1]);
 		}
 	else
 		{
 		${$_[0]}->{_last_modified} = {};
 		store(${$_[0]}->{_last_modified}, $_[1]);
 		warn("\nno information of the files last modified times\n");
 		}
 	}
 sub FETCH { return ${$_[0]}->{_filename}; }
#-------------------------------------------------
 package Net::UploadMirror;
#-------------------------------------------------
 use Net::MirrorDir 0.19;
 use Storable;
 use vars '$AUTOLOAD';
#------------------------------------------------
 @Net::UploadMirror::ISA = qw(Net::MirrorDir);
 $Net::UploadMirror::VERSION = '0.13';
#-------------------------------------------------
 sub _Init
 	{
 	my ($self, %arg) = @_;
	tie($self->{_filename}, 'Net::UploadMirror::FileName', $self);
 	$self->{_filename}	= $arg{filename}	|| 'lastmodified_local';
 	$self->{_delete}	= $arg{delete}	|| 'disabled';
 	return 1;
 	}
#-------------------------------------------------
 sub Upload
 	{
 	my ($self) = @_;
 	return 0 unless($self->Connect());
 	my ($rh_lf, $rh_ld) = $self->ReadLocalDir();
 	if($self->{_debug})
 		{
 		print("local files : $_\n") for(sort keys %$rh_lf);
 		print("local dirs : $_\n") for(sort keys %$rh_ld);
 		}
 	my ($rh_rf, $rh_rd) = $self->ReadRemoteDir();
 	if($self->{_debug})
 		{
 		print("remote files : $_\n") for(sort keys %$rh_rf);
 		print("remote dirs : $_\n") for(sort keys %$rh_rd);
 		}
 	my $ra_ldnir = $self->LocalNotInRemote($rh_ld, $rh_rd);
 	if($self->{_debug})
 		{
 		print("local directories not in remote : $_\n") for(@$ra_ldnir);
 		}
 	$self->MakeDirs($ra_ldnir);
 	my $ra_lfnir = $self->LocalNotInRemote($rh_lf, $rh_rf);
 	if($self->{_debug})
 		{
 		print("local files not in remote: $_\n") for(@$ra_lfnir);
 		}
 	$self->StoreFiles($ra_lfnir);
 	if($self->{_delete} eq 'enable')
 		{
 		my $ra_rfnil = $self->RemoteNotInLocal($rh_lf, $rh_rf);
 		if($self->{_debug})
 			{
 			print("remote files not in local : $_\n") for(@$ra_rfnil);
 			}
  		$self->DeleteFiles($ra_rfnil);
 		my $ra_rdnil = $self->RemoteNotInLocal($rh_ld, $rh_rd);
 		if($self->{_debug})
 			{
 			print("remote directories not in local : $_\n") for(@$ra_rdnil);
 			}
 		$self->RemoveDirs($ra_rdnil);
 		}
 	delete(@{$rh_lf}{@$ra_lfnir});
 	my $ra_mlf = $self->CheckIfModified($rh_lf);
 	if($self->{_debug})
 		{
 		print("modified files : $_\n") for(@$ra_mlf);
 		}
	$self->StoreFiles($ra_mlf);
 	$self->Quit();
 	return 1;
 	}
#-------------------------------------------------
 sub CheckIfModified
 	{
 	my ($self, $rh_lf) = @_;
 	my @mf;
 	my $changed = undef;
 	for my $lf (keys(%$rh_lf))
 		{
 		next unless(-f $lf);
 		if(defined($self->{_last_modified}{$lf}))
 			{
 			next if($self->{_last_modified}{$lf} eq (stat($lf))[9]);
 			}
 		else
 			{
 			$self->{_last_modified}{$lf} = (stat($lf))[9];
 			$changed++;
 			}
 		push(@mf, $lf);
 		}
 	store($self->{_last_modified}, $self->{_filename}) if($changed);
 	return \@mf;
 	}
#-------------------------------------------------
 sub UpdateLastModified
 	{
 	my ($self, $ra_lf) = @_;
 	for(@$ra_lf)
 		{
 		next unless(-e $_);
 		$self->{_last_modified}{$_} = (stat($_))[9];
 		}
 	store($self->{_last_modified}, $self->{_filename});
 	return 1;
 	}
#-------------------------------------------------
 sub StoreFiles
 	{
 	my ($self, $ra_lf) = @_;
 	return 0 unless(@$ra_lf && $self->IsConnection());
 	my $rf;
 	for my $lf (@$ra_lf)
 		{
 		if(-f $lf)
 			{
 			$rf = $lf;
 			$rf =~ s!$self->{_regex_localdir}!$self->{_remotedir}!;
 $self->{_last_modified}{$lf} = (stat($lf))[9] if($self->{_connection}->put($lf, $rf));
 			}
 		else
 			{
 			warn("error in StoreFiles() : $lf is not a local file\n");
 			}
 		}
 	store($self->{_last_modified}, $self->{_filename});
 	return 1;
 	}
#-------------------------------------------------
 sub MakeDirs
 	{
 	my ($self, $ra_ld) = @_;
 	return 0 unless(@$ra_ld && $self->IsConnection());
 	my $rd;
 	for my $ld (@$ra_ld)
 		{
 		$rd = $ld;
 		if(-d $ld)
 			{
 			$rd =~ s!$self->{_regex_localdir}!$self->{_remotedir}!;
 			$self->{_connection}->mkdir($rd, 1) ;
 			}
 		else
 			{
			warn("error in MakeDirs() : $rd is not a local directory\n");
 			}
 		}
 	return 1;
 	}
#-------------------------------------------------
 sub DeleteFiles
 	{
 	my ($self, $ra_rf) = @_;
	return 0 unless(
 		@$ra_rf
 		&& ($self->{_delete} eq 'enable')
 		&& $self->IsConnection()
 		);
	my $lf;
 	for my $rf (@$ra_rf)
 		{
		$lf = $rf;
		$self->{_connection}->delete($rf);
 		$lf =~ s!$self->{_regex_remotedir}!$self->{_localdir}!;
 		delete($self->{_last_modified}{$lf}) if(defined($self->{_last_modified}{$lf}));
 		}
 	store($self->{_last_modified}, $self->{_filename});
 	return 1;
 	}
#-------------------------------------------------
 sub RemoveDirs
 	{
 	my ($self, $ra_rd) = @_;
	return 0 unless(
 		@$ra_rd
 		&& ($self->{_delete} eq 'enable')
 		&& $self->IsConnection()
 		);
 	$self->{_connection}->rmdir($_, 1) for(@$ra_rd);
 	return 1;
 	}
#-------------------------------------------------
sub CleanUp
 	{
 	my ($self, $ra_exists) = @_;
 	my %h_temp = ();
 	for my $key (@$ra_exists)
 		{
		if(
 			defined($self->{_last_modified}{$key})
 			&&
 			($self->{_last_modified}{$key} =~ m/^\d+$/)
 			)
 			{
 			$h_temp{$key} = delete($self->{_last_modified}{$key});
 			}
 		}
 	if($self->{_debug})
 	 	{
 		print(
 			"key: $_	value: "
 			. (defined($self->{_last_modified}{$_}) ? $self->{_last_modified}{$_} : 'undef')
 			. " removed\n")
 				for(keys(%{$self->{_last_modified}}));
 		}
 	%{$self->{_last_modified}} = %h_temp;
 	store($self->{_last_modified}, $self->{_filename});
 	return 1;
 	}
#-------------------------------------------------
 sub LtoR
 	{
 	my ($self, $ra_lp) = @_;
 	my $ra_rp = [];
 	my $rp;
 	for(@$ra_lp)
 		{
 		$rp = $_;
 		$rp =~ s!$self->{_regex_localdir}!$self->{_remotedir}!;
 		push(@$ra_rp, $rp);
 		}
 	return $ra_rp;
 	}
#-------------------------------------------------
 sub RtoL
 	{
 	my ($self, $ra_rp) = @_;
 	my $ra_lp = [];
 	my $lp;
 	for(@$ra_rp)
 		{
 		$lp = $_;
 		$lp =~ s!$self->{_regex_remotedir}!$self->{_localdir}!;
 		push(@$ra_lp, $lp);
 		}
 	return $ra_lp;
 	}
#-------------------------------------------------
1;
#------------------------------------------------
__END__