File Coverage

blib/lib/Slackware/Slackget/Network/Connection/FTP.pm

Criterion	Covered	Total	%
statement	9	72	12.5
branch	0	44	0.0
condition	0	6	0.0
subroutine	3	11	27.2
pod	2	2	100.0
total	14	135	10.3

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