view release on metacpan or  search on metacpan

lib/AnyEvent/FTP/Client.pm  view on Meta::CPAN

 use strict;
 use warnings;
 use AnyEvent;
 use AnyEvent::FTP::Client;
 
 my $client = AnyEvent::FTP::Client->new( passive => 1);
 
 my $done = AnyEvent->condvar;
 
 # connect to CPAN ftp server
 $client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->recv;
 
 # use binary mode
 $client->type('I')->recv;
 
 # download the file directly into a filehandle
 open my $fh, '>', 'perl-5.16.3.tar.gz';
 $client->retr('perl-5.16.3.tar.gz', $fh)->recv;

=head1 DESCRIPTION

This class provides an AnyEvent client interface to the File
Transfer Protocol (FTP).

=head1 ROLES

This class consumes these roles:

=over 4

=item *

L<AnyEvent::FTP::Role::Event>

=item *

L<AnyEvent::FTP::Client::Role::ResponseBuffer>

=item *

L<AnyEvent::FTP::Client::Role::RequestBuffer>

=back

=head1 EVENTS

For details on the event interface see L<AnyEvent::FTP::Role::Event>.

=head2 send

This event gets fired on every command sent to the remote server.  Keep
in mind that some methods of L<AnyEvent::FTP> may make multiple FTP commands
in order to implement their functionality (for example, C<recv>, C<stor>, etc).
One use of this event is to print out commands as they are sent for debugging:

 $client->on_send(sub {
   my($cmd, $arguments) = @_;
   $arguments //= '';
   # hide passwords
   $arguments = 'XXXX' if $cmd =~ /^pass$/i;
   say "CLIENT: $cmd $arguments";
 });

=head2 error

This event is emitted when there is a network error with the remote server.
It passes in a string which describes in human readable description of what
went wrong.

 $client->on_error(sub {
   my($message) = @_;
   warn "network error: $message";
 });

=head2 close

This event is emitted when the connection with the remote server is closed,
either due to an error, or when you send the FTP C<QUIT> command using the
C<quid> method.

 $client->on_close(sub {
   # called when connection closed
 });

=head2 greeting

This event gets fired on the first response returned from the server.  This
is usually a C<220> message which may or may not reveal the server software.

 $client->on_greeting(sub {
   # $res is a AnyEvent::FTP::Client::Response
   my($res) = @_;
   if($res->message->[0] =~ /ProFTPD/)
   {
     # detected a ProFTPD server
   }
 });

=head2 each_response

This event gets fired for each response returned from the server.  This can
be useful for printing the responses for debugging.

 $client->on_each_response(sub {
   # $res isa AnyEvent::FTP::Client::Response
   my($res) = @_;
   print "SERVER: $res\n";
 });

=head2 next_response

Works just like C<each_response> event, but only gets fired for the next response
received.

=head1 ATTRIBUTES

=head2 timeout

Timeout for the initial connection to the FTP server.  The default
is 30.

lib/AnyEvent/FTP/Client.pm  view on Meta::CPAN

really use these interfaces yourself.

=over 4

=item $client-E<gt>site-E<gt>microsoft

For commands specific to Microsoft's IIS FTP server.
See L<AnyEvent::FTP::Client::Site::Microsoft>.

=item $client-E<gt>site-E<gt>net_ftp_server

For commands specific to L<Net::FTPServer>.
See L<AnyEvent::FTP::Client::Site::NetFtpServer>.

=item $client-E<gt>site-E<gt>proftpd

For commands specific to proftpd.
See L<AnyEvent::FTP::Client::Site::Proftpd>.

=back

=head1 EXAMPLES

Here are some longer examples.  They are also included with the
L<AnyEvent::FTP> distribution in its C<example> directory.

=head2 fget.pl

Given a URL to a file, this script will fetch the file and store it
on your local machine.  If you use the C<-d> option you can see the
FTP commands and their responses as they happen.

 #!/usr/bin/perl
 
 use strict;
 use warnings;
 use autodie;
 use 5.010;
 use AnyEvent::FTP::Client;
 use URI;
 use URI::file;
 use Term::ProgressBar;
 use Term::Prompt qw( prompt );
 use Getopt::Long qw( GetOptions );
 use Path::Class qw( file );
 
 my $debug = 0;
 my $progress = 0;
 my $active = 0;
 
 GetOptions(
   'd' => \$debug,
   'p' => \$progress,
   'a' => \$active,
 );
 
 my $remote = shift;
 
 unless(defined $remote)
 {
   say STDERR "usage: perl fget.pl [ -d | -p ] [ -a ] remote";
   say STDERR "  where remote is a URL for a file on an FTP server";
   say STDERR "  and local is a local filename (optional) where to transfer it to";
   say STDERR "  -d (optional) prints FTP commands and responses";
   say STDERR "  -p (optional) displays a progress bar as the file uploads";
   say STDERR "  -a (optional) use active mode transfer";
   exit 2;
 }
 
 $remote = URI->new($remote);
 
 unless($remote->scheme eq 'ftp')
 {
   say STDERR "only FTP URLs are supported";
   exit 2;
 }
 
 unless(defined $remote->password)
 {
   $remote->password(prompt('p', 'Password: ', '', ''));
   say '';
 }
 
 do {
   my $from = $remote->clone;
   $from->password(undef);
 
   say "SRC: ", $from;
 };
 
 my @path = split /\//, $remote->path;
 my $fn = pop @path;
 if(-e $fn)
 {
   say STDERR "local file already exists";
   exit 2;
 }
 
 my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
 
 $ftp->on_send(sub {
   my($cmd, $arguments) = @_;
   $arguments //= '';
   $arguments = 'XXXX' if $cmd eq 'PASS';
   say "CLIENT: $cmd $arguments"
     if $debug;
 });
 
 $ftp->on_each_response(sub {
   my $res = shift;
   if($debug)
   {
     say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
   }
 });
 
 $ftp->connect($remote->host, $remote->port)->recv;
 $ftp->login($remote->user, $remote->password)->recv;
 $ftp->type('I')->recv;
 
 $ftp->cwd(join '/', '', @path)->recv;
 
 my $remote_size;
 
 if($progress)
 {
   my $listing = $ftp->list($fn)->recv;
   foreach my $class (qw( File::Listing File::Listing::Ftpcopy ))
   {
     my $parsed_listing = eval qq{ use $class; ${class}::parse_dir(\$listing->[0]) };
     next if $@;
     my ($name, $type, $size, $mtime, $mode) = @{ $parsed_listing->[0] };
     $remote_size = $size;
     last;
   }
 
   if(defined $remote_size)
   {
   }
   else
   {
     say STDERR "could not determine size of remote file, cannot provide progress bar";
     $progress = 0;
   }
 }
 
 open my $fh, '>', $fn;
 
 my $xfer = $ftp->retr($fn);
 my $pb;
 my $count = 0;
 
 $xfer->on_open(sub {
   my $handle = shift;
   $pb = Term::ProgressBar->new({ count => $remote_size })
     if $progress;
   $handle->on_read(sub {
     $handle->push_read(sub {
       print $fh $_[0]{rbuf};
       $pb->update($count += length($_[0]{rbuf})) if $pb;
       $_[0]{rbuf} = '';
     });
   });
 });
 
 $xfer->recv;
 
 close $fh;
 
 $ftp->quit->recv;

=head2 fls.pl

Here is a similar example, which does a directory listing on a FTP
directory URL.  If you use the C<-d> option to see the FTP commands
and their responses as they happen.  You can use the C<-l> option
to see the long form of the file listing.

 use strict;
 use warnings;
 use 5.010;
 use URI;
 use AnyEvent::FTP::Client;
 use Term::Prompt qw( prompt );
 use Getopt::Long qw( GetOptions );
 
 my $debug = 0;
 my $method = 'nlst';
 
 GetOptions(
   'd' => \$debug,
   'l' => sub { $method = 'list' },
 );
 
 my $ftp = AnyEvent::FTP::Client->new;
 
 if($debug)
 {
   $ftp->on_send(sub {
     my($cmd, $arguments) = @_;
     $arguments //= '';
     $arguments = 'XXXX' if $cmd eq 'PASS';
     say "CLIENT: $cmd $arguments";
   });
 
   $ftp->on_each_response(sub {
     my $res = shift;
     say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
   });
 
 }
 
 my $uri = shift;
 
 unless(defined $uri)
 {
   say STDERR "usage: perl fls.pl URL\n";
   exit 2;
 }
 
 $uri = URI->new($uri);
 
 unless($uri->scheme eq 'ftp')
 {
   say STDERR "only FTP URL accpeted";
   exit 2;
 }
 
 unless(defined $uri->password)
 {
   $uri->password(prompt('p', 'Password: ', '', ''));
   say '';
 }
 
 my $path = $uri->path;
 $uri->path('');
 
 $ftp->connect($uri);
 
 say $_ for @{ $ftp->$method($path)->recv };

=head2 fput.pl

This script uploads a local file to the remote given a local filename
and a remote FTP URL.

 #!/usr/bin/perl
 
 use strict;
 use warnings;
 use autodie;
 use 5.010;
 use AnyEvent::FTP::Client;
 use URI;
 use URI::file;
 use Term::ProgressBar;
 use Term::Prompt qw( prompt );
 use Getopt::Long qw( GetOptions );
 use Path::Class qw( file );
 
 my $debug = 0;
 my $progress = 0;
 my $active = 0;
 
 GetOptions(
   'd' => \$debug,
   'p' => \$progress,
   'a' => \$active,
 );
 
 my $local = shift;
 my $remote = shift;
 
 unless(defined $local && defined $remote)
 {
   say STDERR "usage: perl fput.pl [ -d | -p ] [ -a ] local remote";
   say STDERR "  where local is a local file";
   say STDERR "  and remote is a URL for a FTP server";
   say STDERR "  -d (optional) prints FTP commands and responses";
   say STDERR "  -p (optional) displays a progress bar as the file uploads";
   say STDERR "  -a (optional) use an active transfer instead of passive";
   exit 2;
 }
 
 $local  = file($local);
 $remote = URI->new($remote);
 
 unless($remote->scheme eq 'ftp')
 {
   say STDERR "only FTP URLs are supported";
   exit 2;
 }
 
 unless(defined $remote->password)
 {
   $remote->password(prompt('p', 'Password: ', '', ''));
   say '';
 }
 
 do {
   my $from = URI::file->new_abs($local);
   my $to = $remote->clone;
   $to->password(undef);
 
   say "SRC: ", $from;
   say "DST: ", $to;
 };
 
 my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
 
 $ftp->on_send(sub {
   my($cmd, $arguments) = @_;
   $arguments //= '';
   $arguments = 'XXXX' if $cmd eq 'PASS';
   say "CLIENT: $cmd $arguments"
     if $debug;
 });
 
 $ftp->on_each_response(sub {
   my $res = shift;
   if($debug)
   {
     say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
   }
 });
 
 
 $ftp->connect($remote->host, $remote->port)->recv;
 $ftp->login($remote->user, $remote->password)->recv;
 $ftp->type('I')->recv;
 
 if(defined $remote->path)
 {
   $ftp->cwd($remote->path)->recv;
 }
 
 open my $fh, '<', $local;
 binmode $fh;
 
 my $buffer;
 my $count;
 
 my $pb;
 
 my $xfer = $ftp->stor($local->basename);
 
 $xfer->on_open(sub {
   my $whandle = shift;
   $pb = Term::ProgressBar->new({ count => -s $fh })
     if $progress;
   $whandle->on_drain(sub {
     $pb->update($count) if $pb;
     my $ret = read $fh, $buffer, 1024 * 512;
     $count += $ret;
     if($ret > 0)
     {
       $whandle->push_write($buffer);
     }
     else
     {
       $pb->update($count) if $pb;
       $whandle->push_shutdown;
       close $fh;
     }
   });
 });
 
 $xfer->recv;
 
 $ftp->quit->recv;

=head1 SEE ALSO

=over 4

=item *

L<AnyEvent::FTP>

=item *

L<AnyEvent::FTP::Server>