Debian System Wide Information Manager
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

93 lines
5.7 KiB

# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::F;
use Carp;
use strict;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(get);
# This is Net::FTP::get with minor modifications. Not all the features
# are used, but are kept, just in case they will be.
sub get
{
my($ftp,$remote,$local,$where) = @_;
my($loc,$len,$buf,$resp,$localfd,$data);
local *FD;
$| = 1;
$localfd = ref($local) ? fileno($local)
: undef;
($local = $remote) =~ s#^.*/##
unless(defined $local);
${*$ftp}{'net_ftp_rest'} = $where
if ($where);
delete ${*$ftp}{'net_ftp_port'};
delete ${*$ftp}{'net_ftp_pasv'};
$data = $ftp->retr($remote) or
return undef;
if(defined $localfd)
{
$loc = $local;
}
else
{
$loc = \*FD;
unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
{
carp "Cannot open Local file $local: $!\n";
$data->abort;
return undef;
}
}
if($ftp->type eq 'I' && !binmode($loc))
{
carp "Cannot binmode Local file $local: $!\n";
$data->abort;
return undef;
}
$buf = ''; my $amt = 0;
#print "\n";
do
{
$len = $data->read($buf,1024);
$amt = $len + $amt;
print "[$amt]\r";
}
while($len > 0 && syswrite($loc,$buf,$len) == $len);
close($loc)
unless defined $localfd;
$data->close(); # implied $ftp->response
return $local;
}