lib/File/Rsync/Mirror/Recentfile/Done.pm

   1 package File::Rsync::Mirror::Recentfile::Done;
   2
   3 # use warnings;
   4 use strict;
   5
   6 use File::Rsync::Mirror::Recentfile::FakeBigFloat qw(:all);
   7
   8 =encoding utf-8
   9
  10 =head1 NAME
  11
  12 File::Rsync::Mirror::Recentfile::Done - intervals of already rsynced timespans
  13
  14 =cut
  15
  16 use version; our $VERSION = qv('0.0.1');
  17
  18 =head1 SYNOPSIS
  19
  20  my $done = File::Rsync::Mirror::Recentfile::Done->new;
  21  $done->register ( $recent_events, [3,4,5,9] ); # registers elements 3-5 and 9
  22  my $boolean = $done->covered ( $epoch );
  23
  24 =head1 DESCRIPTION
  25
  26 Keeping track of already rsynced timespans.
  27
  28 =head1 EXPORT
  29
  30 No exports.
  31
  32 =head1 CONSTRUCTORS
  33
  34 =head2 my $obj = CLASS->new(%hash)
  35
  36 Constructor. On every argument pair the key is a method name and the
  37 value is an argument to that method name.
  38
  39 =cut
  40
  41 sub new {
  42     my($class, @args) = @_;
  43     my $self = bless {}, $class;
  44     while (@args) {
  45         my($method,$arg) = splice @args, 0, 2;
  46         $self->$method($arg);
  47     }
  48     return $self;
  49 }
  50
  51 =head1 ACCESSORS
  52
  53 =cut
  54
  55 my @accessors;
  56
  57 BEGIN {
  58     @accessors = (
  59                   "__intervals",
  60                   "_logfile", # undocced: a small yaml dump appended on every change
  61                   "_rfinterval", # undocced: the interval of the holding rf
  62                  );
  63
  64     my @pod_lines =
  65         split /\n/, <<'=cut'; push @accessors, grep {s/^=item\s+//} @pod_lines; }
  66
  67 =over 4
  68
  69 =item verbose
  70
  71 Boolean to turn on a bit verbosity.
  72
  73 =back
  74
  75 =cut
  76
  77 use accessors @accessors;
  78
  79 =head1 METHODS
  80
  81 =head2 $boolean = $obj->covered ( $epoch1, $epoch2 )
  82
  83 =head2 $boolean = $obj->covered ( $epoch )
  84
  85 The first form returns true if both timestamps $epoch1 and $epoch2 in
  86 floating point notation have been registered within one interval,
  87 otherwise false.
  88
  89 The second form returns true if this timestamp has been registered.
  90
  91 =cut
  92
  93 sub covered {
  94     my($self, $epoch_high, $epoch_low) = @_;
  95     die "Alert: covered() called without or with undefined first argument" unless defined $epoch_high;
  96     my $intervals = $self->_intervals;
  97     return unless @$intervals;
  98     if (defined $epoch_low) {
  99         ($epoch_high,$epoch_low) = ($epoch_low,$epoch_high) if _bigfloatgt($epoch_low,$epoch_high);
 100     }
 101     for my $iv (@$intervals) {
 102         my($upper,$lower) = @$iv; # may be the same
 103         if (defined $epoch_low) {
 104             my $goodbound = 0;
 105             for my $e ($epoch_high,$epoch_low) {
 106                 $goodbound++ if
 107                     $e eq $upper || $e eq $lower || (_bigfloatlt($e,$upper) && _bigfloatgt($e,$lower));
 108             }
 109             return 1 if $goodbound > 1;
 110         } else {
 111             return 1 if _bigfloatle($epoch_high,$upper) && _bigfloatge($epoch_high, $lower); # "between"
 112         }
 113     }
 114     return 0;
 115 }
 116
 117 =head2 (void) $obj1->merge ( $obj2 )
 118
 119 Integrates all intervals in $obj2 into $obj1. Overlapping intervals
 120 are conflated/folded/consolidated. Sort order is preserved as decreasing.
 121
 122 =cut
 123 sub merge {
 124     my($self, $other) = @_;
 125     my $intervals = $self->_intervals;
 126     my $ointervals = $other->_intervals;
 127   OTHER: for my $oiv (@$ointervals) {
 128         my $splicepos;
 129         if (@$intervals) {
 130           SELF: for my $i (0..$#$intervals) {
 131                 my $iv = $intervals->[$i];
 132                 if ( _bigfloatlt ($oiv->[0],$iv->[1]) ) {
 133                     # both oiv lower than iv => next
 134                     next SELF;
 135                 }
 136                 if ( _bigfloatgt ($oiv->[1],$iv->[0]) ) {
 137                     # both oiv greater than iv => insert
 138                     $splicepos = $i;
 139                     last SELF;
 140                 }
 141                 # larger(left-iv,left-oiv) becomes left, smaller(right-iv,right-oiv) becomes right
 142                 $iv->[0] = _bigfloatmax ($oiv->[0],$iv->[0]);
 143                 $iv->[1] = _bigfloatmin ($oiv->[1],$iv->[1]);
 144                 next OTHER;
 145             }
 146             unless (defined $splicepos) {
 147                 if ( _bigfloatlt ($oiv->[0], $intervals->[-1][1]) ) {
 148                     $splicepos = @$intervals;
 149                 } else {
 150                     die "Panic: left-oiv[$oiv->[0]] should be smaller than smallest[$intervals->[-1][1]]";
 151                 }
 152             }
 153             splice @$intervals, $splicepos, 0, [@$oiv];
 154         } else {
 155             $intervals->[0] = [@$oiv];
 156         }
 157     }
 158 }
 159
 160 =head2 (void) $obj->register ( $recent_events_arrayref, $register_arrayref )
 161
 162 =head2 (void) $obj->register ( $recent_events_arrayref )
 163
 164 The first arrayref is a list of hashes that contain a key called
 165 C<epoch> which is a string looking like a number. The second arrayref
 166 is a list if integers which point to elements in the first arrayref to
 167 be registered.
 168
 169 The second form registers all events in $recent_events_arrayref.
 170
 171 =cut
 172
 173 sub register {
 174     my($self, $re, $reg) = @_;
 175     my $intervals = $self->_intervals;
 176     unless ($reg) {
 177         $reg = [0..$#$re];
 178     }
 179   REGISTRANT: for my $i (@$reg) {
 180         my $logfile = $self->_logfile;
 181         if ($logfile) {
 182             require YAML::Syck;
 183             open my $fh, ">>", $logfile or die "Could not open '$logfile': $!";
 184             print $fh YAML::Syck::Dump({
 185                                         At => "before",
 186                                         Brfinterval => $self->_rfinterval,
 187                                         Ci => $i,
 188                                         ($i>0 ? ("Dre-1" => $re->[$i-1]) : ()),
 189                                         "Dre-0" => $re->[$i],
 190                                         ($i<$#$re ? ("Dre+1" => $re->[$i+1]) : ()),
 191                                         Eintervals => $intervals,
 192                                        });
 193         }
 194         $self->_register_one
 195             ({
 196               i => $i,
 197               re => $re,
 198               intervals => $intervals,
 199              });
 200         if ($logfile) {
 201             require YAML::Syck;
 202             open my $fh, ">>", $logfile or die "Could not open '$logfile': $!";
 203             print $fh YAML::Syck::Dump({
 204                                         At => "after",
 205                                         intervals => $intervals,
 206                                        });
 207         }
 208     }
 209 }
 210
 211 sub _register_one {
 212     my($self, $one) = @_;
 213     my($i,$re,$intervals) = @{$one}{qw(i re intervals)};
 214     die sprintf "Panic: illegal i[%d] larger than number of events[%d]", $i, $#$re
 215         if $i > $#$re;
 216     my $epoch = $re->[$i]{epoch};
 217     return if $self->covered ( $epoch );
 218     if (@$intervals) {
 219         my $registered = 0;
 220     IV: for my $iv (@$intervals) {
 221             my($ivhi,$ivlo) = @$iv; # may be the same
 222             if ($i > 0
 223                 && _bigfloatge($re->[$i-1]{epoch}, $ivlo)
 224                 && _bigfloatle($re->[$i-1]{epoch}, $ivhi)
 225                 && _bigfloatge($iv->[1],$epoch)
 226                ) {
 227                 # if left neighbor in re belongs to this interval,
 228                 # then I belong to it too; let us lower the ivlo
 229                 $iv->[1] = $epoch;
 230                 $registered++;
 231             }
 232             if ($i < $#$re
 233                 && _bigfloatle($re->[$i+1]{epoch}, $ivhi)
 234                 && _bigfloatge($re->[$i+1]{epoch}, $ivlo)
 235                 && _bigfloatle($iv->[0],$epoch)
 236                ) {
 237                 # ditto for right neighbor; increase the ivhi
 238                 $iv->[0] = $epoch;
 239                 $registered++;
 240             }
 241             last IV if $registered>=2;
 242         }
 243         if ($registered == 2) {
 244             $self->_register_one_fold2
 245                 (
 246                  $intervals,
 247                  $epoch,
 248                 );
 249         } elsif ($registered == 1) {
 250             $self->_register_one_fold1 ($intervals);
 251         } else {
 252             $self->_register_one_fold0
 253                 (
 254                  $intervals,
 255                  $epoch,
 256                 );
 257         }
 258     } else {
 259         $intervals->[0] = [($epoch)x2];
 260     }
 261 }
 262
 263 sub _register_one_fold0 {
 264     my($self,
 265        $intervals,
 266        $epoch,
 267       ) = @_;
 268     my $splicepos;
 269     for my $i (0..$#$intervals) {
 270         if (_bigfloatgt ($epoch, $intervals->[$i][0])) {
 271             $splicepos = $i;
 272             last;
 273         }
 274     }
 275     unless (defined $splicepos) {
 276         if (_bigfloatlt ($epoch,   $intervals->[-1][1])) {
 277             $splicepos = @$intervals;
 278         } else {
 279             die "Panic: epoch[$epoch] should be smaller than smallest[$intervals->[-1][1]]";
 280         }
 281     }
 282     splice @$intervals, $splicepos, 0, [($epoch)x2];
 283 }
 284
 285 # conflate: eliminate overlapping intervals
 286 sub _register_one_fold1 {
 287     my($self,$intervals) = @_;
 288  LOOP: while () {
 289         my $splicepos;
 290         for my $i (0..$#$intervals-1) {
 291             if (_bigfloatle ($intervals->[$i][1],
 292                              $intervals->[$i+1][0])) {
 293                 $intervals->[$i+1][0] = $intervals->[$i][0];
 294                 $splicepos = $i;
 295                 last;
 296             }
 297         }
 298         if (defined $splicepos) {
 299             splice @$intervals, $splicepos, 1;
 300         } else {
 301             last LOOP;
 302         }
 303     }
 304 }
 305
 306 sub _register_one_fold2 {
 307     my($self,
 308        $intervals,
 309        $epoch,
 310       ) = @_;
 311     # we know we have hit twice, like in
 312     # 40:[45,40],        [40,35]
 313     # 40:[45,40],[42,37],[40,35]
 314     # 45:[45,40],        [45,35]
 315     # 45:[45,40],[42,37],[45,35]
 316     # 35:[45,35],        [40,35]
 317     # 35:[45,35],[42,37],[40,35]
 318     my($splicepos, $splicelen, %assert_between);
 319     for my $i (0..$#$intervals) {
 320         if (   $epoch eq $intervals->[$i][0]
 321             or $epoch eq $intervals->[$i][1]
 322            ) {
 323             for (my $j = 1; $i+$j <= $#$intervals; $j++) {
 324                 if (   $epoch eq $intervals->[$i+$j][0]
 325                     or $epoch eq $intervals->[$i+$j][1]) {
 326                     $intervals->[$i+$j][0] = _bigfloatmax($intervals->[$i][0],$intervals->[$i+$j][0]);
 327                     $intervals->[$i+$j][1] = _bigfloatmin($intervals->[$i][1],$intervals->[$i+$j][1]);
 328                     $splicepos = $i;
 329                     $splicelen = $j;
 330                     last;
 331                 } else {
 332                     for my $k (0,1) {
 333                         $assert_between{$intervals->[$i+$j][$k]}++;
 334                     }
 335                 }
 336             }
 337         }
 338     }
 339     if (defined $splicepos) {
 340         for my $k (keys %assert_between) {
 341             if (_bigfloatgt($k,$intervals->[$splicepos+$splicelen][0])
 342                 or _bigfloatlt($k,$intervals->[$splicepos+$splicelen][1])){
 343                 $DB::single=1;
 344                 require Data::Dumper;
 345                 die "Panic: broken intervals:".Data::Dumper::Dumper($intervals);
 346             }
 347         }
 348         splice @$intervals, $splicepos, $splicelen;
 349     } else {
 350         $DB::single=1;
 351         die "Panic: Could not find an interval position to insert '$epoch'";
 352     }
 353 }
 354
 355 =head2 reset
 356
 357 Forgets everything ever done and gives way for a new round of
 358 mirroring. Usually called when the dirtymark on upstream has changed.
 359
 360 =cut
 361
 362 sub reset {
 363     my($self) = @_;
 364     $self->_intervals(undef);
 365 }
 366
 367 =head1 PRIVATE METHODS
 368
 369 =head2 _intervals
 370
 371 =cut
 372 sub _intervals {
 373     my($self,$set) = @_;
 374     if (@_ >= 2) {
 375         $self->__intervals($set);
 376     }
 377     my $x = $self->__intervals;
 378     unless (defined $x) {
 379         $x = [];
 380         $self->__intervals ($x);
 381     }
 382     return $x;
 383 }
 384
 385 =head1 COPYRIGHT & LICENSE
 386
 387 Copyright 2008, 2009 Andreas König.
 388
 389 This program is free software; you can redistribute it and/or modify it
 390 under the same terms as Perl itself.
 391
 392 =cut
 393
 394 1; # End of File::Rsync::Mirror::Recentfile
 395
 396 # Local Variables:
 397 # mode: cperl
 398 # cperl-indent-level: 4
 399 # End: