#!/usr/bin/perl


	# Load the modules we will need
	use Net::FTP;
	use File::Listing qw(parse_dir);
	# We will need to open/write some files
	use FileHandle; 

	# Some defaults
	# Look for files under this age (in seconds),
	# I shall use 7 days
	$age	  = 7*24*60*60;

	# The name of your nearest CPAN host, you will
	# need to change this
	$CPANhost = 'CPAN';

	# The path to the CPAN/modules directory
	# You will probably need to CHANGE this
	$CPANpath = '/mirrors/CPAN/modules';

	# Create the initial connection
	$ftp = connection();

	# Retrieve a recursive directory listing
	@ls = $ftp->ls('-lR');

	# Set the transfer mode to binary
	$ftp->binary or
	    die "Cannot set binary mode: $!";

	# Create a list of files we want to get
	@files = ();
	foreach $file (parse_dir(\@ls)) {
	    my($name, $type, $size, $mtime, $mode) = @$file;

	    # We only want to process plain files
	    next unless($type eq 'f');

	    # Check age of file against $age
	    if($^T - $mtime < $age) {
		push(@files, $name);
	    }

	}

	# The maximum number of connections to make
	$max_connection = 4;
	$max_connection = @files
		if(@files < $max_connection);

	# Create a list of connections, we already have one
	@ftp = ($ftp);

	for($i = 1 ; $i < $max_connection ; $i++) {
	    my $ftp = connection();

	    $ftp->binary or
		die "Cannot set binary mode: $!";

	    push(@ftp, $ftp);
	}

	print "Using ",scalar(@ftp)," connections,\n";
	print " to download ",scalar(@files)," files.\n";

	# Keep a list of data connections
	@data = ();

	# Initialise the fdset to be empty
	$fdset = "";

	# Prime the ftp servers with RETR commands
	while(@ftp && @files) {
	    my $ftp  = shift @ftp;
	    my $file = shift @files;
	    my($data,$fh) = init_xfer($ftp, $file);
	
	    push(@data, [$data, $fh]);
	}

	# Close any unused connections
	while(@ftp) {
	    my $ftp  = shift @ftp;
	    $ftp->close or
		warn "Cannot close connection cleanly: $!";
	}

	# Loop while we have connections, connections will be closed
	# and removed from @data when xfer's finish and @files is empty

	while(@data) {
	    $nfound = select($rout=$fdset, undef, undef, undef);

	    next
		unless($nfound);

	    die "select: $!"
		if($nfound == -1);

	    my @d = @data;
	
	    # Empty @data, connections will be added back
	    # into @data if they are still in use

	    @data = ();

	    foreach $con (@d) {
		my($data,$fh) = @$con;

		# Do we have data waiting on this data
		# connection ?

		if(vec($rout, fileno($data),1)) {
		    my $buf = "";

		    # Read some data, this may block as there
		    # may not be 1024 bytes ready for reading
		    # but we cannot tell, If we want to
		    # reduce the possible blocking time then
		    # use a smaller number

		    my $l = $data->read($buf, 1024);

		    die "Error reading data: $!"
			if($l < 0);

		    if($l) {
			# Write the data to the local file

			syswrite($fh, $buf, $l)
		    }
		    else {
			# The data transfer is complete, do
			# the necessary ftp commands to
			# close the data connection

			my $ftp = finish_xfer($data, $fh);

			# If the are still files left to pull
			# then reuse this ftp connection
			# for another xfer

			if(@files) {
			    my $file = shift @files;
			    @$con = init_xfer($ftp, $file);
			}
			else {

			# else close the ftp connection
			# and remove it from @data

			    $ftp->close or
				warn "Cannot close connection cleanly: $!";

			   # undef $con denotes that the connection
			   # is no longer in use
			   undef $con;
			}
		    }
		}

		# If the connection is still in use then
		# place if back into @data

		push(@data, $con)
			if(defined $con);
	
	    }
	}

	# We are done !
	exit;

	# Create a new connection to the ftp server

	sub connection {
	    # Create a new NET::FTP object

	    # NOTE: I have also changed the timeout
	    # value to be 60 seconds

	    $ftp = Net::FTP->new($CPANhost, Timeout => 60) or
		 die "Cannot contact $CPANhost: $!";

	    # We shall login to the ftp server as anonymous
	    # Specifying a login id stops any netrc lookup

	    $ftp->login('anonymous') or
		die "Cannot login ($CPANhost):" . $ftp->message;

	    # Change the working directory

	    $ftp->cwd($CPANpath) or
		die "Cannot change directory ($CPANhost):" . $ftp->message;

	    $ftp;
	}

	# Initialise a file transfer

	sub init_xfer {
	    my($ftp,$file) = @_;

	    # Send the retr command, and get a file descriptor
	    # for the socket

	    my $data = $ftp->retr($file) or
		die "Cannot retrieve file '$file': $!";

	    # Locally store all files in the current
	    # directory

	    my $path = $file;
	    $path =~ s,.*/([^/]+)\Z,$1,;

	    # Open a filehandle to the local file

	    my $fh = FileHandle->new($path,"w") or
		die "Cannot open file '$path': $!";

	    print "Retrieving $file as $path ...\n";

	    # Add data connection into fdset for select()

	    vec($fdset, fileno($data),1) = 1;

	    ($data, $fh);
	}

	# Cleanup after a file transfer has completed

	sub finish_xfer {
	    my($data, $fh) = @_;

	    # Get the ftp command object

	    my $ftp = $data->cmd;

	    # Remove data connection from fdset for select()

	    vec($fdset, fileno($data),1) = 0;

	    # Close the data connection

	    $data->close or
		warn "Cannot close data connection: $!";

	    # Close the local file

	    close($fh) or
		warn "Cannot close filehandle: $!";

	    $ftp;
	}