view release on metacpan or  search on metacpan

lib/Tk/Mirror.pm  view on Meta::CPAN

# create-soft@tiscali.de
# All rights reserved!
#-------------------------------------------------
 package Tk::Mirror;
#-------------------------------------------------
 use strict;
 use Tk::Frame;
 use Net::UploadMirror 0.13;
 use Net::DownloadMirror 0.10;
 use Storable;
#-------------------------------------------------
 @Tk::Mirror::ISA = qw(Tk::Frame);
 $Tk::Mirror::VERSION = '0.06';
#-------------------------------------------------
 Construct Tk::Widget 'Mirror';
#-------------------------------------------------
 sub Populate
 	{
 	require Tk::Label;
 	require Tk::Entry;
 	require Tk::BrowseEntry;
 	require Tk::Tree;
 	require Tk::Button;
 	require Tk::Dialog;
 	my ($m, $args) = @_;
#-------------------------------------------------
 	if(-f 'para')
 		{
 		$m->{para} = retrieve('para');
 		}
 	else
 		{
 		$m->{para} = {};
 		}
 	for(qw/ 	-localdir
 		-remotedir
 		-ftpserver
 		-user
 		-pass
 		-debug
 		-timeout
 		-delete
 		-connection
 		-exclusions	
 		-subset
 		-filename
 		/)
 		{
 		$m->{para}{substr($_, 1)} = delete($args->{$_}) if(defined($args->{$_}));
 		}
 	$m->{upload}	= Net::UploadMirror->new(%{$m->{para}});
 	$m->{download}	= Net::DownloadMirror->new(%{$m->{para}});
 	$m->{overwrite}	= defined($args->{-overwrite}) ? delete($args->{-overwrite}) : 'none';
 	$m->SUPER::Populate($args);
#-------------------------------------------------
 	my $label_user	= $m->Label(
 		-text		=> 'Username ->',
 		)->grid(
 		-row		=> 0,
 		-column		=> 0,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{bentry_user}	= $m->BrowseEntry(
 		-variable		=> \$m->{para}{user},
 		-browsecmd	=> [\&UpdateAccess, $m, 'user'],
 		)->grid(
 		-row		=> 0,
 		-column		=> 3,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
	my $label_ftpserver = $m->Label(
 		-text		=> 'FTP-Server ->',
 		)->grid(
 		-row		=> 1,
 		-column		=> 0,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{bentry_ftpserver} = $m->BrowseEntry(
 		-variable		=> \$m->{para}{ftpserver},
 		-browsecmd	=> [\&UpdateAccess, $m, 'ftpserver'],
 		)->grid(
 		-row		=> 1,
 		-column		=> 3,
 		-columnspan	=> 3,
 		-sticky		=> 'nsew',
 		);
#-------------------------------------------------
 	my $label_pass	= $m->Label(
 		-text		=> 'Password ->',
 		)->grid(
 		-row		=> 2,
 		-column		=> 0,
 		-columnspan	=> 3,
 		-sticky		=> 'nsew',
 		);
#-------------------------------------------------
 	$m->{entry_pass} = $m->Entry(
 		-textvariable	=> \$m->{para}{pass},
 		-show		=> '*',
 		)->grid(
 		-row		=> 2,
 		-column		=> 3,
 		-columnspan	=> 3,
 		-sticky		=> 'nsew',
 		);
#-------------------------------------------------
 	my $label_local_dir = $m->Label(
 		-text		=> 'Localdirectory',
 		)->grid(
 		-row		=> 3,
 		-column		=> 0,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	my $label_remote_dir = $m->Label(
 		-text		=> 'Remotedirectory',
 		)->grid(
 		-row		=> 3,
 		-column		=> 3,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{bentry_local_dir} = $m->BrowseEntry(
 		-variable		=> \$m->{para}{localdir},
 		-browsecmd	=> [\&UpdateAccess, $m, 'localdir'],
 		)->grid(
 		-row		=> 4,
 		-column		=> 0,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{bentry_remote_dir} = $m->BrowseEntry(
 		-variable		=> \$m->{para}{remotedir},
 		-browsecmd	=> [\&UpdateAccess, $m, 'remotedir'],
 		)->grid(
 		-row		=> 4,
 		-column		=> 3,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{tree_local_dir} = $m->Scrolled(
 		"Tree",
 		-separator	=> '/',
 		-itemtype	=> 'text',
 		-selectmode	=> 'single',
 		)->grid(
 		-row		=> 5,
 		-column		=> 0,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{tree_remote_dir} = $m->Scrolled(
 		"Tree",
 		-separator	=> '/',
 		-itemtype	=> 'text',
 		-selectmode	=> 'single'
 		)->grid(
 		-row		=> 5,
 		-column		=> 3,
 		-columnspan	=> 3,
 		-sticky		=> 'nswe'
 		);
#-------------------------------------------------
 	$m->{label_overwrite} = $m->Label(
 		-text		=> 'overwrite'
 		)->grid(
 		-row		=> 6,
 		-column		=> 0,
 		-columnspan	=> 2,
 		-sticky		=> 'nswe'
 		);
 #------------------------------------------------
 	$m->{rbutton_none} = $m->Radiobutton(
 		-text		=> 'none',
 		-variable		=> \$m->{overwrite},
 		-value		=> 'none'
 		)->grid(
 		-row		=> 6,
 		-column		=> 2,
 		-sticky		=> 'nswe'
 		);
#-------------------------------------------------
 	$m->{rbutton_all} = $m->Radiobutton(
 		-text		=> 'all',
 		-variable		=> \$m->{overwrite},
 		-value		=> 'all',
 		)->grid(
 		-row		=> 6,
 		-column		=> 3,
 		-sticky		=> 'nwes'
 		);
#-------------------------------------------------
 	$m->{rbutton_older} = $m->Radiobutton(
 		-text		=> 'older',
 		-variable		=> \$m->{overwrite},
 		-value		=> 'older'
 		)->grid(
 		-row		=> 6,
 		-column		=> 4,
 		-sticky		=> 'nswe'
 		);
#-------------------------------------------------
 	$m->{button_upload} 	= $m->Button(
 		-text		=> 'Upload ->',
 		-command	=> [\&Upload, $m],
 		-state		=> 'disabled'
 		)->grid(
 		-row		=> 7,
 		-column		=> 0,
 		-columnspan	=> 2,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{button_compare} = $m->Button(
 		-text		=> 'Compare',
 		-command	=> [\&CompareDirectories, $m],
 		)->grid(
 		-row		=> 7,
 		-column		=> 2,
 		-columnspan	=> 2,
 		-sticky		=> 'nsew',
 		);
#-------------------------------------------------
 	$m->{button_download} = $m->Button(
 		-text		=> '<- Download',
 		-command	=> [\&Download, $m],
 		-state		=> 'disabled',
 		)->grid(
 		-row		=> 7,
 		-column		=> 4,
 		-columnspan	=> 2,
 		-sticky		=> 'nswe',
 		);
#-------------------------------------------------
 	$m->{childs} = {
 		'LabelUser'		=> $label_user,
 		'bEntryUser'		=> $m->{bentry_user},
 		'LabelFtpServer'		=> $label_ftpserver,
 		'bEntryFtpServer'		=> $m->{bentry_ftpserver},
 		'LabelPass'		=> $label_pass,
 		'EntryPass'		=> $m->{entry_pass},
 		'LabelLocalDir'		=> $label_local_dir,
 		'LabelRemoteDir'		=> $label_remote_dir,
 		'bEntryLocalDir'		=> $m->{bentry_local_dir},
 		'bEntryRemoteDir'		=> $m->{bentry_remote_dir},
 		'TreeLocalDir'		=> $m->{tree_local_dir},
 		'TreeRemoteDir'		=> $m->{tree_remote_dir},
 		'LabelOverwrite'		=> $m->{label_overwrite},
 		'rButtonNone'		=> $m->{rbutton_none},
 		'rButtonAll'		=> $m->{rbutton_all},
		'rButtonOlder'		=> $m->{rbutton_older},
 		'ButtonUpload'		=> $m->{button_upload},
 		'ButtonCompare'		=> $m->{button_compare},
 		'ButtonDownload'		=> $m->{button_download},
 		};
 	$m->Advertise($_ => $m->{childs}{$_}) for(keys(%{$m->{childs}})); 
 	$m->Delegates(
 		DEFAULT	=> $m->{tree_local_dir},
 		);	
 	$m->InsertStoredValues();
 	}
#-------------------------------------------------
 sub DESTROY
 	{
 	my ($self) = @_;
 	print($self || ref($self) . "object destroyed\n") if($self->{_debug});
 	}
#-------------------------------------------------
 sub GetChilds
 	{
 	return $_[0]->{childs};
 	}
#-------------------------------------------------
 sub SetParams
  	{
  	my ($self) = @_;
  	unless(-d $self->{para}{localdir})
 		{
 		$self->Dialog(
 			-text	=> "Localdirectory $self->{para}{localdir} not found",
 			-title	=> 'INPUT-ERROR'
 			)->Show();
 		return;
 		}
 	for(qw/user ftpserver pass remotedir/)
 		{
 		unless($self->{para}{$_})
 			{
 			$self->Dialog(
 				-text	=> "parameter: $_  undefined",
 				-title	=> 'INPUT-ERROR'