mirror of https://github.com/fspc/dswim
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
93 lines
5.7 KiB
23 years ago
|
# 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;
|
||
|
|
}
|