1 #!/usr/bin/perl -IOpen-ILS/src/perlmods/lib
3 use strict; use warnings;
7 use OpenILS::Utils::RemoteAccount;
10 use Text::Glob qw( match_glob );
11 $Text::Glob::strict_leading_dot = 0;
12 $Text::Glob::strict_wildcard_slash = 0;
17 remote_host => 'example.org',
18 remote_user => 'some_user',
19 remote_password => 'some_user',
20 remote_file => '/home/some_user/out/zzz_testfile',
25 return <<END_OF_CONTENT;
27 This is a test file sent at:
33 my $x = OpenILS::Utils::RemoteAccount->new(
34 remote_host => $config{remote_host},
35 remote_user => $config{remote_user},
39 $Data::Dumper::Indent = 1;
42 $delay and print "Sleeping $delay seconds\n" and sleep $delay;
45 remote_file => $config{remote_file} . "1.$$",
47 }) or die "ERROR: $x->error";
49 # print "\n\n", Dumper($x);
51 my $file = $x->local_file;
52 my $rfile = $x->remote_file;
53 open TEMP, "< $file" or die "Cannot read tempfile $file: $!";
54 print "\n\ncontent from tempfile $file:\n";
55 while (my $line = <TEMP>) {
60 my $dir = '/home/' . $config{remote_user} . '/out';
61 $delay and print "Sleeping $delay seconds\n" and sleep $delay;
63 my $glob6 = $dir . '/*Q*';
65 my @res1 = grep {! /\/\.?\.$/} $x->ls({remote_file => $dir});
66 my @res2 = grep {! /\/\.?\.$/} $x->ls($dir);
67 my @res3 = grep {! /\/\.?\.$/} $x->ls();
68 my @res4 = grep {! /\/\.?\.$/} $x->ls('.');
69 my @res6 = $x->ls($glob6);
75 printf " %50s | %s\n", "ls ({remote_file => '$dir'})", "ls ('$dir')";
77 my $partner = @res2 ? shift @res2 : '';
78 $mismatch++ unless ($_ eq $partner);
79 $_ eq $rfile and $found++;
80 printf "%4d)%1s%50s %s %s\n", ++$i, ($_ eq $rfile ? '*' : ' '), $_, ($_ eq $partner ? '=' : '!'), $partner;
84 print ($found ? "* The file we just sent" : sprintf("Did not find the file we just sent: \n%58s", $rfile));
85 print "\nNumber of mismatches: $mismatch\n";
86 $mismatch and warn "Different style calls to ls got different results. Please check again.";
88 $mismatch = $found = $i = 0;
90 printf " %50s | %s\n", "ls ('.')", "ls ()";
92 my $partner = @res3 ? shift @res3 : '';
93 $mismatch++ unless ($_ eq $partner);
94 printf "%4d)%1s%50s %s %s\n", ++$i, ($_ eq $rfile ? '*' : ' '), $_, ($_ eq $partner ? '=' : '!'), $partner;
97 print "\nNumber of mismatches: $mismatch\n";
98 $mismatch and warn "Different style calls to ls got different results. Please check again.";
101 my $target = $res1[0] || $res3[0];
104 my $io = IO::Scalar->new(\$slurp);
105 print "Trying to read $target into an IO::Scalar\n";
106 $x->get({remote_file => $target, local_file => $io});
108 my $iofile = IO::File->new(">/tmp/io_file_sftp_test.tmp");
109 print "Trying to read $target into an IO::File\n";
110 $x->get({remote_file => $target, local_file => $iofile});
113 my @res5 = (match_glob($glob, @res4));
114 print scalar(@res5) . " of " . scalar(@res4) . " files matching $glob :\n";
116 foreach my $orig (@res4) {
117 printf "%4d)%1s %s\n", ++$i, ((grep {$orig eq $_} @res5 )? '*' : ' '), $orig;
119 scalar(@res5) and print "\n* Matching file\n";
121 print scalar(@res6) . " of " . scalar(@res1) . " files matching $glob6 :\n";
123 foreach my $orig (@res1) {
124 printf "%4d)%1s %s\n", ++$i, ((grep {$orig eq $_} @res6 )? '*' : ' '), $orig;
126 scalar(@res6) and print "\n* Matching file\n";
128 print join("\n", @res6), "\n";