r23370 - in /trunk/libnet-sftp-foreign-perl: Changes MANIFEST META.yml TODO debian/changelog lib/Net/SFTP/Foreign.pm lib/Net/SFTP/Foreign/Constants.pm lib/Net/SFTP/Foreign/Helpers.pm t/1_run.t t/3_convert.t t/common.pm t/data.txd t/data.txu
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Thu Jul 17 17:10:10 UTC 2008
Author: gregoa
Date: Thu Jul 17 17:10:07 2008
New Revision: 23370
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=23370
Log:
New upstream release.
Added:
trunk/libnet-sftp-foreign-perl/TODO
- copied unchanged from r23369, branches/upstream/libnet-sftp-foreign-perl/current/TODO
trunk/libnet-sftp-foreign-perl/t/3_convert.t
- copied unchanged from r23369, branches/upstream/libnet-sftp-foreign-perl/current/t/3_convert.t
trunk/libnet-sftp-foreign-perl/t/common.pm
- copied unchanged from r23369, branches/upstream/libnet-sftp-foreign-perl/current/t/common.pm
trunk/libnet-sftp-foreign-perl/t/data.txd
- copied unchanged from r23369, branches/upstream/libnet-sftp-foreign-perl/current/t/data.txd
trunk/libnet-sftp-foreign-perl/t/data.txu
- copied unchanged from r23369, branches/upstream/libnet-sftp-foreign-perl/current/t/data.txu
Modified:
trunk/libnet-sftp-foreign-perl/Changes
trunk/libnet-sftp-foreign-perl/MANIFEST
trunk/libnet-sftp-foreign-perl/META.yml
trunk/libnet-sftp-foreign-perl/debian/changelog
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Constants.pm
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm
trunk/libnet-sftp-foreign-perl/t/1_run.t
Modified: trunk/libnet-sftp-foreign-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/Changes?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/Changes (original)
+++ trunk/libnet-sftp-foreign-perl/Changes Thu Jul 17 17:10:07 2008
@@ -1,4 +1,15 @@
Revision history for Net::SFTP::Foreign
+
+1.42 Jul 17, 2008
+ - experimental support for resuming file transfers
+ - some typos fixed
+ - TODO added
+
+1.41 Jul 16, 2008
+ - add support for on the fly data conversions including
+ dos2unix and unix2dos
+ - copy_perm => 0 was being ignored in several methods (bug
+ report by Dave Tauzell)
1.40 Jun 24, 2008
- work around for servers that do not include the mandatory
Modified: trunk/libnet-sftp-foreign-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/MANIFEST?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/MANIFEST (original)
+++ trunk/libnet-sftp-foreign-perl/MANIFEST Thu Jul 17 17:10:07 2008
@@ -15,6 +15,11 @@
MANIFEST
META.yml Module meta-data (added by MakeMaker)
README
+TODO
t/1_run.t
t/2_pods.t
+t/3_convert.t
+t/data.txd
+t/data.txu
+t/common.pm
t/Net-SFTP-Foreign-Compat.t
Modified: trunk/libnet-sftp-foreign-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/META.yml?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/META.yml (original)
+++ trunk/libnet-sftp-foreign-perl/META.yml Thu Jul 17 17:10:07 2008
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Net-SFTP-Foreign
-version: 1.40
+version: 1.42
version_from: lib/Net/SFTP/Foreign.pm
installdirs: site
requires:
Modified: trunk/libnet-sftp-foreign-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/debian/changelog?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/debian/changelog (original)
+++ trunk/libnet-sftp-foreign-perl/debian/changelog Thu Jul 17 17:10:07 2008
@@ -1,7 +1,8 @@
-libnet-sftp-foreign-perl (1.40+dfsg-2) UNRELEASED; urgency=low
+libnet-sftp-foreign-perl (1.42+dfsg-1) UNRELEASED; urgency=low
* Replace uversionmangle with dversionmangle in debian/watch; adjust
debian/repack.sh.
+ * New upstream release.
-- gregor herrmann <gregoa at debian.org> Thu, 17 Jul 2008 19:07:09 +0200
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm Thu Jul 17 17:10:07 2008
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign;
-our $VERSION = '1.40';
+our $VERSION = '1.42';
use strict;
use warnings;
@@ -1374,9 +1374,11 @@
my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
my $copy_time = delete $opts{copy_time};
my $overwrite = delete $opts{overwrite};
+ my $resume = delete $opts{resume};
my $block_size = delete $opts{block_size} || $sftp->{_block_size};
my $queue_size = delete $opts{queue_size} || $sftp->{_queue_size};
my $dont_save = delete $opts{dont_save};
+ my $conversion = delete $opts{conversion};
my $oldumask = umask;
@@ -1387,6 +1389,11 @@
croak "'perm' and 'copy_perm' options can not be used simultaneously"
if (defined $perm and defined $copy_perm);
+
+ if ($resume and $conversion) {
+ carp "resume option is useless when data conversion has also been requested";
+ undef $resume;
+ }
my $numask;
@@ -1408,25 +1415,28 @@
$size = $a->size
}
else {
- if ($copy_time or $copy_perm ) {
- return undef;
+ return undef if ($copy_time or $copy_perm);
+ $size = -1;
+ }
+
+ if ($resume and $resume eq 'auto') {
+ undef $resume;
+ if (my @lstat = CORE::stat $local) {
+ if (defined $a and $a->mtime <= $lstat[9]) {
+ $resume = 1;
+ }
}
- $sftp->_set_status;
- $sftp->_set_error;
- $size = -1;
- }
-
- my $rfh = $sftp->open($remote, SSH2_FXF_READ);
- defined $rfh or return undef;
-
- my $rfid = $sftp->_rfid($rfh);
- defined $rfid or return undef;
-
- my $fh;
- my @msgid;
-
- unless ($dont_save) {
- if (!$overwrite and -e $local) {
+ }
+
+ my ($rfh, $fh);
+ my $askoff = 0;
+
+ if ($dont_save) {
+ $rfh = $sftp->open($remote, SSH2_FXF_READ);
+ defined $rfh or return undef;
+ }
+ else {
+ if (!$overwrite and !$resume and -e $local) {
$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
"local file $local already exists");
return undef
@@ -1441,20 +1451,50 @@
$perm = (0666 & $numask) unless defined $perm;
- my $lumask = ~$perm & 0666;
- umask $lumask;
-
- unlink $local;
-
- unless (CORE::open $fh, ">", $local) {
+ if ($resume) {
+ if (CORE::open $fh, '+<', $local) {
+ binmode $fh;
+ CORE::seek($fh, 0, 2);
+ $askoff = CORE::tell $fh;
+ if ($askoff < 0) {
+ # something is going really wrong here, fall
+ # back to non-resuming mode...
+ $askoff = 0;
+ undef $fh;
+ }
+ else {
+ if ($size >=0 and $askoff > $size) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_BIGGER_THAN_REMOTE,
+ "Couldn't resume transfer, local file is bigger than remote");
+ return undef;
+ }
+
+ $size == $askoff and return 1;
+ }
+ }
+ }
+
+ # we open the remote file so late in order to skip it when
+ # resuming an already completed transfer:
+ $rfh = $sftp->open($remote, SSH2_FXF_READ);
+ defined $rfh or return undef;
+
+ unless (defined $fh) {
+ my $lumask = ~$perm & 0666;
+ umask $lumask;
+
+ unlink $local;
+
+ unless (CORE::open $fh, '>', $local) {
+ umask $oldumask;
+ $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
+ "Can't open $local", $!);
+ return undef;
+ }
umask $oldumask;
- $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
- "Can't open $local", $!);
- return undef;
+
+ binmode $fh;
}
- umask $oldumask;
-
- binmode $fh;
# if ((0666 & ~$lumask) != $perm) { ...
# this optimization removed because it doesn't work for already
@@ -1470,10 +1510,16 @@
}
}
+ my $converter = _gen_converter $conversion;
+
+ my $rfid = $sftp->_rfid($rfh);
+ defined $rfid or return undef;
+
+ my @msgid;
my @askoff;
- my $askoff = 0;
- my $loff = 0;
+ my $loff = $askoff;
my $rfno = fileno($sftp->{ssh_in});
+ my $adjustment = 0;
my $selin = '';
my $n = 0;
@@ -1492,8 +1538,6 @@
$n++;
}
- # printf STDERR "queue_size: %d, askoff: %d, bs: %d \r", scalar(@msgid), $askoff, $block_size;
-
my $eid = shift @msgid;
my $roff = shift @askoff;
@@ -1513,7 +1557,8 @@
my $len = length $data;
if ($roff != $loff or !$len) {
- $sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL);
+ $sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL,
+ "remote packet received is too small" );
last;
}
@@ -1523,14 +1568,17 @@
$askoff = $loff;
}
- if (defined $cb) {
+ my $adjustment_before = $adjustment;
+ $adjustment += $converter->($data) if $converter;
+
+ if (length($data) and defined $cb) {
# $size = $loff if ($loff > $size and $size != -1);
- $cb->($sftp, $data, $roff, $size);
+ $cb->($sftp, $data, $roff + $adjustment_before, $size + $adjustment);
last if $sftp->error;
}
- unless ($dont_save) {
+ if (length($data) and !$dont_save) {
unless (print $fh $data) {
$sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
"unable to write data to local file $local", $!);
@@ -1542,6 +1590,42 @@
$sftp->_get_msg for (@msgid);
return undef if $sftp->error;
+
+ # if a converter is in place, and aditional call has to be
+ # performed in order to flush any pending buffered data
+ if ($converter) {
+ my $data = '';
+ my $adjustment_before = $adjustment;
+ $adjustment += $converter->($data);
+
+ if (length($data) and defined $cb) {
+ # $size = $loff if ($loff > $size and $size != -1);
+ $cb->($sftp, $data, $askoff + $adjustment_before, $size + $adjustment);
+ return undef if $sftp->error;
+ }
+
+ if (length($data) and !$dont_save) {
+ unless (print $fh $data) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
+ "unable to write data to local file $local", $!);
+ return undef;
+ }
+ }
+ }
+
+ # we call the callback one last time with an empty string;
+ if (defined $cb) {
+ my $data = '';
+ $cb->($sftp, $data, $askoff + $adjustment, $size + $adjustment);
+ return undef if $sftp->error;
+ if (length($data) and !$dont_save) {
+ unless (print $fh $data) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
+ "unable to write data to local file $local", $!);
+ return undef;
+ }
+ }
+ }
unless ($dont_save) {
unless (CORE::close $fh) {
@@ -1601,11 +1685,13 @@
my $umask = delete $opts{umask};
my $perm = delete $opts{perm};
- my $copy_perm = delete $opts{copy_perm} || delete $opts{copy_perms};
+ my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
my $copy_time = delete $opts{copy_time};
my $overwrite = delete $opts{overwrite};
+ my $resume = delete $opts{resume};
my $block_size = delete $opts{block_size} || $sftp->{_block_size};
my $queue_size = delete $opts{queue_size} || $sftp->{_queue_size};
+ my $conversion = delete $opts{conversion};
%opts and croak "invalid option(s) '".CORE::join("', '", keys %opts)."'";
@@ -1645,18 +1731,91 @@
return undef;
}
+ if ($resume and $resume eq 'auto') {
+ undef $resume;
+ if (my $rattrs = $sftp->stat($remote)) {
+ if ($rattrs->mtime >= $lmtime) {
+ $resume = 1;
+ }
+ }
+ }
+
$perm = $lmode & $numask if $copy_perm;
-
my $attrs = Net::SFTP::Foreign::Attributes->new;
$attrs->set_perm($perm) if defined $perm;
- my $rfh = $sftp->open($remote,
- SSH2_FXF_WRITE | SSH2_FXF_CREAT |
- ($overwrite ? SSH2_FXF_TRUNC : SSH2_FXF_EXCL),
- $attrs)
- or return undef;
-
- # open does not set the attributes for existant files so we do it again:
+ my $rfh;
+ my $readoff = 0;
+ my $converter = _gen_converter $conversion;
+ my $converted_input = '';
+
+ if ($resume) {
+ if (my $rattrs = $sftp->stat($remote)) {
+ $readoff = $rattrs->size;
+ if ($converter) {
+ # as size could change, we have to read and convert
+ # data until we reach the given position on the local
+ # file:
+ my $off = 0;
+ my $eof_t;
+ while (1) {
+ my $len = length $converted_input;
+ my $delta = $readoff - $off;
+ if ($delta <= $len) {
+ substr $converted_input, 0, $delta, '';
+ last;
+ }
+ else {
+ $off += $len;
+ if ($eof_t) {
+ $sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,
+ "Couldn't resume transfer, remote file is bigger than local");
+ return undef;
+ }
+ my $read = CORE::read($fh, $converted_input, $block_size * 4);
+ unless (defined $read) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
+ "Couldn't read from local file '$local'", $!);
+ return undef;
+ }
+ $lsize += $converter->($converted_input);
+ $read or $eof_t = 1;
+ }
+ }
+ }
+ else {
+ if ($readoff > $lsize) {
+ $sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,
+ "Couldn't resume transfer, remote file is bigger than local");
+ return undef;
+ }
+ unless (CORE::seek($fh, $readoff, 0)) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_SEEK_FAILED,
+ "seek operation on local file failed: $!");
+ return undef;
+ }
+ }
+ if ($readoff == $lsize) {
+ if (defined $perm and $rattrs->perm != $perm) {
+ return $sftp->setstat($remote, $attrs);
+ }
+ return 1;
+ }
+ $rfh = $sftp->open($remote, SSH2_FXF_WRITE)
+ or return undef;
+ }
+ }
+
+ unless (defined $rfh) {
+ $rfh = $sftp->open($remote,
+ SSH2_FXF_WRITE | SSH2_FXF_CREAT |
+ ($overwrite ? SSH2_FXF_TRUNC : SSH2_FXF_EXCL),
+ $attrs)
+ or return undef;
+ }
+
+ # in some SFTP server implementations, open does not set the
+ # attributes for existant files so we do it again:
if (defined $perm) {
$sftp->fsetstat($rfh, $attrs)
or return undef;
@@ -1667,60 +1826,81 @@
my @msgid;
my @readoff;
- my $readoff = 0;
my $rfno = fileno($sftp->{ssh_in});
-
- OK: for (1) {
- my $eof;
- while (1) {
- if (!$eof and @msgid < $queue_size) {
- my $len = CORE::read $fh, my ($data), $block_size;
- unless (defined $len) {
- $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
- "Couldn't read from local file '$local'", $!);
- last OK;
- }
+ my ($eof, $eof_t);
+ # when a converter is used the EOF can become delayed by
+ # the buffering introduced, we use $eof_t to account for that.
+ OK: while (1) {
+ if (!$eof and @msgid < $queue_size) {
+ my ($data, $len);
+ if ($converter) {
+ if (!$eof_t and length $converted_input < $block_size) {
+ my $read = CORE::read($fh, my $input, $block_size * 4);
+ unless ($read) {
+ unless (defined $read) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
+ "Couldn't read from local file '$local'", $!);
+ last OK;
+ }
+ $eof_t = 1;
+ }
+ # the last time the $converter call is
+ # performed it receives an empty string
+ $lsize += $converter->($input);
+ $converted_input .= $input;
+ }
+ $data = substr($converted_input, 0, $block_size, '');
+ $len = length $data;
+ $eof = 1 if ($eof_t and !$len);
+ }
+ else {
+ $len = CORE::read($fh, $data, $block_size * 4);
+ unless ($len) {
+ unless (defined $len) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
+ "Couldn't read from local file '$local'", $!);
+ last OK;
+ }
+ $eof = 1;
+ }
+ }
+
+ my $nextoff = $readoff + $len;
+
+ if (defined $cb) {
+ $lsize = $nextoff if $nextoff > $lsize;
+ $cb->($sftp, $data, $readoff, $lsize);
+
+ last OK if $sftp->error;
+
+ $len = length $data;
+ $nextoff = $readoff + $len;
+ }
+
+ if (length $data) {
+ my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
+ int64 => $readoff, str => $data);
- my $nextoff = $readoff + $len;
-
- if (defined $cb) {
- $lsize = $nextoff if $nextoff > $lsize;
- $cb->($sftp, $data, $readoff, $lsize);
-
- last OK if $sftp->error;
-
- $len = length $data;
- $nextoff = $readoff + $len;
- }
-
- if ($len) {
- my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
- int64 => $readoff, str => $data);
-
- push @msgid, $id;
- push @readoff, $readoff;
- $readoff = $nextoff;
- }
- else {
- $eof = 1;
- }
- }
-
- last if ($eof and !@msgid);
-
- next unless ($eof
- or @msgid >= $queue_size
- or $sftp->_do_io(0));
-
- my $id = shift @msgid;
- my $loff = shift @readoff;
- unless ($sftp->_check_status_ok($id,
- SFTP_ERR_REMOTE_WRITE_FAILED,
- "Couldn't write to remote file")) {
- last OK;
- }
- }
- };
+ push @msgid, $id;
+ push @readoff, $readoff;
+ $readoff = $nextoff;
+ }
+ }
+
+ last if ($eof and !@msgid);
+
+ next unless ($eof
+ or @msgid >= $queue_size
+ or $sftp->_do_io(0));
+
+ my $id = shift @msgid;
+ my $loff = shift @readoff;
+ unless ($sftp->_check_status_ok($id,
+ SFTP_ERR_REMOTE_WRITE_FAILED,
+ "Couldn't write to remote file")) {
+ last OK;
+ }
+ }
CORE::close $fh;
@@ -2028,7 +2208,7 @@
# my $cb = delete $opts{callback};
my $umask = delete $opts{umask};
- my $copy_perm = delete $opts{copy_perm} || delete $opts{copy_perms};
+ my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
my $copy_time = delete $opts{copy_time};
my $block_size = delete $opts{block_size};
my $queue_size = delete $opts{queue_size};
@@ -2036,6 +2216,13 @@
my $newer_only = delete $opts{newer_only};
my $on_error = delete $opts{on_error};
my $ignore_links = delete $opts{ignore_links};
+ my $conversion = delete $opts{conversion};
+ my $resume = delete $opts{resume};
+
+ if ($resume and $conversion) {
+ carp "resume option is useless when data conversion has also been requested";
+ undef $resume;
+ }
# my $relative_links = delete $opts{relative_links};
@@ -2125,7 +2312,9 @@
queue_size => $queue_size,
block_size => $block_size,
copy_perm => $copy_perm,
- copy_time => $copy_time)) {
+ copy_time => $copy_time,
+ conversion => $conversion,
+ resume => $resume )) {
$count++;
return undef;
}
@@ -2161,7 +2350,7 @@
# my $cb = delete $opts{callback};
my $umask = delete $opts{umask};
- my $copy_perm = delete $opts{copy_perm} || delete $opts{copy_perms};
+ my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
my $copy_time = delete $opts{copy_time};
my $block_size = delete $opts{block_size};
my $queue_size = delete $opts{queue_size};
@@ -2169,6 +2358,8 @@
my $newer_only = delete $opts{newer_only};
my $on_error = delete $opts{on_error};
my $ignore_links = delete $opts{ignore_links};
+ my $conversion = delete $opts{conversion};
+ my $resume = delete $opts{resume};
# my $relative_links = delete $opts{relative_links};
@@ -2265,7 +2456,9 @@
queue_size => $queue_size,
block_size => $block_size,
perm => ($copy_perm ? $e->{a}->perm : 0777) & $mask,
- copy_time => $copy_time)) {
+ copy_time => $copy_time,
+ conversion => $conversion,
+ resume => $resume )) {
$count++;
return undef;
}
@@ -2638,7 +2831,7 @@
Net::SFTP::Foreign supports version 2 of the SSH protocol only.
-=head2 USAGE
+=head2 Usage
Most of the methods available from this package return undef on
failure and a true value or the requested data on
@@ -2848,6 +3041,21 @@
read and write requests are pipelined in order to maximize transfer
throughput. This option allows to set the maximum number of requests
that can be concurrently waiting for a server response.
+
+=item conversion =E<gt> $conversion
+
+on the fly data conversion of the file contents can be performed with
+this option. See L</On the fly data conversion> bellow.
+
+=item resume =E<gt> 1 | 'auto'
+
+resumes an interrupted transfer.
+
+If the C<auto> value is given, the transfer will be resumed only when
+the local file is newer than the remote one.
+
+C<get> transfers can not be resumed when a data conversion is in
+place.
=item callback =E<gt> $callback
@@ -2877,6 +3085,13 @@
}
}
+The callback will be called one last time with an empty data argument
+to indicate the end of the file transfer.
+
+The size argument can change between different calls as data is
+transferred (for instance, when on the fly data conversion is being
+performed or when the size of the file can not be retrieved with the
+C<stat> SFTP command before the data transfer starts).
=back
@@ -2926,6 +3141,18 @@
throughput. This option allows to set the maximum number of requests
that can be concurrently waiting for a server response.
+=item conversion =E<gt> $conversion
+
+on the fly data conversion of the file contents can be performed with
+this option. See L</On the fly data conversion> bellow.
+
+=item resume =E<gt> 1 | 'auto'
+
+resumes an interrupted transfer.
+
+If the C<auto> value is given, the transfer will be resumed only when
+the remote file is newer than the local one.
+
=item callback =E<gt> $callback
C<$callback> is a reference to a subrutine that will be called after
@@ -2936,11 +3163,19 @@
remote file; the offset from the beginning of the file in bytes; and
the total size of the file in bytes.
+The callback will be called one last time with an empty data argument
+to indicate the end of the file transfer.
+
+The size argument can change between different calls as data is
+transferred (for instance, when on the fly data conversion is being
+performed).
+
This mechanism can be used to provide status messages, download
progress meters, etc.
The C<abort> method can be called from inside the callback to abort
the transfer.
+
=back
@@ -3271,6 +3506,10 @@
=item queue_size =E<gt> $queue_size
+=item conversion =E<gt> $conversion
+
+=item resume =E<gt> $resume
+
see docs for C<get> method.
=back
@@ -3335,7 +3574,12 @@
=item queue_size =E<gt> $queue_size
+=item conversion =E<gt> $conversion
+
+=item resume =E<gt> $resume
+
see docs C<put> method docs.
+
=back
@@ -3589,6 +3833,44 @@
$sftp->symlink("foo.lnk" => $sftp->realpath("../bar"))
=back
+
+=head2 On the fly data conversion
+
+Some of the methods on this module allow to perform on the fly data
+conversion via the C<conversion> option that accepts the following
+values:
+
+=over 4
+
+=item conversion =E<gt> 'dos2unix'
+
+converts LF+CR line endings (as commonly used under MS-DOS) to LF
+(Unix).
+
+=item conversion =E<gt> 'unix2dos'
+
+converts LF line endings (Unix) to LF+CR (DOS).
+
+=item conversion =E<gt> sub { CONVERT $_[0] }
+
+when a callback is given, it is called repeatly as chunks of data
+become available and it has to change C<$_[0]> in place in order to
+perform the conversion.
+
+Also, the subroutine is called one last time with and empty data
+string to indicate that the transfer has finished, so that
+intermediate buffers could be flushed.
+
+Note that when writing conversion subroutines, special care has to be
+taken to handle sequences crossing chunk borders.
+
+=back
+
+The data conversion is always performed before any other callback
+subroutine is called.
+
+See the Wikipedia discussion on line endings for details about the
+different conventions: L<http://en.wikipedia.org/wiki/Newline>.
=head1 FAQ
@@ -3740,11 +4022,11 @@
=back
-Support for MS Windows OSs is still experimental!
-
Support for taint mode is experimental!
Support for plink is experimental!
+
+Support for transfer resuming is experimental!
Support for password/passphrase handling via Expect is also
experimental. On Windows it only works under the cygwin version of
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Constants.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Constants.pm?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Constants.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Constants.pm Thu Jul 17 17:10:07 2008
@@ -105,7 +105,10 @@
SFTP_ERR_LOCAL_BAD_OBJECT => 41,
SFTP_ERR_REMOTE_ALREADY_EXISTS => 42,
# SFTP_ERR_BAD_SSH_BINARY => 43,
- SFTP_ERR_ABORTED => 44
+ SFTP_ERR_ABORTED => 44,
+ SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL => 45,
+ SFTP_ERR_LOCAL_BIGGER_THAN_REMOTE => 46,
+ SFTP_ERR_LOCAL_SEEK_FAILED => 47,
);
for my $key (keys %constants) {
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm Thu Jul 17 17:10:07 2008
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Helpers;
-our $VERSION = '1.28';
+our $VERSION = '1.41';
use strict;
use warnings;
@@ -19,7 +19,9 @@
_glob_to_regex
_tcroak
_catch_tainted_args
- _debug);
+ _debug
+ _gen_converter
+ );
sub _do_nothing {}
@@ -188,5 +190,84 @@
}
}
+sub _gen_dos2unix {
+ my $previous;
+ my $done;
+ sub {
+ $done and die "Internal error: bad calling sequence for unix2dos transformation";
+ my $debug = ($Net::SFTP::Foreing::debug and $Net::SFTP::Foreing::debug & 128);
+ my $adjustment = 0;
+ for (@_) {
+ if ($debug) {
+ _debug ("before dos2unixunix2dos: previous: $previous, data follows...");
+ _hexdump($_);
+ }
+ if (length) {
+ if ($previous) {
+ $adjustment++;
+ $_ = "\x0d$_";
+ }
+ $adjustment -= $previous = s/\x0d\z//s;
+ $adjustment -= s/\x0d\x0a/\x0a/gs;
+ }
+ elsif ($previous) {
+ $previous = 0;
+ $done = 1;
+ $adjustment++;
+ $_ = "\x0d";
+ }
+ if ($debug) {
+ _debug ("after dos2unix: previous: $previous, adjustment: $adjustment, data follows...");
+ _hexdump($_);
+ }
+ return $adjustment;
+ }
+ }
+}
+
+sub _unix2dos {
+ my $debug = ($Net::SFTP::Foreing::debug and $Net::SFTP::Foreing::debug & 128);
+ if ($debug) {
+ _debug ("before unix2dos: data follows...");
+ _hexdump($_[0]);
+ }
+ my $adjustment = $_[0] =~ s/\x0a/\x0d\x0a/gs;
+ if ($debug) {
+ _debug ("before unix2dos: adjustment: $adjustment, data follows...");
+ _hexdump($_[0]);
+ }
+ $adjustment;
+}
+
+sub _gen_unix2dos { \&_unix2dos }
+
+sub _gen_converter {
+ my $conversion = shift;
+
+ return undef unless defined $conversion;
+
+ if (ref $conversion) {
+ if (ref $conversion eq 'CODE') {
+ return sub {
+ my $before = length $_[0];
+ $conversion->($_[0]);
+ length $_[0] - $before;
+ }
+ }
+ else {
+ croak "unsupported conversion argument"
+ }
+ }
+ elsif ($conversion eq 'dos2unix') {
+ return _gen_dos2unix;
+ }
+ elsif ($conversion eq 'unix2dos') {
+ return _gen_unix2dos
+ }
+ else {
+ croak "unknown conversion '$conversion'";
+ }
+}
+
1;
Modified: trunk/libnet-sftp-foreign-perl/t/1_run.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/t/1_run.t?rev=23370&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/t/1_run.t (original)
+++ trunk/libnet-sftp-foreign-perl/t/1_run.t Thu Jul 17 17:10:07 2008
@@ -7,107 +7,17 @@
#$Net::SFTP::Foreign::debug = 2;
+use lib "./t";
+use common;
+
use File::Spec;
use Cwd qw(getcwd);
-select STDERR;
-$|=1;
-select STDOUT;
-
-$ENV{PATH} = '/usr/bin:/bin' if ${^TAINT};
-
-my ($server, $sscmd, @ssh, $ssname, $windows);
-
-BEGIN {
- $windows = $^O =~ /MSWin32/i;
- if($windows) {
- $ssname = 'sftp-server.exe';
- my $pf;
- eval {
- require Win32;
- $pf = Win32::GetFolderPath(Win32::CSIDL_PROGRAM_FILES());
- };
- $pf = "C:/Program Files/" unless defined $pf;
-
- @ssh = ("$pf/openssh/bin/ssh.exe",
- "$pf/openssh/usr/bin/ssh.exe",
- "$pf/bin/ssh.exe",
- "$pf/usr/bin/ssh.exe");
- }
- else {
- $ssname = 'sftp-server';
- @ssh = qw( /usr/bin/ssh
- /usr/local/bin/ssh
- /usr/local/openssh/bin/ssh
- /opt/openssh/bin/ssh
- /opt/ssh/bin/ssh );
- }
-
- if (eval {require File::Which; 1}) {
- unshift @ssh, File::Which::where('ssh');
- }
- elsif ($^O !~ /MSWin32/i) {
- chomp(my $ssh = `which ssh`);
- unshift @ssh, $ssh if (!$? and $ssh);
- }
-
- SEARCH: for (@ssh) {
- my ($vol, $dir) = File::Spec->splitpath($_);
-
- my $up = File::Spec->rel2abs(File::Spec->catpath($vol, $dir, File::Spec->updir));
-
- for ( File::Spec->catfile($vol, $dir, $ssname),
- File::Spec->catfile($up, 'lib', $ssname),
- File::Spec->catfile($up, 'libexec', $ssname),
- File::Spec->catfile($up, 'sbin', $ssname),
- File::Spec->catfile($up, 'lib', 'openssh', $ssname),
- File::Spec->catfile($up, 'usr', 'lib', $ssname),
- File::Spec->catfile($up, 'usr', 'libexec', $ssname),
- File::Spec->catfile($up, 'usr', 'sbin', $ssname) ) {
-
- if (-x $_) {
- $sscmd = $_;
- diag "sftp-server found at $_\n";
- last SEARCH;
- }
- }
- }
-}
-
-sub filediff {
- my ($a, $b) = @_;
- open my $fa, "<", $a
- or die "unable to open file $a";
-
- open my $fb, "<", $b
- or die "unable to open file $b";
-
- binmode $fa;
- binmode $fb;
-
- while (1) {
- my $la = read($fa, my $da, 2048);
- my $lb = read($fb, my $db, 2048);
-
- return 1 unless (defined $la and defined $lb);
- return 1 if $la != $lb;
- return 0 if $la == 0;
- return 1 if $la ne $lb;
- }
-}
-
-sub mktestfile {
- my ($fn, $count, $data) = @_;
-
- open DL, '>', $fn
- or die "unable to create test data file $fn";
-
- print DL $data for (1..$count);
- close DL;
-}
+my $server; # = 'localhost';
+my $sscmd = sftp_server;
plan skip_all => "tests not supported on inferior OS"
- if ($windows and eval "no warnings; getlogin ne 'salva'");
+ if (is_windows and eval "no warnings; getlogin ne 'salva'");
plan skip_all => "sftp-server not found"
unless defined $sscmd;
More information about the Pkg-perl-cvs-commits
mailing list