1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
# $Net::SFTP::Foreign::debug = 17 + 64;
use lib "./t";
use common;
use File::Spec;
use Cwd qw(getcwd);
plan skip_all => "tests not supported on inferior OS"
if (is_windows and eval "no warnings; getlogin ne 'salva'");
my @new_args = new_args;
plan tests => 223;
use_ok('Net::SFTP::Foreign');
use Net::SFTP::Foreign::Constants qw(:flags);
$SIG{ALRM} = sub {
print STDERR "# timeout expired: your computer is too slow or some test is not finishing\n";
exit 1;
};
# don't set the alarm if we are being debugged!
alarm 300 unless exists ${DB::}{sub};
chdir 't';
my $lcwd = File::Spec->rel2abs('.');
for my $bs (7, 8, 9, 20, 1024, 4096) {
my $sftp = eval { Net::SFTP::Foreign->new(@new_args, block_size => $bs) };
diag($@) if $@;
ok (defined $sftp, "creating object");
unless (defined $sftp) {
diag "unable to create Net::SFTP::Foreign object, aborting tests";
exit 1;
}
ok (!$sftp->error, "sftp object created ok - $bs");
diag ($sftp->error) if $sftp->error;
my $rcwd = $sftp->realpath($lcwd);
ok ($sftp->setcwd($rcwd), "setcwd");
diag ($sftp->error) if $sftp->error;
ok($sftp->get('data.txu', 'copied.txd', conversion => 'unix2dos'), "get unix2dos - $bs");
diag ($sftp->error) if $sftp->error;
ok(!filediff('data.txd', 'copied.txd'), "get conversion unix2dos ok - $bs");
unlink 'copied.txd';
ok($sftp->get('data.txd', 'copied.txd', conversion => 'unix2dos'), "get unix2dos when already in dos format - $bs");
diag ($sftp->error) if $sftp->error;
ok(!filediff('data.txd', 'copied.txd'), "get conversion unix2dos when already is dos format ok - $bs");
unlink 'copied.txd';
ok($sftp->get('data.txd', 'copied.txu', conversion => 'dos2unix'), "get dos2unix - $bs");
diag ($sftp->error) if $sftp->error;
ok(!filediff('data.txu', 'copied.txu'), "get conversion dos2unix ok - $bs");
unlink 'copied.txu';
ok($sftp->put('data.txu', 'copied.txd', conversion => 'unix2dos'), "put unix2dos - $bs");
diag ($sftp->error) if $sftp->error;
ok(!filediff('data.txd', 'copied.txd'), "put conversion unix2dos ok - $bs");
# unlink 'copied.txd';
ok($sftp->put('data.txd', 'copied.txu', conversion => 'dos2unix'), "put dos2unix - $bs");
diag ($sftp->error) if $sftp->error;
ok(!filediff('data.txu', 'copied.txu'), "put conversion dos2unix ok - $bs");
# unlink 'copied.txu';
for my $r (1..3) {
my $trunc = int (2500 * rand);
truncate 'copied.txd', $trunc;
ok($sftp->put('data.txu', 'copied.txd', conversion => 'unix2dos', resume => 1),
"put unix2dos with resume - $bs, $r")
or diag $sftp->error;
ok(!filediff('data.txd', 'copied.txd'), "put conversion unix2dos with resume ok - $bs, $r")
or diag "truncation position: $trunc";
truncate 'copied.txu', $trunc;
ok($sftp->put('data.txd', 'copied.txu', conversion => 'dos2unix', resume => 1),
"put dos2unix with resume - $bs, $r")
or diag $sftp->error;
ok(!filediff('data.txu', 'copied.txu'), "put conversion dos2unix with resume ok - $bs, $r")
or diag "truncation position: $trunc";
truncate 'copied.txd', $trunc;
ok($sftp->put('data.txd', 'copied.txd', resume => 1),
"put with resume - $bs, $r")
or diag $sftp->error;
ok(!filediff('data.txd', 'copied.txd'), "put with resume ok - $bs, $r")
or diag "truncation position: $trunc";
truncate 'copied.txd', $trunc;
ok($sftp->get('data.txd', 'copied.txd', resume => 1),
"get with resume - $bs, $r")
or diag $sftp->error;
ok(!filediff('data.txd', 'copied.txd'), "get with resume ok - $bs, $r, $trunc")
# or exit 1;
or diag "truncation position: $trunc";
}
unlink 'copied.txu';
unlink 'copied.txd';
}
|
