File Coverage

blib/lib/Net/FTP/blat.pm

Criterion	Covered	Total	%
statement	9	53	16.9
branch	0	18	0.0
condition	0	3	0.0
subroutine	3	5	60.0
pod	0	2	0.0
total	12	81	14.8

package Net::FTP::blat;

use strict;
use Carp;

use vars '$VERSION';

$VERSION = 0.03;

sub Net::FTP::slurp
# store a remote file to a scalar
# syntax: $ftpobj->slurp($remote_file_name [, $lvalue ] )
{
 my($ftp,$remote) = @_[0,1];
 my $target = ( exists($_[2])? \$_[2] : \(my $foo));

 my($len,$buf,$resp,$data);

 croak("Bad remote filename '$remote'\n")
	if $remote =~ /[\r\n]/s;

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

 unless( $data = $ftp->retr($remote)){
 	$^W and carp "could not retr [$remote]";
	$$target=undef;
	return undef;
 };

 $buf = '';
 my($count) = (0);

 my $blksize = ${*$ftp}{'net_ftp_blksize'};
 local $\; # Just in case

 my @pieces = ();
 while(
   $data->read($buf,$blksize)
 ){
   push @pieces, $buf;
  };

  $data->close(); # implied $ftp->response
  if (defined(wantarray)){
  $$target = my $result =  join('',@pieces);
  return $result
  };

  $$target = join('',@pieces);

};

sub Net::FTP::blat
# STOR a scalar to a remote file
# syntax: $ftpobj->blat($value,$remote)
{
 my($ftp,$remote) = @_[0,2];
 my $value = \$_[1];

 my($sock,$len,$buf);

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

 # ALLO
 $ftp->_ALLO( length $$value);

 croak("Bad remote filename '$remote'\n")
	if $remote =~ /[\r\n]/s;

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

 $sock = $ftp->_data_cmd('STOR', $remote) or
 	croak "failure of STOR [$remote] data_cmd";

 #
 #chunking really only makes sense when we're reading
 #from disk and sending. Since we're sending a scalar,
 #we can avoid multiple substr calls , each of which
 #will need to do a full FETCH on a tied scalar, and just
 #write the whole thing at once.
 #
 # my $blksize = ${*$ftp}{'net_ftp_blksize'};
 #
 # my($pos) = (0);
 #
 # while(
 #   $len = length ( $buf = substr ( $$value, $pos, $blksize))
 #  ){
 #
 #    my $wlen;
 #    unless(defined($wlen = $sock->write($buf,$len)) && $wlen == $len)
 #     {
 #      $sock->abort;
 #      croak "only wrote $wlen of $len  data to FTP data channel at [$remote]:$pos\n";
 #     }
 #     $pos += $len;
 #   }

     $len = length $$value;
     my $wlen;
     unless(defined($wlen = $sock->write($$value,$len))
         && $wlen == $len)
      {
       $sock->abort;
       croak "only wrote $wlen of $len  data to FTP data channel at [$remote] ";
      }

 $sock->close();

 $$value;

}


__END__