Net::MirrorDir - Perl extension for compare local-directories and remote-directories with each other

  use Net::MirrorDir;
  my $md = Net::MirrorDir->new(
 	ftpserver		=> "my_ftp.hostname.com",
 	user		=> "my_ftp_user_name",
 	pass		=> "my_ftp_password",
 	);
 my ($ref_h_local_files, $ref_h_local_dirs) = $md->ReadLocalDir();
 my ($ref_h_remote_files, $ref_h_remote_dirs) = $md->ReadRemoteDir();
 my $ref_a_remote_files_not_in_local = $md->RemoteNotInLocal(
 	$ref_h_local_files, 
 	$ref_h_remote_files
 	);
 my $ref_a_local_files_not_in_remote = $md->LocalNotInRemote(
 	$ref_h_local_files, 
 	$ref_h_remote_files
 	);
 $md->Quit();

 or more detailed
 my $md = Net::MirrorDir->new(
 	ftpserver		=> "my_ftp.hostname.com",
 	user		=> "my_ftp_user_name",
 	pass		=> "my_ftp_password",
 	localdir		=> "home/nameA/homepageA",
 	remotedir	=> "public",
 	debug		=> 1 # 1 for yes, 0 for no
 	timeout		=> 60 # default 30
 	connection	=> $ftp_object, # default undef
# "exclusions" default references to a empty array []
 	exclusions	=> ["private.txt", "Thumbs.db", ".sys", ".log"],
# "subset" default references to a empty array []
 	subset		=> [".txt, ".pl", ".html", "htm", ".gif", ".jpg", ".css", ".js", ".png"]
# or substrings in pathnames
#	exclusions	=> ["psw", "forbidden_code"]
#	subset		=> ["name", "my_files"]
# or you can use regular expressions
# 	exclusions	=> [qr/SYSTEM/i, $regex]
# 	subset		=> [qr/(?i:HOME)(?i:PAGE)?/, $regex]
 	);
 $md->SetLocalDir("home/name/homepage");
 print("hostname : ", $md->get_ftpserver(), "\n");
 $md->Connect();
 my ($ref_h_local_files, $ref_h_local_dirs) = $md->ReadLocalDir();
 if($md->{_debug})
 	{
 	print("local files : $_\n") for(sort keys %{$ref_h_local_files});
 	print("local dirs : $_\n") for(sort keys %{$ref_h_local_dirs});
 	}	
 my ($ref_h_remote_files, $ref_h_remote_dirs) = $md->ReadRemoteDir();
 if($md->{_debug})
 	{
 	print("remote files : $_\n") for(sort keys %{$ref_h_remote_files});
 	print("remote dirs : $_\n") for(sort keys %{$ref_h_remote_dirs});
 	}
 my $ref_a_local_files_not_in_remote = $md->LocalNotInRemote(
 	$ref_h_local_files, 
 	$ref_h_remote_files
 	);
 if($md->{_debug})
 	{
 	print("new local files : $_\n") for(@{$ref_a_local_files_not_in_remote});
 	}
 my $ref_a_local_dirs_not_in_remote = $md->LocalNotInRemote(
 	$ref_h_local_dirs, 
 	$ref_h_remote_dirs
 	);
 if($md->{_debug})
 	{
 	print("new local dirs : $_\n") for(@{$ref_a_local_dirs_not_in_remote});
 	}
 my $ref_a_remote_files_not_in_local = $md->RemoteNotInLocal(
 	$ref_h_local_files, 
 	$ref_h_remote_files
 	);
 if($md->{_debug})
 	{
 	print("new remote files : $_\n") for(@{$ref_a_remote_files_not_in_local});
 	}
 my $ref_a_remote_dirs_not_in_local = $md->RemoteNotInLocal(
 	$ref_h_local_dirs, 
 	$ref_h_remote_dirs
 	);
 if($md->{_debug})
 	{
 	print("new remote dirs : $_\n") for(@{$ref_a_remote_dirs_not_in_local});
 	}
 $md->Quit();

#*** MirrorDir.pm ***#
# Copyright (C) 2006 - 2009 by Torsten Knorr
# create-soft@freenet.de
# 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 <dir($p)>\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__