releasing the trial release as stable
[rersyncrecent.git] / t / 02-operation.t
blob1c4bd627a896e5de83086437ee932b64cf3dbd1b
1 use Getopt::Long;
2 use Test::More;
3 use strict;
4 my $tests;
5 BEGIN { $tests = 0 }
6 use lib "lib";
8 my %Opt;
9 GetOptions(
10            "verbose!",
11           ) or die;
12 $Opt{verbose} ||= $ENV{PERL_RERSYNCRECENT_TEST_VERBOSE};
14 my $HAVE;
15 BEGIN {
16     # neither LibMagic nor MMagic tell them apart
17     for my $package (
18                      # "File::LibMagic",
19                      "File::MMagic",
20                     ) {
21         $HAVE->{$package} = eval qq{ require $package; };
22     }
25 use Dumpvalue;
26 use File::Basename qw(dirname);
27 use File::Copy qw(cp);
28 use File::Path qw(mkpath rmtree);
29 use File::Rsync::Mirror::Recent;
30 use File::Rsync::Mirror::Recentfile;
31 use List::MoreUtils qw(uniq);
32 use Storable;
33 use Time::HiRes qw(time sleep);
34 use YAML::Syck;
36 my $root_from = "t/ta";
37 my $root_to = "t/tb";
38 my $statusfile = "t/recent-rmirror-state.yml";
39 rmtree [$root_from, $root_to];
42     my @serializers;
43     my $test_counter;
44     BEGIN {
45         $test_counter = $tests;
46         @serializers = (
47                         [".yaml","YAML::Syck"],
48                         [".json","JSON"],
49                         [".sto","Storable"],
50                         [".dd","Data::Dumper"],
51                        );
52         $tests += @serializers;
53         if ($HAVE->{"File::LibMagic"}||$HAVE->{"File::MMagic"}) {
54             $tests += @serializers;
55         }
56     }
57     printf "#test_counter[%d]\n", $test_counter;
58     mkpath $root_from;
59     my $ttt = "$root_from/ttt";
60     open my $fh, ">", $ttt or die "Could not open: $!";
61     print $fh time;
62     close $fh or die "Could not close: $!";
63     my $fm;
64     if ($HAVE->{"File::LibMagic"}) {
65         $fm = File::LibMagic->new();
66     } elsif ($HAVE->{"File::MMagic"}) {
67         $fm = File::MMagic->new();
68     }
69     for my $serializer (@serializers) {
70         my($s,$module) = @$serializer;
71         unless (eval "require $module; 1") {
72             ok(1, "Skipping because $module not installed");
73             if ($fm) {
74                 ok(1, "Skipping the magic test for same reason");
75             }
76             next;
77         }
78         my $rf = File::Rsync::Mirror::Recentfile->new
79             (
80              filenameroot   => "RECENT",
81              interval       => q(1m),
82              localroot      => $root_from,
83              serializer_suffix => $s,
84             );
85         $rf->update($ttt,"new");
86         if ($fm) {
87             my $magic = $fm->checktype_filename("$root_from/RECENT-1m$s");
88             ok($magic, sprintf
89                ("Got a magic[%s] for s[%s]: [%s]",
90                 ref $fm,
91                 $s,
92                 $magic,
93                ));
94         }
95         my $content = do {open my $fh, "$root_from/RECENT-1m$s";local $/;<$fh>};
96         $content = Dumpvalue->new()->stringify($content);
97         my $want_length = 42; # or maybe 3 more
98         substr($content,$want_length) = "..." if length $content > 3+$want_length;
99         ok($content, "Got a substr for s[$s]: [$content]");
100     }
103 rmtree [$root_from, $root_to];
106     # very small tree, aggregate it
107     my @intervals;
108     my $test_counter;
109     BEGIN {
110         $test_counter = $tests;
111         @intervals = qw( 2s 4s 8s 16s 32s Z );
112         $tests += 2 + 2 * (10 + 14 * @intervals); # test_counter
113     }
114     printf "#test_counter[%d]\n", $test_counter;
115     ok(1, "starting smalltree block");
116     is 6, scalar @intervals, "array has 6 elements: @intervals";
117     printf "#test_counter[%d]\n", $test_counter+=2;
118     for my $pass (0,1) {
119         my $rf0 = File::Rsync::Mirror::Recentfile->new
120             (
121              aggregator     => [@intervals[1..$#intervals]],
122              interval       => $intervals[0],
123              localroot      => $root_from,
124              rsync_options  => [
125                                 compress          => 0,
126                                 links             => 1,
127                                 times             => 1,
128                                 checksum          => 0,
129                                ],
130             );
131         my $timestampfutured = 0;
132         for my $iv (@intervals) {
133             for my $i (0..3) {
134                 my $file = sprintf
135                     (
136                      "%s/A%s-%02d",
137                      $root_from,
138                      $iv,
139                      $i,
140                     );
141                 mkpath dirname $file;
142                 open my $fh, ">", $file or die "Could not open '$file': $!";
143                 print $fh time, ":", $file, "\n";
144                 close $fh or die "Could not close '$file': $!";
145                 $rf0->update($file,"new");
146                 if ($pass==1 && !$timestampfutured) {
147                     my $recent_events = $rf0->recent_events;
148                     $recent_events->[0]{epoch} += 987654321;
149                     $rf0->write_recent($recent_events);
150                     $timestampfutured++;
151                 }
152             }
153         }
154         my $recent_events = $rf0->recent_events;
155         # faking internals as if the contents were wide-spread in time
156         for my $evi (0..$#$recent_events) {
157             my $ev = $recent_events->[$evi];
158             $ev->{epoch} -= 2**($evi*.25);
159         }
160         $rf0->write_recent($recent_events);
161         $rf0->aggregate;
162         my $filesize_threshold = 1750; # XXX may be system dependent
163         my %size_before;
164         for my $iv (@intervals) {
165             my $rf = "$root_from/RECENT-$iv.yaml";
166             my $filesize = -s $rf;
167             $size_before{$iv} = $filesize;
168             # now they have $filesize_threshold+ bytes because they were merged for the
169             # first time ever and could not be truncated for this reason.
170             ok( $filesize > $filesize_threshold, "file $iv (before merging) has good size[$filesize]");
171             utime 0, 0, $rf; # so that the next aggregate isn't skipped
172         }
173         printf "#test_counter[%d]\n", $test_counter+=6;
174         open my $fh, ">", "$root_from/finissage" or die "Could not open: $!";
175         print $fh "fin";
176         close $fh or die "Could not close: $!";
177         $rf0->update("$root_from/finissage","new");
178         $rf0 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-2s.yaml");
179         $rf0->aggregate;
180         for my $iv (@intervals) {
181             my $filesize = -s "$root_from/RECENT-$iv.yaml";
182             # now they have <$filesize_threshold bytes because the second aggregate could
183             # truncate them
184             ok($iv eq "Z" || $filesize<$size_before{$iv}, "file $iv (after merging) has good size[$filesize<$size_before{$iv}]");
185         }
186         printf "#test_counter[%d]\n", $test_counter+=6;
187         my $dagg1 = $rf0->_debug_aggregate;
188         Time::HiRes::sleep 1.2;
189         $rf0->aggregate;
190         my $dagg2 = $rf0->_debug_aggregate;
191         {
192             my $recc = File::Rsync::Mirror::Recent->new
193                 (
194                  local => "$root_from/RECENT-2s.yaml",
195                 );
196             ok $recc->overview, "overview created";
197             # diag $recc->overview;
198         }
199         printf "#test_counter[%d]\n", $test_counter+=1;
200         for my $dirti (0,1,2) {
201             open my $fh2, ">", "$root_from/dirty$dirti" or die "Could not open: $!";
202             print $fh2 "dirty$dirti";
203             close $fh2 or die "Could not close: $!";
204             my $timestamp = $dirti <= 1 ? "999.999" : "1999.999";
205             my $becomes_i = $dirti <= 1 ? -1 : -3;
206             $rf0->update("$root_from/dirty$dirti","new",$timestamp);
207             $recent_events = $rf0->recent_events;
208             is $recent_events->[-1]{epoch}, $timestamp, "found the dirty timestamp during dirti[$dirti]";
209             printf "#test_counter[%d]\n", $test_counter+=1;
210             $rf0->aggregate(force => 1);
211             my $recc = File::Rsync::Mirror::Recent->new
212                 (
213                  localroot => $root_from,
214                  local => "$root_from/RECENT.recent",
215                 );
216             my %seen;
217             for my $rf (@{$recc->recentfiles}) {
218                 my $isec = $rf->interval_secs;
219                 my $re = $rf->recent_events;
220                 like $re->[-1]{epoch}, qr/999\.999/, "found some dirty timestamp[$re->[-1]{epoch}] in isec[$isec]";
221                 my $dirtymark = $rf->dirtymark;
222                 ok $dirtymark, "dirtymark[$dirtymark]";
223                 $seen{ $rf->dirtymark }++;
224             }
225             printf "#test_counter[%d]\n", $test_counter+=12;
226             is scalar keys %seen, 1, "all recentfiles have the same dirtymark";
227             printf "#test_counter[%d]\n", $test_counter+=1;
228             sleep 0.2;
229             $rf0->aggregate(force => 1);
230             my $rfs = $recc->recentfiles;
231             for my $i (0..$#$rfs) {
232                 my $rf = $rfs->[$i];
233                 my $re = $rf->recent_events;
234                 if ($i == 0) {
235                     unlike $re->[-1]{epoch}, qr/999\.999/, "dirty file events already moved up i[$i]";
236                 } elsif ($i == $#$rfs) {
237                     is $re->[$becomes_i]{epoch}, $timestamp, "found the dirty timestamp on i[$i]";
238                 } else {
239                     isnt $re->[-1]{epoch}, $timestamp, "dirty timestamp gone on i[$i]";
240                 }
241                 my $dirtymark = $rf->dirtymark;
242                 ok $dirtymark, "dirtymark[$dirtymark]";
243                 $seen{ $rf->dirtymark }++;
244             }
245             printf "#test_counter[%d]\n", $test_counter+=12;
246             is scalar keys %seen, 1, "all recentfiles have the same dirtymark";
247             printf "#test_counter[%d]\n", $test_counter+=1;
248         }
249         # $DB::single++;
250         rmtree [$root_from];
251     }
254 rmtree [$root_from, $root_to];
257     # replay a short history, run aggregate on it, add files, aggregate again
258     my $test_counter;
259     BEGIN {
260         $test_counter = $tests;
261         $tests += 208;
262     }
263     printf "#test_counter[%d]\n", $test_counter;
264     ok(1, "starting short history block");
265     my $rf = File::Rsync::Mirror::Recentfile->new_from_file("t/RECENT-6h.yaml");
266     my $recent_events = $rf->recent_events;
267     my $recent_events_cnt = scalar @$recent_events;
268     is (
269         92,
270         $recent_events_cnt,
271         "found $recent_events_cnt events",
272        );
273     $rf->interval("5s");
274     $rf->localroot($root_from);
275     $rf->comment("produced during the test 02-operation.t");
276     $rf->aggregator([qw(10s 30s 1m 1h Z)]);
277     $rf->verbose(0);
278     my $start = Time::HiRes::time;
279     for my $e (@$recent_events) {
280         for my $pass (0,1) {
281             my $file = sprintf
282                 (
283                  "%s/%s",
284                  $pass==0 ? $root_from : $root_to,
285                  $e->{path},
286                 );
287             mkpath dirname $file;
288             open my $fh, ">", $file or die "Could not open '$file': $!";
289             print $fh time, ":", $file, "\n";
290             close $fh or die "Could not close '$file': $!";
291             if ($pass==0) {
292                 $rf->update($file,$e->{type});
293             }
294         }
295     }
296     $rf->aggregate;
297     my $took = Time::HiRes::time - $start;
298     ok $took > 0, "creating the tree and aggregate took $took seconds";
299     my $dagg1 = $rf->_debug_aggregate;
300     for my $i (1..5) {
301         my $file_from = "$root_from/anotherfilefromtesting$i";
302         open my $fh, ">", $file_from or die "Could not open: $!";
303         print $fh time, ":", $file_from;
304         close $fh or die "Could not close: $!";
305         $rf->update($file_from,"new");
306     }
307     $rf->aggregate;
308     my $dagg2 = $rf->_debug_aggregate;
309     undef $rf;
310     ok($dagg1->[0]{size} < $dagg2->[0]{size}, "The second 5s file size larger: $dagg1->[0]{size} < $dagg2->[0]{size}");
311     ok($dagg1->[1]{mtime} <= $dagg2->[1]{mtime}, "The second 30s file timestamp larger: $dagg1->[1]{mtime} <= $dagg2->[1]{mtime}");
312     is $dagg1->[2]{size}, $dagg2->[2]{size}, "The 1m file size unchanged";
313     is $dagg1->[3]{mtime}, $dagg2->[3]{mtime}, "The 1h file timestamp unchanged";
314     ok -l "t/ta/RECENT.recent", "found the symlink";
315     my $have_slept = my $have_worked = 0;
316     $start = Time::HiRes::time;
317     my $debug = +[];
318     for my $i (0..99) {
319         my $file = sprintf
320             (
321              "%s/secscnt%03d",
322              $root_from,
323              ($i<25) ? ($i%12) : $i,
324             );
325         open my $fh, ">", $file or die "Could not open '$file': $!";
326         print $fh time, ":", $file, "\n";
327         close $fh or die "Could not close '$file': $!";
328         my $another_rf = File::Rsync::Mirror::Recentfile->new
329             (
330              interval => "5s",
331              localroot => $root_from,
332              aggregator => [qw(10s 30s 1m Z)],
333             );
334         $another_rf->update($file,"new");
335         my $should_have = 97 + (($i<25) ? ($i < 12 ? ($i+1) : 12) : ($i-12));
336         my($news,$filtered_news);
337         if ($i < 50) {
338             $another_rf->aggregate;
339         }
340         {
341             my $recc = File::Rsync::Mirror::Recent->new
342                 (
343                  local => "$root_from/RECENT-5s.yaml",
344                 );
345             $news = $recc->news ();
346             $filtered_news = [ uniq map { $_->{path} } @$news ];
347         }
348         is scalar @$filtered_news, $should_have, "should_have[$should_have]" or die;
349         $debug->[$i] = $news;
350         my $rf2 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-5s.yaml");
351         my $rece = $rf2->recent_events;
352         my $rececnt = @$rece;
353         my $span = $rece->[0]{epoch} - $rece->[-1]{epoch};
354         $have_worked = Time::HiRes::time - $start - $have_slept;
355         ok($rececnt > 0
356            && ($i<50 ? $span <= 5 # we have run aggregate, so it guaranteed(*)
357                : $i < 90 ? 1      # we have not yet spent 5 seconds, so cannot predict
358                : $span > 5        # we have certainly written enough files now, must happen
359               ),
360            sprintf
361            ("i[%s]cnt[%s]span[%s]worked[%6.4f]",
362             $i,
363             $rececnt,
364             $span,
365             $have_worked,
366            ));
367         $have_slept += Time::HiRes::sleep 0.2;
368     }
369     # (*) "<=" instead of "<" because of rounding errors
373     # running mirror
374     my $test_counter;
375     BEGIN {
376         $test_counter = $tests;
377         $tests += 3;
378     }
379     printf "#test_counter[%d]\n", $test_counter;
380     my $rf = File::Rsync::Mirror::Recentfile->new
381         (
382          filenameroot              => "RECENT",
383          interval                  => q(30s),
384          localroot                 => $root_to,
385          max_rsync_errors          => 0,
386          remote_dir                => $root_from,
387          # verbose                 => 1,
388          max_files_per_connection  => 65,
389          rsync_options  => {
390                             compress          => 0,
391                             links             => 1,
392                             times             => 1,
393                             # not available in rsync 3.0.3: 'omit-dir-times'  => 1,
394                             checksum          => 0,
395                            },
396         );
397     my $somefile_epoch;
398     for my $pass (0,1) {
399         my $success;
400         if (0 == $pass) {
401             $success = $rf->mirror;
402             my $re = $rf->recent_events;
403             $somefile_epoch = $re->[24]{epoch};
404         } elsif (1 == $pass) {
405             $success = $rf->mirror(after => $somefile_epoch);
406         }
407         ok($success, "mirrored pass[$pass] without dying");
408     }
409     {
410         my $recc = File::Rsync::Mirror::Recent->new
411             (  # ($root_from, $root_to)
412              local => "$root_from/RECENT-5s.yaml",
413             );
414         diag "\n" if $Opt{verbose};
415         diag $recc->overview if $Opt{verbose};
416     }
417     {
418         my $recc = File::Rsync::Mirror::Recent->new
419             (
420              # ignore_link_stat_errors => 1,
421              localroot => $root_to,
422              remote => "$root_from/RECENT-5s.yaml",
423              # verbose => 1,
424              max_files_per_connection => 512,
425              rsync_options => {
426                                links => 1,
427                                times => 1,
428                                compress => 1,
429                                checksum => 1,
430                               },
431             );
432         $recc->rmirror;
433     }
434     {
435         my $recc = File::Rsync::Mirror::Recent->new
436             (  # ($root_from, $root_to)
437              local => "$root_to/RECENT-5s.yaml",
438             );
439         diag "\n" if $Opt{verbose};
440         diag $recc->overview if $Opt{verbose};
441     }
442     {
443         BEGIN {
444             $tests += 2;
445         }
446         my $recc = File::Rsync::Mirror::Recent->new
447             (
448              # order matters!
449              # ignore_link_stat_errors => 1,
450              localroot                   => $root_to,
451              remote                      => "$root_from/RECENT.recent",
452              max_files_per_connection    => 65,
453              rsync_options               =>
454              {
455               links     => 1,
456               times     => 1,
457               compress  => 1,
458               checksum  => 1,
459              },
460              _runstatusfile              => $statusfile,
461              verbose                     => $Opt{verbose},
462             );
463         $recc->rmirror;
464         my $rf2 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-5s.yaml");
465         my $file = "$root_from/about-re-mirroring.txt";
466         open my $fh, ">", $file or die "Could not open '$file': $!";
467         print $fh time;
468         close $fh or die "Could not close '$file': $!";
469         $rf2->update($file, "new");
470         $recc->rmirror;
471         ok -e "$root_to/about-re-mirroring.txt", "picked up the update";
472         $file = "$root_from/about-re2-mirroring.txt";
473         undef $fh;
474         open $fh, ">", $file or die "Could not open '$file': $!";
475         print $fh time;
476         close $fh or die "Could not close '$file': $!";
477         $rf2->update($file, "new", 123456789);
478         $rf2->aggregate(force => 1);
479         $rf2->aggregate(force => 1);
480         $recc->verbose(1) if $Opt{verbose};
482         # { no warnings 'once'; $DB::single++; }
483         # x map { $_->dirtymark } @{$self->recentfiles}
484         # x map { $_->_seeded } @{$self->recentfiles}
485         # x sort keys %$rf
486         # $recc->verbose(1)
488         $recc->rmirror;
489         ok -e "$root_to/about-re2-mirroring.txt", "picked up a dirty update";
490     }
491     {
492         my $recc = File::Rsync::Mirror::Recent->new
493             (  # ($root_from, $root_to)
494              local => "$root_to/RECENT-5s.yaml",
495             );
496         diag "\n" if $Opt{verbose};
497         diag $recc->overview if $Opt{verbose};
498     }
499     {
500         my $recc = File::Rsync::Mirror::Recent->new
501             (
502              # ignore_link_stat_errors => 1,
503              localroot => $root_to,
504              local => "$root_to/RECENT.recent",
505             );
506         my %seen;
507         for my $rf (@{$recc->recentfiles}) {
508             my $dirtymark = $rf->dirtymark or next;
509             $seen{ $dirtymark }++;
510         }
511         is scalar keys %seen, 1, "all recentfiles have the same dirtymark or we don't know it";
512     }
515 rmtree [$root_from, $root_to, $statusfile] unless $Opt{verbose};
517 BEGIN {
518     plan tests => $tests
521 # Local Variables:
522 # mode: cperl
523 # cperl-indent-level: 4
524 # End: