###
###  Copyright 2000-2007 University of Illinois Board of Trustees
###  All rights reserved. 
###
###  PSGConf::Action::PackageManager::FTPArchive - General tools to use to get package info from an FTP Archive.
###
###
###  Campus Information Technologies and Educational Services
###  University of Illinois at Urbana-Champaign
###


package PSGConf::Action::PackageManager::FTPArchive;

use strict;

use PSGConf::Action::PackageManager;
use PSGConf::Data::Boolean;
use PSGConf::Data::Integer;
use PSGConf::Data::String;

use PSGConf::Util;
use File::Basename;
use Net::FTP;

our @ISA = qw(PSGConf::Action::PackageManager);

###############################################################################
###  configuration constructor
###############################################################################

sub conf
{
     my ($class, $psgconf) = @_;
     my ($self);

     $self = {};
     bless($self, $class);

     $psgconf->register_data(
          pkg_ftp_passive_enable     => PSGConf::Data::Boolean->new(
                              value => 0
                         ),
          pkg_ftp_timeout     => PSGConf::Data::Integer->new(
                              value => 120
                         ),
          pkg_ftp_list_method     => PSGConf::Data::String->new(
                              value => "ls"
                         )
	);

     return $self;
}

sub get_latest_version 
{
     my ($self, $psgconf, $pkg, $path, $regex) = @_;
     my (@files);
     my ($version) = '';

	# Return right away if we do not have all the information we need.
	return undef
		if ( ! length ($path) ||
			! length ($pkg) ||
			! length ($regex) );

     @files = $self->list_files_from_url($psgconf, $path, $regex);

	grep (/$regex/ &&
			($version=($self->ComparePkgs($version, $1)<0)? $1: $version),
		@files);

	### Now trim off the pkg name from the version.
	$version =~ s/^\Q${pkg}\E$self->{seperator}->[0]//;

     warn "\t* no updates found for package $pkg\n"
          if ( $psgconf->{verbose} && $version eq '' );

     return $version;
}

sub list_files_from_url
{
	my ($self, $psgconf, $path, $regex) = @_;
	my (@files, $url);

	# Return right away if we do not have all the information we need.
	return @files if ( ! length ($path) );

	foreach $url (split (/[\\\s]+/o, $path)) {

		grep (/^($regex)/ && (push @files, $url . $1),
			$self->_get_directory_listing($psgconf, $url));

		last if ( scalar @files );
	}

	return @files;
}

sub _parse_url {
	my ($url) = @_;
	my ($host, $dir, $file);

	grep (/ftp:\/\/([^\/]+)(.*\/)([^\/]+)?$/o 
		&& ($host=$1, $dir=$2, $file=$3),
		$url);

	return ($host, $dir, $file);
}

sub _get_directory_listing {
	my ($self, $psgconf, $url) = @_;
	my ($ftp, $cache, $method);
	local *FP;

	$cache = $url;
	$cache =~ s,/,::,g;

	$method = $psgconf->data_obj('pkg_ftp_list_method')->get();

	if ( ! defined $self->{$cache} ) {
		if (($ftp = &_go_2_ftpdir ($psgconf, $url))) {
			if ( ! ( @{$self->{$cache}} = $ftp->$method ) ) {
				warn "\tCould not read dir ($url)\n\t\t" . $ftp->message;
				return undef;
			}

			$ftp->quit;

			# parse out the last element in the ftp listing
			# (should be the filename).
			map { $_ =~ s/^.* //; } @{$self->{$cache}};
		}
	}

	return @{$self->{$cache}};
}

sub get_file_from_url {
	my ($self, $psgconf, $url) = @_;
	my ($file, $ftp);

	return undef if ( ! length ( $url ));

	$file = &basename($url);

	if (($ftp = &_go_2_ftpdir ($psgconf, $url))) {

		# Fetch the file.
		if ( ! $ftp->get($file, $psgconf->{tmpdir} . '/' . $file) ) {
			warn "Failed to get ($file) ", $ftp->message;
			$file = undef;
		}

		$ftp->quit;
	}

	return $file;
}

sub _go_2_ftpdir {
	my ($psgconf, $url) = @_;
	my ($host, $dir, $ftp);

	($host, $dir) = &_parse_url($url);

	if (($ftp=Net::FTP->new($host,
						Passive => $psgconf->data_obj('pkg_ftp_passive_enable')->get(),
						Timeout => $psgconf->data_obj('pkg_ftp_timeout')->get()))) {
		if ( $ftp->login( "ftp", "psgconf@" . $psgconf->data_obj('hostname')->get() )) {
			if ( $ftp->cwd($dir) ) {
				if ( ! $ftp->binary() ) {
					warn "\tCould not covert to binary mode\n\t\t" . $ftp->message;
					return undef;
				} 
			} else {
				warn "\tCould not cd\n\t\t" . $ftp->message;
				return undef;
			}
		} else {
			warn "\tCould not login\n\t\t" . $ftp->message;
			return undef;
		}
	} else {
		warn "\tCould not open ftp session to ($url) $@\n";
		return undef;
	}

	return $ftp;
}

###############################################################################
###  documentation
###############################################################################

1;

__END__

=head1 NAME

PSGConf::Action::PackageManager::FTPArchive - General tools to use to get package info from an FTP Archive.

=head1 SYNOPSIS

  use PSGConf::Action::PackageManager::FTPArchive;

  $psgconf->register_actions(
		PSGConf::Action::PackageManager::FTPArchive->new(
			'quiet'		=> 1
		),
		...
	);

=head1 DESCRIPTION

The B<PSGConf::Action::PackageManager::FTPArchive> module provides a B<PSGConf>
action class for updating packages.

The B<PSGConf::Action::PackageManager::FTPArchive> class is derived from the
B<PSGConf::Action::PackageManager> class, but it defines/overrides the 
following methods:

=over 4

=item I<get_latest_version($self, $psgconf, $pkg, $path, $regex)>

Find the latest version of a package from FTP Archive(s).

=item I<list_files_from_url($self, $psgconf, $path, $regex)>

Given an ftp list of ftp URLs, list all files that match the given regex.

=item I<get_file_from_url($self, $url)>

Download the URL given, file will be stored in C<psgconf>'s tmpdir.

=back

The constructor also registers the following data objects:

=over 4

=item I<pkg_ftp_passive_enable>

A B<PSGConf::Data::Boolean> object that determines if L<Net::FTP> will
use a Passive FTP connection.  Defaults to C<false>.

=item I<pkg_ftp_timeout>

A B<PSGConf::Data::Integer> object that determines how many seconds
L<Net::FTP> will use FTP connection timeout.  Defaults to C<120>.

=item I<pkg_ftp_list_method>

A B<PSGConf::Data::String> object that determines what Net::FTP method
to call to list the contents of a directory.  The default is C<ls>.  The
assumption is that the last element of each line is the filename.

=back

=head1 SEE ALSO

L<perl>

L<PSGConf>

L<PSGConf::Action>

L<PSGConf::Action::PackageManager>

L<PSGConf::Data::Boolean>

L<PSGConf::Data::Integer>

L<PSGConf::Data::String>

L<PSGConf::Util>

L<Net::FTP>

L<File::Basename>

=cut