t/02-operation.t

   1 use Test::More;
   2 use strict;
   3 my $tests;
   4 BEGIN { $tests = 0 }
   5 use lib "lib";
   6
   7
   8 my $HAVE;
   9 BEGIN {
  10     # neither LibMagic nor MMagic tell them apart
  11     for my $package (
  12                      # "File::LibMagic",
  13                      "File::MMagic",
  14                     ) {
  15         $HAVE->{$package} = eval qq{ require $package; };
  16     }
  17 }
  18
  19 use Dumpvalue;
  20 use File::Basename qw(dirname);
  21 use File::Copy qw(cp);
  22 use File::Path qw(mkpath rmtree);
  23 use File::Rsync::Mirror::Recent;
  24 use File::Rsync::Mirror::Recentfile;
  25 use List::MoreUtils qw(uniq);
  26 use Storable;
  27 use Time::HiRes qw(time sleep);
  28 use YAML::Syck;
  29
  30 my $root_from = "t/ta";
  31 my $root_to = "t/tb";
  32 rmtree [$root_from, $root_to];
  33
  34 {
  35     my @serializers;
  36     BEGIN {
  37         @serializers = (
  38                         ".yaml",
  39                         ".json",
  40                         ".sto",
  41                         ".dd",
  42                        );
  43         $tests += @serializers;
  44         if ($HAVE->{"File::LibMagic"}||$HAVE->{"File::MMagic"}) {
  45             $tests += @serializers;
  46         }
  47     }
  48     mkpath $root_from;
  49     my $ttt = "$root_from/ttt";
  50     open my $fh, ">", $ttt or die "Could not open: $!";
  51     print $fh time;
  52     close $fh or die "Could not close: $!";
  53     my $fm;
  54     if ($HAVE->{"File::LibMagic"}) {
  55         $fm = File::LibMagic->new();
  56     } elsif ($HAVE->{"File::MMagic"}) {
  57         $fm = File::MMagic->new();
  58     }
  59     for my $s (@serializers) {
  60         my $rf = File::Rsync::Mirror::Recentfile->new
  61             (
  62              filenameroot   => "RECENT",
  63              interval       => q(1m),
  64              localroot      => $root_from,
  65              serializer_suffix => $s,
  66             );
  67         $rf->update($ttt,"new");
  68         if ($fm) {
  69             my $magic = $fm->checktype_filename("$root_from/RECENT-1m$s");
  70             ok($magic, sprintf
  71                ("Got a magic[%s] for s[%s]: [%s]",
  72                 ref $fm,
  73                 $s,
  74                 $magic,
  75                ));
  76         }
  77         my $content = do {open my $fh, "$root_from/RECENT-1m$s";local $/;<$fh>};
  78         $content = Dumpvalue->new()->stringify($content);
  79         my $want_length = 42; # or maybe 3 more
  80         substr($content,$want_length) = "..." if length $content > 3+$want_length;
  81         ok($content, "Got a substr for s[$s]: [$content]");
  82     }
  83 }
  84
  85 rmtree [$root_from, $root_to];
  86
  87 {
  88     # very small tree, aggregate it
  89     my @intervals;
  90     BEGIN {
  91         $tests += 16;
  92         @intervals = qw( 2s 4s 8s 16s 32s Z );
  93     }
  94     ok(1, "starting smalltree block");
  95     is 6, scalar @intervals, "array has 6 elements: @intervals";
  96     my $rf0 = File::Rsync::Mirror::Recentfile->new
  97         (
  98          aggregator     => [@intervals[1..$#intervals]],
  99          interval       => $intervals[0],
 100          localroot      => $root_from,
 101          rsync_options  => {
 102                             compress          => 0,
 103                             links             => 1,
 104                             times             => 1,
 105                             checksum          => 0,
 106                            },
 107         );
 108     for my $iv (@intervals) {
 109         for my $i (0..3) {
 110             my $file = sprintf
 111                 (
 112                  "%s/A%s-%02d",
 113                  $root_from,
 114                  $iv,
 115                  $i,
 116                 );
 117             mkpath dirname $file;
 118             open my $fh, ">", $file or die "Could not open '$file': $!";
 119             print $fh time, ":", $file, "\n";
 120             close $fh or die "Could not close '$file': $!";
 121             $rf0->update($file,"new");
 122         }
 123     }
 124     my $recent_events = $rf0->recent_events;
 125     # faking internals as if the contents were wide-spread in time
 126     for my $evi (0..$#$recent_events) {
 127         my $ev = $recent_events->[$evi];
 128         $ev->{epoch} -= 2**($evi*.25);
 129     }
 130     $rf0->write_recent($recent_events);
 131     $rf0->aggregate;
 132     my $filesize_threshold = 1750; # XXX may be system dependent
 133     for my $iv (@intervals) {
 134         my $rf = "$root_from/RECENT-$iv.yaml";
 135         my $filesize = -s $rf;
 136         # now they have $filesize_threshold+ bytes because they were merged for the
 137         # first time ever and could not be truncated for this reason.
 138         ok($filesize_threshold < $filesize, "file $iv has good size[$filesize]");
 139         utime 0, 0, $rf; # so that the next aggregate isn't skipped
 140     }
 141     open my $fh, ">", "$root_from/finissage" or die "Could not open: $!";
 142     print $fh "fin";
 143     close $fh or die "Could not close: $!";
 144     $rf0->update("$root_from/finissage","new");
 145     $rf0 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-2s.yaml");
 146     $rf0->aggregate;
 147     for my $iv (@intervals) {
 148         my $filesize = -s "$root_from/RECENT-$iv.yaml";
 149         # now they have <$filesize_threshold bytes because the second aggregate could
 150         # truncate them
 151         ok($iv eq "Z" || $filesize_threshold > $filesize, "file $iv has good size[$filesize]");
 152     }
 153     my $dagg1 = $rf0->_debug_aggregate;
 154     Time::HiRes::sleep 1.2;
 155     $rf0->aggregate; # should not change the file
 156     my $dagg2 = $rf0->_debug_aggregate;
 157     is $dagg2->[0]{mtime}, $dagg1->[0]{mtime}, "no change by gratuitous aggregate";
 158     {
 159         my $recc = File::Rsync::Mirror::Recent->new
 160             (
 161              local => "$root_from/RECENT-2s.yaml",
 162             );
 163         ok $recc->overview, "overview created";
 164     }
 165 }
 166
 167 rmtree [$root_from, $root_to];
 168
 169 {
 170     # replay a short history, run aggregate on it, add files, aggregate again
 171     BEGIN { $tests += 208 }
 172     ok(1, "starting short history block");
 173     my $rf = File::Rsync::Mirror::Recentfile->new_from_file("t/RECENT-6h.yaml");
 174     my $recent_events = $rf->recent_events;
 175     my $recent_events_cnt = scalar @$recent_events;
 176     is (
 177         92,
 178         $recent_events_cnt,
 179         "found $recent_events_cnt events",
 180        );
 181     $rf->interval("5s");
 182     $rf->localroot($root_from);
 183     $rf->comment("produced during the test 02-operation.t");
 184     $rf->aggregator([qw(10s 30s 1m 1h Z)]);
 185     $rf->verbose(0);
 186     my $start = Time::HiRes::time;
 187     for my $e (@$recent_events) {
 188         for my $pass (0,1) {
 189             my $file = sprintf
 190                 (
 191                  "%s/%s",
 192                  $pass==0 ? $root_from : $root_to,
 193                  $e->{path},
 194                 );
 195             mkpath dirname $file;
 196             open my $fh, ">", $file or die "Could not open '$file': $!";
 197             print $fh time, ":", $file, "\n";
 198             close $fh or die "Could not close '$file': $!";
 199             if ($pass==0) {
 200                 $rf->update($file,$e->{type});
 201             }
 202         }
 203     }
 204     $rf->aggregate;
 205     my $took = Time::HiRes::time - $start;
 206     ok $took > 0, "creating the tree and aggregate took $took seconds";
 207     my $dagg1 = $rf->_debug_aggregate;
 208     for my $i (1..5) {
 209         my $file_from = "$root_from/anotherfilefromtesting$i";
 210         open my $fh, ">", $file_from or die "Could not open: $!";
 211         print $fh time, ":", $file_from;
 212         close $fh or die "Could not close: $!";
 213         $rf->update($file_from,"new");
 214     }
 215     $rf->aggregate;
 216     my $dagg2 = $rf->_debug_aggregate;
 217     undef $rf;
 218     # $DB::single=1;
 219     ok($dagg1->[0]{size} < $dagg2->[0]{size}, "The second 5s file size larger: $dagg1->[0]{size} < $dagg2->[0]{size}");
 220     ok($dagg1->[1]{mtime} <= $dagg2->[1]{mtime}, "The second 30s file timestamp larger: $dagg1->[1]{mtime} <= $dagg2->[1]{mtime}");
 221     is $dagg1->[2]{size}, $dagg2->[2]{size}, "The 1m file size unchanged";
 222     is $dagg1->[3]{mtime}, $dagg2->[3]{mtime}, "The 1h file timestamp unchanged";
 223     ok -l "t/ta/RECENT.recent", "found the symlink";
 224     my $have_slept = my $have_worked = 0;
 225     $start = Time::HiRes::time;
 226     my $debug = +[];
 227     for my $i (0..99) {
 228         my $file = sprintf
 229             (
 230              "%s/secscnt%03d",
 231              $root_from,
 232              ($i<25) ? ($i%12) : $i,
 233             );
 234         open my $fh, ">", $file or die "Could not open '$file': $!";
 235         print $fh time, ":", $file, "\n";
 236         close $fh or die "Could not close '$file': $!";
 237         my $another_rf = File::Rsync::Mirror::Recentfile->new
 238             (
 239              interval => "5s",
 240              localroot => $root_from,
 241              aggregator => [qw(10s 30s 1m 1h Z)],
 242             );
 243         $another_rf->update($file,"new");
 244         my $should_have = 97 + (($i<25) ? ($i < 12 ? ($i+1) : 12) : ($i-12));
 245         my($news,$filtered_news);
 246         if ($i < 50) {
 247             $another_rf->aggregate;
 248         }
 249         {
 250             my $recc = File::Rsync::Mirror::Recent->new
 251                 (
 252                  local => "$root_from/RECENT-5s.yaml",
 253                 );
 254             $news = $recc->news ();
 255             $filtered_news = [ uniq map { $_->{path} } @$news ];
 256         }
 257         is scalar @$filtered_news, $should_have, "should_have[$should_have]" or die;
 258         $debug->[$i] = $news;
 259         my $rf2 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-5s.yaml");
 260         my $rece = $rf2->recent_events;
 261         my $rececnt = @$rece;
 262         my $span = $rece->[0]{epoch} - $rece->[-1]{epoch};
 263         $have_worked = Time::HiRes::time - $start - $have_slept;
 264         ok($rececnt > 0
 265            && ($i<50 ? $span <= 5 # we have run aggregate, so it guaranteed(*)
 266                : $i < 90 ? 1      # we have not yet spent 5 seconds, so cannot predict
 267                : $span > 5        # we have certainly written enough files now, must happen
 268               ),
 269            sprintf
 270            ("i[%s]cnt[%s]span[%s]worked[%6.4f]",
 271             $i,
 272             $rececnt,
 273             $span,
 274             $have_worked,
 275            ));
 276         $have_slept += Time::HiRes::sleep 0.2;
 277     }
 278     # (*) "<=" instead of "<" because of rounding errors
 279 }
 280
 281 {
 282     # running mirror
 283     BEGIN { $tests += 2 }
 284     my $rf = File::Rsync::Mirror::Recentfile->new
 285         (
 286          filenameroot   => "RECENT",
 287          interval       => q(30s),
 288          localroot      => $root_to,
 289          max_rsync_errors  => 0,
 290          remote_dir     => $root_from,
 291          # verbose        => 1,
 292          rsync_options  => {
 293                             compress          => 0,
 294                             links             => 1,
 295                             times             => 1,
 296                             # not available in rsync 3.0.3: 'omit-dir-times'  => 1,
 297                             checksum          => 0,
 298                            },
 299         );
 300     my $somefile_epoch;
 301     for my $pass (0,1) {
 302         my $success;
 303         if (0 == $pass) {
 304             $success = $rf->mirror;
 305             my $re = $rf->recent_events;
 306             $somefile_epoch = $re->[24]{epoch};
 307         } elsif (1 == $pass) {
 308             $success = $rf->mirror(after => $somefile_epoch);
 309         }
 310         ok($success, "mirrored without dying");
 311     }
 312     {
 313         my $recc = File::Rsync::Mirror::Recent->new
 314             (  # ($root_from, $root_to)
 315              local => "$root_from/RECENT-5s.yaml",
 316             );
 317         # diag $recc->overview;
 318     }
 319     {
 320         my $recc = File::Rsync::Mirror::Recent->new
 321             (  # ($root_from, $root_to)
 322              local => "$root_to/RECENT-30s.yaml",
 323             );
 324         # diag $recc->overview;
 325     }
 326 }
 327
 328 rmtree [$root_from, $root_to];
 329
 330 BEGIN { plan tests => $tests }
 331
 332 # Local Variables:
 333 # mode: cperl
 334 # cperl-indent-level: 4
 335 # End: