File Coverage

blib/lib/Net/MirrorDir.pm

Criterion	Covered	Total	%
statement	169	218	77.5
branch	38	74	51.3
condition	25	58	43.1
subroutine	32	35	91.4
pod	7	8	87.5
total	271	393	68.9

#*** MirrorDir.pm ***#
# Copyright (C) 2006 - 2009 by Torsten Knorr
# [e-mail]
# All rights reserved!
#-------------------------------------------------
 use strict;
#-------------------------------------------------
 package Net::MirrorDir::LocalDir;
 sub TIESCALAR { my ($class, $obj) = @_; return bless(\$obj, $class || ref($class)); }
 sub STORE { $_[1] ||= '.'; ${$_[0]}->{_regex_localdir} = qr!^\Q$_[1]\E!; }
 sub FETCH { return ${$_[0]}->{_localdir}; }
#-------------------------------------------------
 package Net::MirrorDir::RemoteDir;
 sub TIESCALAR { my($class, $obj) = @_; return bless(\$obj, $class || ref($class)); }
 sub STORE { $_[1] ||= ''; ${$_[0]}->{_regex_remotedir} = qr!^\Q$_[1]\E!; }
 sub FETCH { return ${$_[0]}->{_remotedir}; }
#-------------------------------------------------
 package Net::MirrorDir::Exclusions;
 sub TIESCALAR { my ($class, $obj) = @_; return bless(\$obj, $class || ref($class)); }
 sub STORE { @{${$_[0]}->{_regex_exclusions}} = map { qr/$_/ } @{${$_[0]}->{_exclusions}}; }
 sub FETCH { return ${$_[0]}->{_exclusions}; }
#-------------------------------------------------
 package Net::MirrorDir::Subset;
 sub TIESCALAR { my ($class, $obj) = @_; return bless(\$obj, $class || ref($class)); }
 sub STORE { @{${$_[0]}->{_regex_subset}} = map { qr/$_/ } @{${$_[0]}->{_subset}}; }
 sub FETCH { return ${$_[0]}->{_subset}; }
#-------------------------------------------------
 package Net::MirrorDir::Connection;
 sub TIESCALAR	{ return bless($_[1], $_[0] || ref($_[0])); }
 sub STORE	{ ${$_[0]} = $_[1]; }
 sub FETCH	{ return ${$_[0]}; }
#-------------------------------------------------
 package Net::MirrorDir;
 use Net::FTP;
 use vars '$AUTOLOAD';
 $Net::MirrorDir::VERSION		= '0.20';
 $Net::MirrorDir::_connection	= undef;
#-------------------------------------------------
 sub new
 	{
 	my ($class, %arg) = @_;
 	my $self =
 		{
 		_ftpserver	=> $arg{ftpserver}	|| warn("missing ftpservername"),
 		_user		=> $arg{user}	|| warn("missing username"),
 		_pass		=> $arg{pass}	|| warn("missing password"),
 		_timeout		=> $arg{timeout}	|| 30,
 		_connection	=>
 $Net::MirrorDir::_connection	|| $arg{connection} || undef,
 		_debug		=> defined($arg{debug}) ? $arg{debug} : 1
 		};
 	bless($self, $class || ref($class));
 	tie($self->{_localdir},	"Net::MirrorDir::LocalDir",		$self);
 	tie($self->{_remotedir},	"Net::MirrorDir::RemoteDir",	$self);
 	tie($self->{_exclusions},	"Net::MirrorDir::Exclusions",	$self);
 	tie($self->{_subset},	"Net::MirrorDir::Subset",		$self);
 	tie(
 		$self->{_connection},
 		"Net::MirrorDir::Connection",
 		\$Net::MirrorDir::_connection
 		);
 	$self->{_localdir}		= $arg{localdir}	|| '.';
 	$self->{_remotedir}	= $arg{remotedir}	|| '';
 	$self->{_exclusions}	= $arg{exclusions}	|| [];
 	$self->{_subset}		= $arg{subset}	|| [];
	$self->_Init(%arg) if(__PACKAGE__ ne ref($self));
 	return $self;
 	}
#-------------------------------------------------
 sub _Init
	{
	warn("\n\ncall to abstract method _Init() from package: " . ref($_[0]) . "\n");
 	return(0);
	}
#------------------------------------------------
 sub Connect
 	{
 	my ($self) = @_;
 	return($Net::MirrorDir::_connection) if($self->IsConnection());
 	eval
 		{
 	 	$Net::MirrorDir::_connection = Net::FTP->new(
 			$self->{_ftpserver},
 			Debug	=> $self->{_debug},
 			Timeout	=> $self->{_timeout},
 			) or warn("Cannot connect to $self->{_ftpserver} : $@\n");
 		if($Net::MirrorDir::_connection->login($self->{_user}, $self->{_pass}))
 			{
 		 	$Net::MirrorDir::_connection->binary();
 			}
 		else
 			{
 			$Net::MirrorDir::_connection->quit();
 			$Net::MirrorDir::_connection = undef;
 			print("\nerror in login\n") if($self->{_debug});
 			return 0;
 			}
 		return 1;
 		};
 	}
#-------------------------------------------------
 sub IsConnection
 	{
 	return eval { $Net::MirrorDir::_connection->pwd(); };
 	}
#-------------------------------------------------
 sub Quit
 	{
 	my ($self) = @_;
 	$Net::MirrorDir::_connection->quit() if($self->IsConnection());
 	$Net::MirrorDir::_connection = undef;
 	return 1;
 	}
#-------------------------------------------------
 sub ReadLocalDir
 	{
 	my ($self, $dir) = @_;
 	$dir ||= $self->{_localdir};
 	return({}, {}) unless(-d $dir);
 	$self->{_localfiles} = {};
 	$self->{_localdirs} = {};
 	$self->{_readlocaldir} = sub
 		{
 		my ($self, $p) = @_;
 		if(-f $p)
 			{
 			if(!@{$self->{_regex_subset}})
 				{
 				$self->{_localfiles}{$p} = 1;
 				return($self->{_localfiles}, $self->{_localdirs});
 				}
 			for(@{$self->{_regex_subset}})
 				{
 				if($p =~ $_)
 					{
 					$self->{_localfiles}{$p} = 1;
 					last;
 					}
 				}
 			return($self->{_localfiles}, $self->{_localdirs});
 			}
 		elsif(-d $p)
 			{
 			$self->{_localdirs}{$p} = 1;
 			opendir(PATH, $p) or die("error in opendir $p $!\n");
 			my @files = grep { $_ ne '.' and $_ ne '..' } readdir(PATH);
 			closedir(PATH);
 			for my $file (@files)
 				{
 				next if(grep { $file =~ $_ } @{$self->{_regex_exclusions}});
 				$self->{_readlocaldir}->($self, "$p/$file");
 				}
 			return($self->{_localfiles}, $self->{_localdirs});
 			}
 		warn("$p is neither a file nor a directory\n");
		return($self->{_localfiles}, $self->{_localdirs});
 		};
 	opendir(PATH, $dir) or die("error in opendir $dir $!\n");
 		my @files = grep { $_ ne '.' and $_ ne '..' } readdir(PATH);
 	closedir(PATH);
	for my $file (@files)
 		{
 		next if(grep { $file =~ $_ } @{$self->{_regex_exclusions}});
 		$self->{_readlocaldir}->($self, "$dir/$file");
 		}
 	return($self->{_localfiles}, $self->{_localdirs});
 	}
#-------------------------------------------------
 sub ReadRemoteDir
 	{
 	my ($self, $dir) = @_;
 	$dir ||= $self->{_remotedir};
 	return({}, {}) unless(eval { $Net::MirrorDir::_connection->cwd($dir); });
 	return({}, {}) unless($Net::MirrorDir::_connection->cwd());
 	$self->{_remotefiles} = {};
 	$self->{_remotedirs} = {};
 	$self->{_readremotedir} = sub
 		{
 		my ($self, $p) = @_;
 		my (@info, $name, $np, $ra_lines);
 		my $count = 0;
 		until($ra_lines = $Net::MirrorDir::_connection->dir($p) || ++$count > 3)
 			{
			$self->Connect() unless($Net::MirrorDir::_connection->abort());
 			}
 		if($self->{_debug})
 			{
 			print("\nreturnvalues from \n");
 			print("$_\n") for(@{$ra_lines});
 			}
 		for my $line (@{$ra_lines})
 			{
			@info = split(/\s+/, $line);
 			$name = $info[$#info];
 			next if($name eq '.' || $name eq '..');
 			$np = "$p/$name";
			next if(grep { $np =~ $_ } @{$self->{_regex_exclusions}});
 			if($line =~ m/^-/)
 				{
 				$self->{_remotefiles}{$np} = 1
 					unless(@{$self->{_regex_subset}});
 				for(@{$self->{_regex_subset}})
 					{
 					if($np =~ $_)
 						{
 						$self->{_remotefiles}{$np} = 1;
 						last;
 						}
 					}
 				}
 			elsif($line =~ m/^d/)
 				{
 				$self->{_remotedirs}{$np} = 1;
 				$self->{_readremotedir}->($self, $np);
 				}
 			else
 				{
 				warn("error can not get info: $line\n");
 				}
 			}
		return($self->{_remotefiles}, $self->{_remotedirs});
 		};
 	return $self->{_readremotedir}->($self, $dir);
 	}
#-------------------------------------------------
 sub LocalNotInRemote
 	{
 	my ($self, $rh_lp, $rh_rp) = @_;
 	my @lnir = ();
 	my $rp;
 	for my $lp (keys(%{$rh_lp}))
 		{
 		$rp = $lp;
 		$rp =~ s!$self->{_regex_localdir}!$self->{_remotedir}!;
 		push(@lnir, $lp) unless(defined($rh_rp->{$rp}));
 		}
 	return \@lnir;
 	}
#-------------------------------------------------
 sub RemoteNotInLocal
 	{
 	my ($self, $rh_lp, $rh_rp) = @_;
 	my @rnil = ();
 	my $lp;
 	for my $rp (keys(%{$rh_rp}))
 		{
 		$lp = $rp;
 		$lp =~ s!$self->{_regex_remotedir}!$self->{_localdir}!;
 		push(@rnil, $rp) unless(defined($rh_lp->{$lp}));
 		}
 	return \@rnil;
 	}
#-------------------------------------------------
 sub AUTOLOAD
 	{
 	no strict "refs";
 	my ($self, $value) = @_;
 	if($AUTOLOAD =~ m/.*::(?i:get)_*(\w+)/)
 		{
 		my $attr = lc($1);
 		$attr = '_' . $attr;
 		if(exists($self->{$attr}))
 			{
 			*{$AUTOLOAD} = sub
 				{
 				return $_[0]->{$attr};
 				};
 			return $self->{$attr};
 			}
 		else
 			{
 			warn("\nNO such attribute : $attr\n");
 			}
 		}
 	elsif($AUTOLOAD =~ m/.*::(?i:set)_*(\w+)/)
 		{
 		my $attr = lc($1);
 		$attr = '_' . $attr;
 		if(exists($self->{$attr}))
 			{
 			*{$AUTOLOAD} = sub
 				{
 				$_[0]->{$attr} = $_[1];
 				return 1;
 				};
 			$self->{$attr} = $value;
 			return 1;
 			}
 		else
 			{
 			warn("\nNO such attribute : $attr\n");
 			}
 		}
 	elsif($AUTOLOAD =~ m/.*::(?i:add)_*(\w+)/)
 		{
 		my $attr = lc($1);
 		$attr = '_' . $attr;
 		if(ref($self->{$attr}) eq "ARRAY")
 			{
 			*{$AUTOLOAD} = sub
 				{
 				$_[0]->{$attr} = [@{$_[0]->{$attr}}, $_[1]];
 				return 1;
 				};
 			$self->{$attr} = [@{$self->{$attr}}, $value];
 			return 1;
 			}
 		else
 			{
 			warn("\nNO such attribute or NOT a array reference: $attr\n");
 			}
 		}
 	else
 		{
 		warn("\nno such method : $AUTOLOAD\n");
 		}
 	return 0;
 	}
#-------------------------------------------------
 sub DESTROY
 	{
 	my ($self) = @_;
	print($self || ref($self) . "object destroyed\n") if($self->{_debug});
 	}
#-------------------------------------------------
1;
#-------------------------------------------------
__END__