Re: [MacPerl] Net::FTP + file truncation

[Jacques REBISCOUL <jacques.rebiscoul@ssti.fr>]

Ben Brewer wrote :
> 
> Hi!
> 
> I've been using the code below to successfully upload all the files in a
> folder on my mac to our web server.  Files over a certain length however
> (seems to be about 20k), are truncated when I check the new copies on the
> server.  Any thoughts on why this is and how to circumvent it would be most
> appreciated!
> 
> Thanks!
> 
> #local source for files to be uploaded
> chdir($dbDirectory);
> opendir(D, $dbDirectory)
>         or die "Could not open $dbDirectory: $!";
> 
> my $ftp = Net::FTP->new("$remoteHost");
> $ftp->login($usr, $pswd);
> $ftp->cwd($directory);
> 
> foreach my $fileToSend (readdir(D)) {
>         $ftp->put($fileToSend, $fileToSend)
>                 or die "Could not put $fileToSend\n";
> }
> 
> $ftp->quit();
> 
> ===== Want to unsubscribe from this list?
> ===== Send mail with body "unsubscribe" to macperl-request@macperl.org
Same problem for me.
It seems that connexion is closed before all data is sent. It may be because
the perl close on the data socket returns before all data are from the TCP socket are sent
and as ftp daemon on the sun receives a new command on the FTP command socket it
closes the data socket.
I have not found a way to test if all data are sent (they are in hidden buffers somewhere).
The solution has been to estimate time necessary to send around 20 Kb on the line, wait for
that amount before closing the data socket.
We also added the check of the size of the sent file to retry sending.

Here is an FTPM.pm file which adds a timer before closing the data socket.
Put this file in your directory and replace use Net::FTP by use FTPM.

If 15 seconds are not enough, increase it.

This should only be a replacement until the right correction is found...

# ::FTPM.pm
#
# Copyright (c) 1995 Graham Barr <gbarr@ti.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Documentation (at end) improved 1996 by Nathan Torkington <gnat@frii.com>.

# For Mac Perl :
# Modification pour le probleme de fichiers tronques sur ligne lente

package FTPM;

require 5.001;

use strict;
use vars qw(@ISA $VERSION);
use Carp;

# use Socket 1.3;
# use IO::Socket;
# use Time::Local;
# use Net::Cmd;
# use Net::Config;
use Net::FTP;
 
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
@ISA     = qw(Exporter Net::FTP);

sub new
{
 my $pkg  = shift;
 my $peer = shift;
 my %arg  = @_; 

 my $ftpm = $pkg->SUPER::new($peer,%arg) or return undef;

 $ftpm;
}

##
## User interface methods
##

sub put        { shift->_store_cmd("stor",@_) }
sub put_unique { shift->_store_cmd("stou",@_) }
sub append     { shift->_store_cmd("appe",@_) }

sub _store_cmd 
{
 my($ftpm,$cmd,$local,$remote) = @_;
 my($loc,$sock,$len,$buf,$localfd);
 local *FD;
 use File::Basename;

 $localfd = ref($local) ? fileno($local)
			: undef;

 unless(defined $remote)
  {
   croak 'Must specify remote filename with stream input'
	if defined $localfd;

   $remote = basename($local);
  }

 if(defined $localfd)
  {
   $loc = $local;
  }
 else
  {
   $loc = \*FD;

   unless(open($loc,"<$local"))
    {
     carp "Cannot open Local file $local: $!\n";
     return undef;
    }
  }

 if(($ftpm->type =~ /^I/) && !binmode($loc))
  {
   carp "Cannot binmode Local file $local: $!\n";
   return undef;
  }

 delete ${*$ftpm}{'net_ftp_port'};
 delete ${*$ftpm}{'net_ftp_pasv'};

 $sock = $ftpm->_data_cmd($cmd, $remote) or 
	return undef;

 while(1)
  {
   last unless $len = sysread($loc,$buf="",1024);

   unless($sock->write($buf,$len) == $len)
    {
     $sock->abort;
     close($loc)
	unless defined $localfd;
     return undef;
    }
  }

#-----------------------------------------------------------------------
# Modification to wait for all data to be sent before closing
#
 $sock->flush();

 sleep(15);
#
# End of modification
#------------------------------------------------------------------------
 $sock->close();

 close($loc)
	unless defined $localfd;

 ($remote) = $ftpm->message =~ /unique file name:\s*(\S*)\s*\)/
	if ('STOU' eq uc $cmd);

 return $remote;
}

1;

# END OF FILE

-- 
   Jacques REBISCOUL      S. S. T. I. 

31,Av. Champollion 31100 TOULOUSE FRANCE

    mailto:Jacques.Rebiscoul@ssti.fr

           http://www.ssti.fr

Tel:(33) 5 61 43 65 65 Fax:(33) 5 61 40 52 02

===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org