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 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                  );
  61
  62     my @pod_lines =
  63         split /\n/, <<'=cut'; push @accessors, grep {s/^=item\s+//} @pod_lines; }
  64
  65 =over 4
  66
  67 =item verbose
  68
  69 Boolean to turn on a bit verbosity.
  70
  71 =back
  72
  73 =cut
  74
  75 use accessors @accessors;
  76
  77 =head1 METHODS
  78
  79 =head2 $boolean = $obj->covered ( $epoch1, $epoch2 )
  80
  81 =head2 $boolean = $obj->covered ( $epoch )
  82
  83 The first form returns true if both timestamps $epoch1 and $epoch2 in
  84 floating point notation have been registered, otherwise false.
  85
  86 The second form returns true if this timestamp has been registered.
  87
  88 =cut
  89
  90 sub covered {
  91     my($self, $epoch_high, $epoch_low) = @_;
  92     my $intervals = $self->_intervals;
  93     return unless @$intervals;
  94     if (defined $epoch_low) {
  95         ($epoch_high,$epoch_low) = ($epoch_low,$epoch_high) if $epoch_low > $epoch_high;
  96     }
  97     for my $iv (@$intervals) {
  98         my($upper,$lower) = @$iv; # may be the same
  99         if (defined $epoch_low) {
 100             my $goodbound = 0;
 101             for my $e ($epoch_high,$epoch_low) {
 102                 $goodbound++ if
 103                     $e eq $upper || $e eq $lower || ($e < $upper && $e > $lower);
 104             }
 105             return 1 if $goodbound > 1;
 106         } else {
 107             return 1 if $epoch_high eq $upper || $epoch_high eq $lower || ($epoch_high < $upper && $epoch_high > $lower);
 108         }
 109     }
 110     return 0;
 111 }
 112
 113 =head2 (void) $obj1->merge ( $obj2 )
 114
 115 Integrates all intervals in $obj2 into $obj1. Overlapping intervals
 116 are conflated/folded/consolidated. Sort order is preserved as decreasing.
 117
 118 =cut
 119 sub merge {
 120     my($self, $other) = @_;
 121     my $intervals = $self->_intervals;
 122     my $ointervals = $other->_intervals;
 123   OTHER: for my $oiv (@$ointervals) {
 124         my $splicepos;
 125         if (@$intervals) {
 126           SELF: for my $i (0..$#$intervals) {
 127                 my $iv = $intervals->[$i];
 128                 if ( _bigfloatlt ($oiv->[0],$iv->[1]) ) {
 129                     # both oiv lower than iv => next
 130                     next SELF;
 131                 }
 132                 if ( _bigfloatgt ($oiv->[1],$iv->[0]) ) {
 133                     # both oiv greater than iv => insert
 134                     $splicepos = $i;
 135                     last SELF;
 136                 }
 137                 # larger(left-iv,left-oiv) becomes left, smaller(right-iv,right-oiv) becomes right
 138                 $iv->[0] = _bigfloatmax ($oiv->[0],$iv->[0]);
 139                 $iv->[1] = _bigfloatmin ($oiv->[1],$iv->[1]);
 140                 next OTHER;
 141             }
 142             unless (defined $splicepos) {
 143                 if ( _bigfloatlt ($oiv->[0], $intervals->[-1][1]) ) {
 144                     $splicepos = @$intervals;
 145                 } else {
 146                     die "Panic: left-oiv[$oiv->[0]] should be smaller than smallest[$intervals->[-1][1]]";
 147                 }
 148             }
 149             splice @$intervals, $splicepos, 0, [@$oiv];
 150         } else {
 151             $intervals->[0] = [@$oiv];
 152         }
 153     }
 154 }
 155
 156 =head2 (void) $obj->register ( $recent_events_arrayref, $register_arrayref )
 157
 158 =head2 (void) $obj->register ( $recent_events_arrayref )
 159
 160 The first arrayref is a list fo hashes that contain a key called
 161 C<epoch> which is a string looking like a number. The second arrayref
 162 is a list if integers which point to elements in the first arrayref to
 163 be registered.
 164
 165 The second form registers all events in $recent_events_arrayref.
 166
 167 =cut
 168
 169 sub register {
 170     my($self, $re, $reg) = @_;
 171     my $intervals = $self->_intervals;
 172     unless ($reg) {
 173         $reg = [0..$#$re];
 174     }
 175   REGISTRANT: for my $i (@$reg) {
 176         $self->_register_one
 177             ({
 178               i => $i,
 179               re => $re,
 180               intervals => $intervals,
 181              });
 182     }
 183 }
 184
 185 sub _register_one {
 186     my($self, $one) = @_;
 187     my($i,$re,$intervals) = @{$one}{qw(i re intervals)};
 188     die sprintf "Panic: illegal i[%d] larger than number of events[%d]", $i, $#$re
 189         if $i > $#$re;
 190     my $epoch = $re->[$i]{epoch};
 191     return if $self->covered ( $epoch );
 192     if (@$intervals) {
 193         my $registered = 0;
 194         for my $iv (@$intervals) {
 195             my($upper,$lower) = @$iv; # may be the same
 196             if ($i > 0
 197                 && $re->[$i-1]{epoch} eq $lower) {
 198                 $iv->[1] = $epoch;
 199                 $registered++;
 200             }
 201             if ($i < $#$re
 202                 && $re->[$i+1]{epoch} eq $upper) {
 203                 $iv->[0] = $epoch;
 204                 $registered++;
 205             }
 206         }
 207         if ($registered == 2) {
 208             $self->_register_one_fold2
 209                 (
 210                  $intervals,
 211                  $epoch,
 212                 );
 213         } elsif ($registered == 1) {
 214         } else {
 215             $self->_register_one_fold0
 216                 (
 217                  $intervals,
 218                  $epoch,
 219                 );
 220         }
 221     } else {
 222         $intervals->[0] = [($epoch)x2];
 223     }
 224 }
 225
 226 sub _register_one_fold0 {
 227     my($self,
 228        $intervals,
 229        $epoch,
 230       ) = @_;
 231     my $splicepos;
 232     for my $i (0..$#$intervals) {
 233         if (_bigfloatgt ($epoch, $intervals->[$i][0])) {
 234             $splicepos = $i;
 235             last;
 236         }
 237     }
 238     unless (defined $splicepos) {
 239         if (_bigfloatlt ($epoch,   $intervals->[-1][1])) {
 240             $splicepos = @$intervals;
 241         } else {
 242             die "Panic: epoch[$epoch] should be smaller than smallest[$intervals->[-1][1]]";
 243         }
 244     }
 245     splice @$intervals, $splicepos, 0, [($epoch)x2];
 246 }
 247
 248 sub _register_one_fold2 {
 249     my($self,
 250        $intervals,
 251        $epoch,
 252       ) = @_;
 253     my $splicepos;
 254     for my $i (0..$#$intervals) {
 255         if (   $epoch eq $intervals->[$i][1]
 256                && $intervals->[$i][1] eq $intervals->[$i+1][0]) {
 257             $intervals->[$i+1][0] = $intervals->[$i][0];
 258             $splicepos = $i;
 259             last;
 260         }
 261     }
 262     if (defined $splicepos) {
 263         splice @$intervals, $splicepos, 1;
 264     } else {
 265         die "Panic: Could not find an interval position to insert '$epoch'";
 266     }
 267 }
 268
 269 =head1 PRIVATE METHODS
 270
 271 =head2 _intervals
 272
 273 =cut
 274 sub _intervals {
 275     my($self) = @_;
 276     my $x = $self->__intervals;
 277     unless (defined $x) {
 278         $x = [];
 279         $self->__intervals ($x);
 280     }
 281     return $x;
 282 }
 283
 284 =head1 COPYRIGHT & LICENSE
 285
 286 Copyright 2008 Andreas König.
 287
 288 This program is free software; you can redistribute it and/or modify it
 289 under the same terms as Perl itself.
 290
 291 =cut
 292
 293 1; # End of File::Rsync::Mirror::Recentfile
 294
 295 # Local Variables:
 296 # mode: cperl
 297 # cperl-indent-level: 4
 298 # End: