# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Tk-Mirror.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 144; # use Test::More "no_plan"; BEGIN { use_ok('Tk::Mirror') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. #------------------------------------------------- use_ok('Tk'); #------------------------------------------------- my $mw = eval { MainWindow->new(); }; warn($@) if($@); #------------------------------------------------- SKIP: { skip("no tests without a valid screen\n", 142) unless(ref($mw) && $mw->isa('MainWindow')); #------------------------------------------------- $mw->title('Mirror Directories'); $mw->geometry('+5+5'); can_ok($mw, 'Mirror'); ok(my $mirror = $mw->Mirror( -localdir => 'TestA', -remotedir => '/authors/id/K/KN/KNORR/Remote/TestA', -user => 'anonymous', -ftpserver => 'www.cpan.org', -pass => 'create-soft@tiscali.de', -exclusions => ['CHECKSUMS'], -overwrite => 'older' )); #------------------------------------------------- # Net::MirrorDir Methods isa_ok($mirror->{upload}, 'Net::MirrorDir'); isa_ok($mirror->{download}, 'Net::MirrorDir'); for(qw/ _Init Connect IsConnection Quit ReadLocalDir ReadRemoteDir LocalNotInRemote RemoteNotInLocal AUTOLOAD DESTROY /) { can_ok($mirror->{upload}, $_); can_ok($mirror->{download}, $_); } #------------------------------------------------- # Net::UploadMirror methods isa_ok($mirror->{upload}, 'Net::UploadMirror'); can_ok($mirror->{upload}, $_) for(qw/ _Init Upload CheckIfModified UpdateLastModified StoreFiles MakeDirs DeleteFiles RemoveDirs CleanUp RtoL LtoR /); #------------------------------------------------- # Net::DownloadMirror methods isa_ok($mirror->{download}, 'Net::DownloadMirror'); can_ok($mirror->{download}, $_) for(qw/ _Init Download CheckIfModified UpdateLastModified StoreFiles MakeDirs DeleteFiles RemoveDirs CleanUp LtoR RtoL /); #------------------------------------------------- # Tk::Mirror methods isa_ok($mirror, 'Tk::Frame'); isa_ok($mirror, 'Tk::Mirror'); can_ok($mirror, $_) for(qw/ new GetChilds Populate CompareDirectories Label Download BrowseEntry Upload Entry StoreParams Dialog SetParams Scrolled UpdateAccess Button InsertLocalTree Advertise InsertRemoteTree Delegates InsertProperties grid InsertRemoteModifiedTimes Subwidget InsertLocalModifiedTimes InsertStoredValues InsertPaths DeletePaths DeleteProperties DESTROY /); #------------------------------------------------- ok($mirror->grid()); ok(my $rh_childs = $mirror->GetChilds()); my $sub_widget; for(keys(%{$rh_childs})) { ok($sub_widget = $mirror->Subwidget($_)); can_ok($sub_widget, "configure"); $sub_widget->configure( -font => "{Times New Roman} 14 {bold}", ); } for(qw/ TreeLocalDir TreeRemoteDir /) { ok($sub_widget = $mirror->Subwidget($_)); can_ok($sub_widget, "configure"); $sub_widget->configure( -background => "#FFFFFF", -width => 40, -height => 20, ); } for(qw/ bEntryUser EntryPass bEntryFtpServer bEntryLocalDir bEntryRemoteDir /) { ok($sub_widget = $mirror->Subwidget($_)); can_ok($sub_widget, "configure"); $sub_widget->configure( -background => "#FFFFFF", ); } #------------------------------------------------- skip("no tests with www.cpan.org\n", 9) unless($mirror->{download}->Connect()); ok($mirror->CompareDirectories()); ok($mirror->Download()); ok(-f $_) for( 'TestA/TestB/TestC/Dir1/test1.txt', 'TestA/TestB/TestC/Dir2/test2.txt', 'TestA/TestB/TestC/Dir2/test2.subset', 'TestA/TestB/TestC/Dir3/test3.txt', 'TestA/TestB/TestC/Dir4/test4.txt', 'TestA/TestB/TestC/Dir4/test4.exclusions', 'TestA/TestB/TestC/Dir5/test5.txt' ); # can only be tested with a valid FTP-Access # ok($mirror->Upload()); #------------------------------------------------- $mw->destroy(); } #-------------------------------------------------