Open-ILS/src/support-scripts/test-scripts/ftp_ls.pl

   1 #!/usr/bin/perl -IOpen-ILS/src/perlmods/lib
   2
   3 use strict; use warnings;
   4
   5 use Data::Dumper;
   6
   7 use OpenILS::Utils::RemoteAccount;
   8 use IO::Scalar;
   9 use IO::File;
  10 use Text::Glob qw( match_glob );
  11 $Text::Glob::strict_leading_dot    = 0;
  12 $Text::Glob::strict_wildcard_slash = 0;
  13
  14 my $delay = 1;
  15
  16 my %config = (
  17     remote_host => 'example.org',
  18     remote_user => 'some_user',
  19     remote_password => 'some_user',
  20     remote_file => '/home/some_user/out/zzz_testfile',
  21 );
  22
  23 sub content {
  24     my $time = localtime;
  25     return <<END_OF_CONTENT;
  26
  27 This is a test file sent at:
  28 $time
  29
  30 END_OF_CONTENT
  31 }
  32
  33 my $x = OpenILS::Utils::RemoteAccount->new(
  34     remote_host => $config{remote_host},
  35     remote_user => $config{remote_user},
  36     content => content(),
  37 );
  38
  39 $Data::Dumper::Indent = 1;
  40 # print Dumper($x);
  41
  42 $delay and print "Sleeping $delay seconds\n" and sleep $delay;
  43
  44 $x->put({
  45     remote_file => $config{remote_file} . "1.$$",
  46     content     => content(),
  47 }) or die "ERROR: $x->error";
  48
  49 # print "\n\n", Dumper($x);
  50
  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>) {
  56     print $line;
  57 }
  58 close TEMP;
  59
  60 my $dir = '/home/' . $config{remote_user} . '/out';
  61 $delay and print "Sleeping $delay seconds\n" and sleep $delay;
  62
  63 my $glob6 = $dir . '/*Q*';
  64
  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);
  70
  71 my $mismatch = 0;
  72 my $found    = 0;
  73 my $i=0;
  74 print "\n\n";
  75 printf "      %50s | %s\n", "ls ({remote_file => '$dir'})", "ls ('$dir')";
  76 foreach (@res1) {
  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;
  81 }
  82
  83 print "\n";
  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.";
  87
  88 $mismatch = $found = $i = 0;
  89 print "\n\n";
  90 printf "      %50s | %s\n", "ls ('.')", "ls ()";
  91 foreach (@res4) {
  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;
  95 }
  96 print "\n";
  97 print "\nNumber of mismatches: $mismatch\n";
  98 $mismatch and warn "Different style calls to ls got different results.  Please check again.";
  99
 100 $x->debug(1);
 101 my $target = $res1[0] || $res3[0];
 102 my $slurp;
 103
 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});
 107
 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});
 111
 112 my $glob = '*t*';
 113 my @res5 = (match_glob($glob, @res4));
 114 print scalar(@res5) . " of " . scalar(@res4) . " files matching $glob :\n";
 115 $i = 0;
 116 foreach my $orig (@res4) {
 117     printf "%4d)%1s %s\n", ++$i, ((grep {$orig eq $_} @res5 )? '*' : ' '), $orig;
 118 }
 119 scalar(@res5) and print "\n* Matching file\n";
 120
 121 print scalar(@res6) . " of " . scalar(@res1) . " files matching $glob6 :\n";
 122 $i = 0;
 123 foreach my $orig (@res1) {
 124     printf "%4d)%1s %s\n", ++$i, ((grep {$orig eq $_} @res6 )? '*' : ' '), $orig;
 125 }
 126 scalar(@res6) and print "\n* Matching file\n";
 127
 128 print join("\n", @res6), "\n";
 129 print "\n\ndone\n";
 130 exit;
 131