1 # RemoteSite::FTP.pm

     2 #

     3 #Copyright (c) 2000-2006, The Perl Foundation. All rights reserved.

     4 #This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

     5 #

     6 

     7 package RemoteSite::FTP::Experimental;

     8 

     9 use strict;

    10 

    11 use RemoteSite::FTP;

    12 use vars qw(@ISA);

    13 @ISA=("RemoteSite::FTP");

    14 

    15 sub DirList {

    16   my $self = shift;

    17   my $remoteDir = shift;

    18 

    19   print "Listing FTP directory $remoteDir\n" if ($self->{verbose});

    20 

    21   my $dirlist_retries = 3;

    22   

    23   $remoteDir =~ s{\\}{\/}g;   #convert back slashes to forward slashes

    24   

    25   my $retry;

    26   for ($retry = 0; $retry < $dirlist_retries; $retry++) {

    27 

    28     unless ($self->Connected()) {

    29       $self->Connect();

    30     }

    31 

    32     # The Net::FTP module that we're using here has two options for listing the contents 

    33     # of a directory. They are the 'ls' and 'dir' calls.

    34     # The 'ls' call is great, and just returns a list of the items. But, irritatingly, it

    35     # misses out directories: the returned list just contains names of *files*.

    36     # dir is better, in some ways, as it lists directories too, but its output format

    37     # varies from one FTP site to the next. So we have to stick with ls.

    38     print "About to call dir(\"$remoteDir\")\n" if ($self->{verbose});

    39     my %hash = $self->dir($remoteDir);

    40     my @items = keys %hash;

    41     @items = grep { $_ ne "." && $_ ne ".." } @items;

    42     @items = map { "$remoteDir/$_" } @items; # prepend the path as that's the output format

    43       # that is expected of this function

    44     return \@items;

    45   }

    46   die "Error: have tried to list \"$remoteDir\" $retry times with no success - giving up\n";

    47 }

    48 

    49 # Code from Net::FTP::Common v 4.0a

    50 sub dir {       

    51   my ($self, $directory) = @_;

    52 

    53   my $ftp = $self->{ftp};

    54 

    55   my $dir = $ftp->dir($directory);

    56   if (!defined($dir)) {

    57     return ();

    58   } else

    59   {

    60     my %HoH;

    61 

    62     # Comments were made on this code in this thread:

    63     # http://perlmonks.org/index.pl?node_id=287552

    64 

    65     foreach (@{$dir})

    66         {

    67 	      $_ = 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*]*)#;

    68 

    69         my $perm = $1;

    70         my $inode = $2;

    71         my $owner = $3;

    72         my $group = $4;

    73         my $size = $5;

    74         my $month = $6;

    75         my $day = $7;

    76         my $yearOrTime = $8;

    77         my $name = $9;

    78         my $linkTarget;

    79 

    80         if ( $' =~ m#\s*->\s*([A-Za-z0-9.-/]*)# )       # it's a symlink

    81                 { $linkTarget = $1; }

    82 

    83         $HoH{$name}{perm} = $perm;

    84         $HoH{$name}{inode} = $inode;

    85         $HoH{$name}{owner} = $owner;

    86         $HoH{$name}{group} = $group;

    87         $HoH{$name}{size} = $size;

    88         $HoH{$name}{month} = $month;

    89         $HoH{$name}{day} = $day;

    90         $HoH{$name}{yearOrTime} =  $yearOrTime;

    91         $HoH{$name}{linkTarget} = $linkTarget;

    92 

    93         }

    94   return(%HoH);

    95   }

    96 }

    97 

    98 

    99 1;

   100 

   101 =head1 NAME

   102 

   103 RemoteSite::FTP::Experimental.pm - Access a remote FTP site.

   104 

   105 =head1 DESCRIPTION

   106 

   107 C<RemoteSite::FTP::Experimental> is inherited from the abstract base class C<RemoteSite>, implementing the abstract methods required for transfer of files to and from a remote site when the remote site is an FTP server.

   108 

   109 This class differs from C<RemoteSite::FTP> only in using a different mechanism for listing the contents of directories on FTP sites.

   110 

   111 =head1 KNOWN BUGS

   112 

   113 None

   114 

   115 =head1 COPYRIGHT

   116 

   117 Copyright (c) 2000-2006, The Perl Foundation. All rights reserved.

   118 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

   119 

   120 =cut