summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Net/FTP/I.pm
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:57:31 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:57:31 +0000
commit320d8694fec25ed148613684543b5a0504a046ae (patch)
tree0ddcf933d3acd3c98a387fa2bf73d0554ca6e50d /Master/tlpkg/tlperl/lib/Net/FTP/I.pm
parent779e71f16ca01a6244b632b95bdb461fec163b34 (diff)
New tlperl part XIV
git-svn-id: svn://tug.org/texlive/trunk@21436 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Net/FTP/I.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Net/FTP/I.pm80
1 files changed, 80 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Net/FTP/I.pm b/Master/tlpkg/tlperl/lib/Net/FTP/I.pm
new file mode 100644
index 00000000000..449bb99eab6
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Net/FTP/I.pm
@@ -0,0 +1,80 @@
+##
+## Package to read/write on BINARY data connections
+##
+
+package Net::FTP::I;
+
+use vars qw(@ISA $buf $VERSION);
+use Carp;
+
+require Net::FTP::dataconn;
+
+@ISA = qw(Net::FTP::dataconn);
+$VERSION = "1.12";
+
+
+sub read {
+ my $data = shift;
+ local *buf = \$_[0];
+ shift;
+ my $size = shift || croak 'read($buf,$size,[$timeout])';
+ my $timeout = @_ ? shift: $data->timeout;
+
+ my $n;
+
+ if ($size > length ${*$data} and !${*$data}{'net_ftp_eof'}) {
+ $data->can_read($timeout)
+ or croak "Timeout";
+
+ my $blksize = ${*$data}{'net_ftp_blksize'};
+ $blksize = $size if $size > $blksize;
+
+ unless ($n = sysread($data, ${*$data}, $blksize, length ${*$data})) {
+ return undef unless defined $n;
+ ${*$data}{'net_ftp_eof'} = 1;
+ }
+ }
+
+ $buf = substr(${*$data}, 0, $size);
+
+ $n = length($buf);
+
+ substr(${*$data}, 0, $n) = '';
+
+ ${*$data}{'net_ftp_bytesread'} += $n;
+
+ $n;
+}
+
+
+sub write {
+ my $data = shift;
+ local *buf = \$_[0];
+ shift;
+ my $size = shift || croak 'write($buf,$size,[$timeout])';
+ my $timeout = @_ ? shift: $data->timeout;
+
+ # If the remote server has closed the connection we will be signal'd
+ # when we write. This can happen if the disk on the remote server fills up
+
+ local $SIG{PIPE} = 'IGNORE'
+ unless ($SIG{PIPE} || '') eq 'IGNORE'
+ or $^O eq 'MacOS';
+ my $sent = $size;
+ my $off = 0;
+
+ my $blksize = ${*$data}{'net_ftp_blksize'};
+ while ($sent > 0) {
+ $data->can_write($timeout)
+ or croak "Timeout";
+
+ my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent, $off);
+ return undef unless defined($n);
+ $sent -= $n;
+ $off += $n;
+ }
+
+ $size;
+}
+
+1;