view release on metacpan or  search on metacpan

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

 # complete.  In real code you'd probably not
 # want to do this because your event loop may
 # not support blocking.
 $done->recv;

Same, but using recv to wait for each command to complete (not supported in all event loops):

 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.

=head2 passive

If set to true (the default) then data will be transferred using the
passive (PASV) command, meaning the server will open a port for the
client to connect to.  If set to false then data will be transferred
using data port (PORT) command, meaning the client will open a port
for the server to send to.

=head1 METHODS

Unless otherwise specified, these methods will return an AnyEvent condition variable
(AnyEvent->condvar) or an object that implements its interface (methods C<recv>, C<cb>).
On success the C<send> will be used on the condition variable, on failure C<croak> will be
used instead.  Unless otherwise specified the object sent (for both success and failure)
will be an instance of L<AnyEvent::FTP::Client::Response>.

As an example, here is a fairly thorough handling of a response to the standard FTP C<HELP>
command:

 $client->help->cb(sub {
   my $res = eval { shift->recv };
   if(my $error = $@)
   {
     # $error isa AnyEvent::FTP::Client::Response with a 4xx or 5xx
     # code
     my $code = $error->code;
     # the message component is always a list ref, even if
     # the response had just one message line
     my @msg  = @{ $error->message };
     # $error is stringified into something human readable when
     # it is streated as a string
     warn "error trying FTP HELP command: $error";
   }
   else
   {
     # $res isa AnyEvent::FTP::Client::Response with a 2xx or 3xx
     # code
     my $code = $res->code;
     # the message component is always a list ref, even if
     # the response had just one message line
     my @msg = @{ $res->message };

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

=head2 quit

 $client->quit;

Send the FTP C<QUIT> command and close the connection to the remote server.

=head2 site

 $client->site;

The C<site> method provides an interface to site specific FTP commands.  Many
FTP servers will support an extended set of commands using the standard FTP
C<SITE> command.  This command will not check to see if the site commands are
supported by the remote server, so it is up to you to determine if you can
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 *