t/03-done.t

   1 use Data::Dumper;
   2 use File::Copy qw(cp);
   3 use File::Path qw(mkpath rmtree);
   4 use File::Rsync::Mirror::Recentfile;
   5 use File::Rsync::Mirror::Recentfile::Done;
   6 use List::Util qw(sum);
   7 use Storable qw(dclone);
   8 use Test::More;
   9 our $HAVE_YAML_SYCK;
  10 BEGIN { $HAVE_YAML_SYCK = eval { require YAML::Syck; 1; }; }
  11 use strict;
  12 my $tests;
  13 BEGIN { $tests = 0 }
  14 use lib "lib";
  15
  16 my @recent_events = map { +{ epoch => $_ } }
  17     (
  18      "1216706557.63601",
  19      "1216706557.5279",
  20      "1216706557.23439",
  21      "1216706555.44193",
  22      "1216706555.17699",
  23      "1216706554.23419",
  24      "1216706554.12319",
  25      "1216706553.47884",
  26      "1216706552.9627",
  27      "1216706552.661",
  28     );
  29
  30 # lm = long mantissa
  31 my @recent_events_lm = map { +{ epoch => $_ } }
  32     (
  33      "100.0000000000000001116606557906601",
  34      "100.0000000000000001116606557806690",
  35      "100.0000000000000001116606557706639",
  36      "100.0000000000000001116606557606693",
  37      "100.0000000000000001116606557506699",
  38       "99.9999999999999991116606557406619",
  39       "99.9999999999999991116606557306619",
  40       "99.9999999999999991116606557206684",
  41       "99.9999999999999991116606557106670",
  42       "99.9999999999999991116606557006600",
  43     );
  44
  45 my @snapshots;
  46
  47 {
  48     my @t;
  49     BEGIN {
  50         @t =
  51             (
  52              [[0,1,2],[3,4,5],[6,7,8,9]],
  53              [[9,8],[7,6,5],[4,3,2,1,0]],
  54              [[0,1,5],[3,4],[2,6,7,8,9]],
  55              [[1,5],[3,4,5,7],[2,0,6,7,9,8]],
  56             );
  57         my $sum = sum map { my @cnt = @$_; scalar @cnt; } @t;
  58         $tests += 2 * $sum;
  59     }
  60     for my $t (@t) {
  61         my $done = File::Rsync::Mirror::Recentfile::Done->new;
  62         my $done_lm = File::Rsync::Mirror::Recentfile::Done->new;
  63         my @sessions = @$t;
  64         for my $i (0..$#sessions) {
  65             my $session = $sessions[$i];
  66
  67             $done->register ( \@recent_events, $session );
  68             my $boolean = $done->covered ( map {$_->{epoch}} @recent_events[0,-1] );
  69             is 0+$boolean, $i==$#sessions ? 1 : 0, $recent_events[$session->[0]]{epoch} or
  70                 die Dumper({boolean=>$boolean,i=>$i,done=>$done});
  71
  72             $done_lm->register ( \@recent_events_lm, $session );
  73             my $boolean_lm = $done_lm->covered ( map {$_->{epoch}} @recent_events_lm[0,-1] );
  74             is 0+$boolean_lm, $i==$#sessions ? 1 : 0, $recent_events_lm[$session->[0]]{epoch}  or
  75                 die Dumper({boolean_lm=>$boolean_lm,i=>$i,done_lm=>$done_lm});
  76
  77             push @snapshots, dclone $done, dclone $done_lm;
  78         }
  79     }
  80 }
  81
  82 {
  83     BEGIN {
  84         $tests += 1;
  85         if ($HAVE_YAML_SYCK) {
  86             $tests += 1;
  87         }
  88     }
  89     my $snapshots = scalar @snapshots;
  90     ok $snapshots>=24, "enough snapshots[$snapshots]";
  91     my $ok = 0;
  92     for my $i (0..$#snapshots) {
  93         my($a) = [@snapshots[$i-1,$i]];
  94         my $b = dclone $a;
  95         $a->[0]->merge($a->[1]);
  96         $b->[1]->merge($b->[0]);
  97         if ($HAVE_YAML_SYCK) {
  98             $ok++ if YAML::Syck::Dump($a->[0]) eq YAML::Syck::Dump($b->[1]);
  99         }
 100     }
 101     if ($HAVE_YAML_SYCK) {
 102         is $ok, $snapshots, "all merge operations OK";
 103     }
 104 }
 105
 106 {
 107     BEGIN {
 108         $tests += 4;
 109     }
 110     mkpath "t/ta";
 111     cp "t/RECENT-1h.yaml", "t/ta/RECENT-Z.yaml";
 112     my $rf = bless( {
 113     '-aggregator' => [
 114       '1d',
 115       '1W',
 116       '1M',
 117       '1Q',
 118       '1Y',
 119       'Z'
 120     ],
 121     '-_localroot' => "t/ta",
 122     '-filenameroot' => 'RECENT',
 123     '-serializer_suffix' => '.yaml',
 124     '-minmax' => {
 125       'mtime' => '1223270942',
 126       'min' => '1223269222.00701',
 127       'max' => '1223270911.76639'
 128     },
 129     '-verbose' => '1',
 130     '-_done' => bless( {
 131       '-__intervals' => [
 132         [
 133           '1223270911.76639',
 134           '1223256470.41935'
 135         ]
 136       ]
 137     }, 'File::Rsync::Mirror::Recentfile::Done' ),
 138     '-have_mirrored' => '1223271134.78303',
 139     '-_interval' => 'Z',
 140     '-protocol' => '1'
 141   }, 'File::Rsync::Mirror::Recentfile' );
 142     my $rfile = $rf->_my_current_rfile ();
 143     ok $rfile, "Could determine the current rfile[$rfile]";
 144     my $re = $rf->recent_events;
 145     my $cnt = scalar @$re;
 146     ok $cnt, "re have more than one[$cnt] elements";
 147     my $done = $rf->done;
 148     ok $done->covered ($re->[0]{epoch},$re->[-1]{epoch}), "covered I";
 149     $rf->update("t/ta/id/M/MS/MSIMERSON/Mail-Toaster-5.12_01.tar.gz","new");
 150     $rf->update("t/ta/id/M/MS/MSIMERSON/Mail-Toaster-5.12_01.readme","new");
 151     my $re2 = $rf->recent_events;
 152     $done->register($re2, [0,1]);
 153     ok $done->covered ($re2->[0]{epoch},$re2->[-1]{epoch}), "covered II";
 154 }
 155
 156 {
 157     my @lines;
 158     BEGIN {
 159         @lines = split /\n/, <<EOL;
 160 40:[45,40],        [40,35]
 161 40:[45,40],[42,37],[40,35]
 162 45:[45,40],        [45,35]
 163 45:[45,40],[42,37],[45,35]
 164 35:[45,35],        [40,35]
 165 35:[45,35],[42,37],[40,35]
 166 EOL
 167         $tests += 3*@lines;
 168     }
 169     for my $line (@lines) {
 170         my($epoch,$perl) = $line =~ /^(\d+):(.+)/;
 171         my @intervals = eval $perl;
 172         my $done = File::Rsync::Mirror::Recentfile::Done->new;
 173         $done->_register_one_fold2(\@intervals,$epoch);
 174         ok 1==@intervals, "line $line";
 175         ok 45==$intervals[0][0], "line $line => $intervals[0][0]";
 176         ok 35==$intervals[0][1], "line $line => $intervals[0][1]";
 177     }
 178 }
 179
 180 rmtree ( "t/ta" );
 181
 182 BEGIN { plan tests => $tests }
 183
 184 # Local Variables:
 185 # mode: cperl
 186 # cperl-indent-level: 4
 187 # End: