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 =head1 VERSION
  15
  16 Version 0.0.1
  17
  18 =cut
  19
  20 use version; our $VERSION = qv('0.0.1');
  21
  22 =head1 SYNOPSIS
  23
  24  my $done = File::Rsync::Mirror::Recentfile::Done->new;
  25  $done->register ( $recent_events, [3,4,5,9] ); # registers elements 3-5 and 9
  26  my $boolean = $done->covered ( $epoch );
  27
  28 =head1 DESCRIPTION
  29
  30 Keeping track of already rsynced timespans.
  31
  32 =head1 EXPORT
  33
  34 No exports.
  35
  36 =head1 CONSTRUCTORS
  37
  38 =head2 my $obj = CLASS->new(%hash)
  39
  40 Constructor. On every argument pair the key is a method name and the
  41 value is an argument to that method name.
  42
  43 =cut
  44
  45 sub new {
  46     my($class, @args) = @_;
  47     my $self = bless {}, $class;
  48     while (@args) {
  49         my($method,$arg) = splice @args, 0, 2;
  50         $self->$method($arg);
  51     }
  52     return $self;
  53 }
  54
  55 =head1 ACCESSORS
  56
  57 =cut
  58
  59 my @accessors;
  60
  61 BEGIN {
  62     @accessors = (
  63                   "__intervals",
  64                   "_logfile",
  65                  );
  66
  67     my @pod_lines =
  68         split /\n/, <<'=cut'; push @accessors, grep {s/^=item\s+//} @pod_lines; }
  69
  70 =over 4
  71
  72 =item verbose
  73
  74 Boolean to turn on a bit verbosity.
  75
  76 =back
  77
  78 =cut
  79
  80 use accessors @accessors;
  81
  82 =head1 METHODS
  83
  84 =head2 $boolean = $obj->covered ( $epoch1, $epoch2 )
  85
  86 =head2 $boolean = $obj->covered ( $epoch )
  87
  88 The first form returns true if both timestamps $epoch1 and $epoch2 in
  89 floating point notation have been registered within one interval,
  90 otherwise false.
  91
  92 The second form returns true if this timestamp has been registered.
  93
  94 =cut
  95
  96 sub covered {
  97     my($self, $epoch_high, $epoch_low) = @_;
  98     die "Alert: covered() called without or with undefined first argument" unless defined $epoch_high;
  99     my $intervals = $self->_intervals;
 100     return unless @$intervals;
 101     if (defined $epoch_low) {
 102         ($epoch_high,$epoch_low) = ($epoch_low,$epoch_high) if $epoch_low > $epoch_high;
 103     }
 104     for my $iv (@$intervals) {
 105         my($upper,$lower) = @$iv; # may be the same
 106         if (defined $epoch_low) {
 107             my $goodbound = 0;
 108             for my $e ($epoch_high,$epoch_low) {
 109                 $goodbound++ if
 110                     $e eq $upper || $e eq $lower || ($e < $upper && $e > $lower);
 111             }
 112             return 1 if $goodbound > 1;
 113         } else {
 114             return 1 if $epoch_high eq $upper || $epoch_high eq $lower || ($epoch_high < $upper && $epoch_high > $lower);
 115         }
 116     }
 117     return 0;
 118 }
 119
 120 =head2 (void) $obj1->merge ( $obj2 )
 121
 122 Integrates all intervals in $obj2 into $obj1. Overlapping intervals
 123 are conflated/folded/consolidated. Sort order is preserved as decreasing.
 124
 125 =cut
 126 sub merge {
 127     my($self, $other) = @_;
 128     my $intervals = $self->_intervals;
 129     my $ointervals = $other->_intervals;
 130   OTHER: for my $oiv (@$ointervals) {
 131         my $splicepos;
 132         if (@$intervals) {
 133           SELF: for my $i (0..$#$intervals) {
 134                 my $iv = $intervals->[$i];
 135                 if ( _bigfloatlt ($oiv->[0],$iv->[1]) ) {
 136                     # both oiv lower than iv => next
 137                     next SELF;
 138                 }
 139                 if ( _bigfloatgt ($oiv->[1],$iv->[0]) ) {
 140                     # both oiv greater than iv => insert
 141                     $splicepos = $i;
 142                     last SELF;
 143                 }
 144                 # larger(left-iv,left-oiv) becomes left, smaller(right-iv,right-oiv) becomes right
 145                 $iv->[0] = _bigfloatmax ($oiv->[0],$iv->[0]);
 146                 $iv->[1] = _bigfloatmin ($oiv->[1],$iv->[1]);
 147                 next OTHER;
 148             }
 149             unless (defined $splicepos) {
 150                 if ( _bigfloatlt ($oiv->[0], $intervals->[-1][1]) ) {
 151                     $splicepos = @$intervals;
 152                 } else {
 153                     die "Panic: left-oiv[$oiv->[0]] should be smaller than smallest[$intervals->[-1][1]]";
 154                 }
 155             }
 156             splice @$intervals, $splicepos, 0, [@$oiv];
 157         } else {
 158             $intervals->[0] = [@$oiv];
 159         }
 160     }
 161 }
 162
 163 =head2 (void) $obj->register ( $recent_events_arrayref, $register_arrayref )
 164
 165 =head2 (void) $obj->register ( $recent_events_arrayref )
 166
 167 The first arrayref is a list fo hashes that contain a key called
 168 C<epoch> which is a string looking like a number. The second arrayref
 169 is a list if integers which point to elements in the first arrayref to
 170 be registered.
 171
 172 The second form registers all events in $recent_events_arrayref.
 173
 174 =cut
 175
 176 sub register {
 177     my($self, $re, $reg) = @_;
 178     my $intervals = $self->_intervals;
 179     unless ($reg) {
 180         $reg = [0..$#$re];
 181     }
 182   REGISTRANT: for my $i (@$reg) {
 183         my $logfile = $self->_logfile;
 184         if ($logfile) {
 185             require YAML::Syck;
 186             open my $fh, ">>", $logfile or die "Could not open '$logfile': $!";
 187             print $fh YAML::Syck::Dump({
 188                                         t => "before",
 189                                         i => $i,
 190                                         ($i>0 ? ("re-1" => $re->[$i-1]) : ()),
 191                                         "re-0" => $re->[$i],
 192                                         ($i<$#$re ? ("re+1" => $re->[$i+1]) : ()),
 193                                         intervals => $intervals,
 194                                        });
 195         }
 196         $self->_register_one
 197             ({
 198               i => $i,
 199               re => $re,
 200               intervals => $intervals,
 201              });
 202         if ($logfile) {
 203             require YAML::Syck;
 204             open my $fh, ">>", $logfile or die "Could not open '$logfile': $!";
 205             print $fh YAML::Syck::Dump({
 206                                         t => "after",
 207                                         i => $i,
 208                                         intervals => $intervals,
 209                                        });
 210         }
 211     }
 212 }
 213
 214 sub _register_one {
 215     my($self, $one) = @_;
 216     my($i,$re,$intervals) = @{$one}{qw(i re intervals)};
 217     die sprintf "Panic: illegal i[%d] larger than number of events[%d]", $i, $#$re
 218         if $i > $#$re;
 219     my $epoch = $re->[$i]{epoch};
 220     return if $self->covered ( $epoch );
 221     if (@$intervals) {
 222         my $registered = 0;
 223         for my $iv (@$intervals) {
 224             my($ivupper,$ivlower) = @$iv; # may be the same
 225             if ($i > 0
 226                 && _bigfloatge($re->[$i-1]{epoch}, $ivlower)
 227                 && _bigfloatle($re->[$i-1]{epoch}, $ivupper)
 228                ) {
 229                 $iv->[1] = $epoch;
 230                 $registered++;
 231             }
 232             if ($i < $#$re
 233                 && _bigfloatle($re->[$i+1]{epoch}, $ivupper)
 234                 && _bigfloatge($re->[$i+1]{epoch}, $ivlower)
 235                ) {
 236                 $iv->[0] = $epoch;
 237                 $registered++;
 238             }
 239         }
 240         if ($registered == 2) {
 241             $self->_register_one_fold2
 242                 (
 243                  $intervals,
 244                  $epoch,
 245                 );
 246         } elsif ($registered == 1) {
 247         } else {
 248             $self->_register_one_fold0
 249                 (
 250                  $intervals,
 251                  $epoch,
 252                 );
 253         }
 254     } else {
 255         $intervals->[0] = [($epoch)x2];
 256     }
 257 }
 258
 259 sub _register_one_fold0 {
 260     my($self,
 261        $intervals,
 262        $epoch,
 263       ) = @_;
 264     my $splicepos;
 265     for my $i (0..$#$intervals) {
 266         if (_bigfloatgt ($epoch, $intervals->[$i][0])) {
 267             $splicepos = $i;
 268             last;
 269         }
 270     }
 271     unless (defined $splicepos) {
 272         if (_bigfloatlt ($epoch,   $intervals->[-1][1])) {
 273             $splicepos = @$intervals;
 274         } else {
 275             die "Panic: epoch[$epoch] should be smaller than smallest[$intervals->[-1][1]]";
 276         }
 277     }
 278     splice @$intervals, $splicepos, 0, [($epoch)x2];
 279 }
 280
 281 sub _register_one_fold2 {
 282     my($self,
 283        $intervals,
 284        $epoch,
 285       ) = @_;
 286     my $splicepos;
 287     for my $i (0..$#$intervals) {
 288         if (   $epoch eq $intervals->[$i][1]
 289                && $intervals->[$i][1] eq $intervals->[$i+1][0]) {
 290             $intervals->[$i+1][0] = $intervals->[$i][0];
 291             $splicepos = $i;
 292             last;
 293         }
 294     }
 295     if (defined $splicepos) {
 296         splice @$intervals, $splicepos, 1;
 297     } else {
 298         die "Panic: Could not find an interval position to insert '$epoch'";
 299     }
 300 }
 301
 302 =head1 PRIVATE METHODS
 303
 304 =head2 _intervals
 305
 306 =cut
 307 sub _intervals {
 308     my($self) = @_;
 309     my $x = $self->__intervals;
 310     unless (defined $x) {
 311         $x = [];
 312         $self->__intervals ($x);
 313     }
 314     return $x;
 315 }
 316
 317 =head1 COPYRIGHT & LICENSE
 318
 319 Copyright 2008 Andreas König.
 320
 321 This program is free software; you can redistribute it and/or modify it
 322 under the same terms as Perl itself.
 323
 324 =cut
 325
 326 1; # End of File::Rsync::Mirror::Recentfile
 327
 328 # Local Variables:
 329 # mode: cperl
 330 # cperl-indent-level: 4
 331 # End: