package Slackware::Slackget::Network::Connection::FTP; use warnings; use strict; require Slackware::Slackget::Network::Connection ; use Time::HiRes ; require Net::FTP ; require File::Copy; require Slackware::Slackget::File ; =head1 NAME Slackware::Slackget::Network::Connection::FTP - This class encapsulate Net::FTP =head1 VERSION Version 1.0.0 =cut our $VERSION = '1.0.0'; our @ISA = qw() ; =head1 SYNOPSIS This class encapsulate Net::FTP, and provide some methods for the treatment of FTP requests. This class need the following extra CPAN modules : - Net::FTP - Time::HiRes use Slackware::Slackget::Network::Connection::FTP; my $foo = Slackware::Slackget::Network::Connection::FTP->new(); ... =cut sub new { my ($class,$url,$config) = @_ ; my $self = {}; # return undef if(!defined($config) && ref($config) ne 'Slackware::Slackget::Config'); # $self->{config} = $config ; return undef unless (is_url($self,$url)); $self->{DATA}->{conn} = new Net::FTP ($url); bless($self,$class); $self->parse_url($url) ; return $self; } =head1 CONSTRUCTOR =head2 new This class is not designed to be instanciate alone or used alone. You have to use the Slackware::Slackget::Network::Connection. =head1 FUNCTIONS =head2 __test_server This method test the rapidity of the mirror, by making a new connection to the server and logging in. Be aware of the fact that after testing the connection you will have a new connection (if you were previously connected the previous connection is closed). my $time = $connection->test_server() ; =cut sub __test_server { my $self = shift ; # print "[debug http] protocol : $self->{DATA}->{protocol}\n"; # print "[debug http] host : $self->{DATA}->{host}\n"; if(defined($self->{DATA}->{conn})) { $self->{DATA}->{conn}->close ; $self->{DATA}->{conn} = undef ; } # print "[debug http] Testing a FTP server: $self->{DATA}->{host}\n"; my $start_time = Time::HiRes::time(); # print "[debug http] \$start_time : $start_time\n"; $self->{DATA}->{conn} = Net::FTP->new($self->{DATA}->{host}) or return undef; $self->{DATA}->{conn}->login($self->{DATA}->{config}->{'network-parameters'}->{ftp}->{login},$self->{DATA}->{config}->{'network-parameters'}->{ftp}->{password}) or return undef; my $stop_time = Time::HiRes::time(); # print "[debug http] \$stop_time: $stop_time\n"; return ($stop_time - $start_time); } sub _connect { my $self = shift ; # print "[_connect] test de config\n"; # print "[_connect] config param is $self->{DATA}->{config}\n"; return undef if(!defined($self->{DATA}->{config}) && ref($self->{DATA}->{config}) ne 'Slackware::Slackget::Config') ; # print "[_connect] test de l'existence d'une connexion\n"; unless($self->{DATA}->{conn}) { # print "[_connect] pas de connexion : cr�tion\n"; $self->{DATA}->{conn} = Net::FTP->new($self->{DATA}->{host}) or return undef; # print "[_connect] login\n"; $self->{DATA}->{conn}->login($self->{DATA}->{config}->{'network-parameters'}->{ftp}->{login},$self->{DATA}->{config}->{'network-parameters'}->{ftp}->{password}) or return undef; } # print "[_connect] That's all folks\n"; return 1; } =head2 _test_current_directory [PRIVATE] This private methos is used internally each time you require a transfert, for testing if the current directory is the 'path' parameter of the DATA section of the current Connection object. Do that by sending a PWD command to the server and compare the result with $connection->path. $ftp->cwd('/any/remote/directory/') unless($connection->_test_current_directory) ; Due to the fact that this method is private and internal the example is not really explicit, please look at the code for more informations. =cut sub _test_current_directory { my $self = shift ; # print "test de connexion\n"; $self->_connect or return undef; # print "r�ertoire courant : ",$self->conn->pwd,"\n"; # print "path : $self->{DATA}->{path}\n"; my $tmp_path = $self->conn->pwd ; if( $self->{DATA}->{path}=~/^$tmp_path\/*$/) { return 1; } else { # print "CHANGEMENT\n"; $self->conn->cwd($self->{DATA}->{path}) or return undef; return 1; } } =head2 __get_file Download and return a given file. my $file = $connection->get_file('PACKAGES.TXT') ; Please note that the Net::FTP module doesn't support a method like that. So, this method is not an encapsulator like the one of HTTP.pm, and use Slackware::Slackget::File to return the content of the downloaded file. So you'd better to use fetch_file(). =cut sub __get_file { my ($self,$remote_file) = @_ ; $remote_file = $self->file unless(defined($remote_file)) ; srand (time ^ $$ ^ unpack "%L*", `ps axww | gzip`); my $name = $remote_file.'-' ; for(my $k=0;$k<=20;$k++){ $name .= (0..9,'a'..'f')[int(rand(15))]; } # print "[Slackware::Slackget::Network::Connection::FTP] temp filename is '$name'\n"; $self->_test_current_directory or return undef; $self->conn->get($remote_file,"/tmp/$name") or return undef; my $file = new Slackware::Slackget::File ("/tmp/$name",'file-encoding' => $self->{DATA}->{config}->{'file-encoding'}) or return undef ; return join "\n",$file->Get_file ; # return get($self->protocol().'://'.$self->host().'/'.$self->path().'/'.$remote_file); } =head2 __fetch_file Download and store a given file. $connection->fetch_file() ; # download the file $connection->file and store it at $config->{common}->{'update-directory'}/$connection->file, this way is not recommended or $connection->fetch_file($remote_file) ; # download the file $remote_file and store it at $config->{common}->{'update-directory'}/$connection->file, this way is not recommended or $connection->fetch_file('PACKAGES.TXT',"$config->{common}->{'update-directory'}/".$current_specialfilecontainer_object->id."/PACKAGES.TXT") ; # This is the recommended way. # This is equivalent to : $connection->fetch_file($remote_file,$local_file) ; This method return a Slackware::Slackget::Status object with the following object declaration : my $status = Slackware::Slackget::Status->new(codes => { 0 => "All goes well.\n", 1 => "An error occured " }); =cut sub __fetch_file { my ($self,$remote_file,$local_file) = @_ ; $remote_file = $self->file unless(defined($remote_file)); unless(defined($local_file)){ if(defined($self->{DATA}->{download_directory}) && -e $self->{DATA}->{download_directory}){ $remote_file=~ /([^\/]*)$/; $local_file = $self->{DATA}->{download_directory}.'/'.$1 ; } elsif(defined($self->{DATA}->{config})){ $remote_file=~ /([^\/]*)$/; $local_file = $self->{DATA}->{config}->{common}->{'update-directory'}.'/'.$1 ; } else{ warn "[Slackware::Slackget::Network::Connection::FTP] unable to determine the path to save $remote_file.\n"; return undef; } } # print "[debug ftp] save the fetched file (",$remote_file,") to $local_file\n"; $self->_test_current_directory or return undef; my $state = Slackware::Slackget::Status->new(codes => { 0 => "All goes well.\n", 1 => "An error occured, we recommend to change this server's host.\n" }); if($self->conn->get($remote_file,$local_file.'.part')) { File::Copy::move( $local_file.'.part' , $local_file ); $state->current(0); } else { $state->current(1); } return $state; } =head2 __fetch_all This method fetch all files declare in the "files" parameter of the constructor. $connection->fetch_all or die "Unable to fetch all files\n"; This method save all files in the $config->{common}->{'update-directory'} directory (so you have to manage yourself the files deletion/replacement problems) =cut sub __fetch_all { my $self = shift ; foreach (@{$self->files}){ $self->fetch_file($_) or return undef; } return 1 ; } =head2 conn An accessor which return the current Net::FTP connection object =cut sub conn { my $self = shift; return $self->{DATA}->{conn}; } =head1 AUTHOR DUPUIS Arnaud, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Slackware::Slackget You can also look for information at: =over 4 =item * Infinity Perl website L =item * slack-get specific website L =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS Thanks to Bertrand Dupuis (yes my brother) for his contribution to the documentation. =head1 COPYRIGHT & LICENSE Copyright 2005 DUPUIS Arnaud, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of Slackware::Slackget::Network::Connection::FTP