diff -r 22486c9c7b15 -r 378360dbbdba releasing/cbrtools/perl/RemoteSite/FTP/Experimental.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/releasing/cbrtools/perl/RemoteSite/FTP/Experimental.pm Wed Jun 30 11:35:58 2010 +0800 @@ -0,0 +1,120 @@ +# RemoteSite::FTP.pm +# +#Copyright (c) 2000-2006, The Perl Foundation. All rights reserved. +#This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. +# + +package RemoteSite::FTP::Experimental; + +use strict; + +use RemoteSite::FTP; +use vars qw(@ISA); +@ISA=("RemoteSite::FTP"); + +sub DirList { + my $self = shift; + my $remoteDir = shift; + + print "Listing FTP directory $remoteDir\n" if ($self->{verbose}); + + my $dirlist_retries = 3; + + $remoteDir =~ s{\\}{\/}g; #convert back slashes to forward slashes + + my $retry; + for ($retry = 0; $retry < $dirlist_retries; $retry++) { + + unless ($self->Connected()) { + $self->Connect(); + } + + # The Net::FTP module that we're using here has two options for listing the contents + # of a directory. They are the 'ls' and 'dir' calls. + # The 'ls' call is great, and just returns a list of the items. But, irritatingly, it + # misses out directories: the returned list just contains names of *files*. + # dir is better, in some ways, as it lists directories too, but its output format + # varies from one FTP site to the next. So we have to stick with ls. + print "About to call dir(\"$remoteDir\")\n" if ($self->{verbose}); + my %hash = $self->dir($remoteDir); + my @items = keys %hash; + @items = grep { $_ ne "." && $_ ne ".." } @items; + @items = map { "$remoteDir/$_" } @items; # prepend the path as that's the output format + # that is expected of this function + return \@items; + } + die "Error: have tried to list \"$remoteDir\" $retry times with no success - giving up\n"; +} + +# Code from Net::FTP::Common v 4.0a +sub dir { + my ($self, $directory) = @_; + + my $ftp = $self->{ftp}; + + my $dir = $ftp->dir($directory); + if (!defined($dir)) { + return (); + } else + { + my %HoH; + + # Comments were made on this code in this thread: + # http://perlmonks.org/index.pl?node_id=287552 + + foreach (@{$dir}) + { + $_ = m#([a-z-]*)\s*([0-9]*)\s*([0-9a-zA-Z]*)\s*([0-9a-zA-Z]*)\s*([0-9]*)\s*([A-Za-z]*)\s*([0-9]*)\s*([0-9A-Za-z:]*)\s*([\w*\W*\s*\S*]*)#; + + my $perm = $1; + my $inode = $2; + my $owner = $3; + my $group = $4; + my $size = $5; + my $month = $6; + my $day = $7; + my $yearOrTime = $8; + my $name = $9; + my $linkTarget; + + if ( $' =~ m#\s*->\s*([A-Za-z0-9.-/]*)# ) # it's a symlink + { $linkTarget = $1; } + + $HoH{$name}{perm} = $perm; + $HoH{$name}{inode} = $inode; + $HoH{$name}{owner} = $owner; + $HoH{$name}{group} = $group; + $HoH{$name}{size} = $size; + $HoH{$name}{month} = $month; + $HoH{$name}{day} = $day; + $HoH{$name}{yearOrTime} = $yearOrTime; + $HoH{$name}{linkTarget} = $linkTarget; + + } + return(%HoH); + } +} + + +1; + +=head1 NAME + +RemoteSite::FTP::Experimental.pm - Access a remote FTP site. + +=head1 DESCRIPTION + +C is inherited from the abstract base class C, implementing the abstract methods required for transfer of files to and from a remote site when the remote site is an FTP server. + +This class differs from C only in using a different mechanism for listing the contents of directories on FTP sites. + +=head1 KNOWN BUGS + +None + +=head1 COPYRIGHT + +Copyright (c) 2000-2006, The Perl Foundation. All rights reserved. +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut