1 package File
::Rsync
::Mirror
::Recentfile
::Done
;
6 use File
::Rsync
::Mirror
::Recentfile
::FakeBigFloat
qw(:all);
12 File::Rsync::Mirror::Recentfile::Done - intervals of already rsynced timespans
16 use version
; our $VERSION = qv
('0.0.5');
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 );
26 Keeping track of already rsynced timespans.
34 =head2 my $obj = CLASS->new(%hash)
36 Constructor. On every argument pair the key is a method name and the
37 value is an argument to that method name.
42 my($class, @args) = @_;
43 my $self = bless {}, $class;
45 my($method,$arg) = splice @args, 0, 2;
60 "_logfile", # undocced: a small yaml dump appended on every change
61 "_rfinterval", # undocced: the interval of the holding rf
65 split /\n/, <<'=cut'; push @accessors, grep {s/^=item\s+//} @pod_lines; }
71 Boolean to turn on a bit verbosity.
77 use accessors
@accessors;
81 =head2 $boolean = $obj->covered ( $epoch1, $epoch2 )
83 =head2 $boolean = $obj->covered ( $epoch )
85 The first form returns true if both timestamps $epoch1 and $epoch2 in
86 floating point notation have been registered within one interval,
89 The second form returns true if this timestamp has been registered.
96 for my $i (0..$#$ivs) {
98 if (_bigfloatge
($ivs->[$i][0],$Lup)) {
99 warn "Warning (may be harmless): F:R:M:R:Done object contains unsorted internal data";
104 $Lup = $ivs->[$i][0];
109 my($self, $epoch_high, $epoch_low) = @_;
110 die "Alert: covered() called without or with undefined first argument" unless defined $epoch_high;
111 my $intervals = $self->_intervals;
112 return unless @
$intervals;
113 if (defined $epoch_low) {
114 ($epoch_high,$epoch_low) = ($epoch_low,$epoch_high) if _bigfloatgt
($epoch_low,$epoch_high);
116 my $is_sorted = $self->_is_sorted($intervals);
117 for my $iv (@
$intervals) {
118 my($upper,$lower) = @
$iv; # may be the same
119 if (defined $epoch_low) {
121 for my $e ($epoch_high,$epoch_low) {
123 $e eq $upper || $e eq $lower || (_bigfloatlt
($e,$upper) && _bigfloatgt
($e,$lower));
125 return 1 if $goodbound > 1;
127 if ( _bigfloatle
( $epoch_high, $upper ) ) {
128 if ( _bigfloatge
( $epoch_high, $lower )) {
129 return 1; # "between"
131 } elsif ($is_sorted) {
132 return 0; # no chance anymore
139 =head2 (void) $obj1->merge ( $obj2 )
141 Integrates all intervals in $obj2 into $obj1. Overlapping intervals
142 are conflated/folded/consolidated. Sort order is preserved as decreasing.
146 my($self, $other) = @_;
147 my $intervals = $self->_intervals;
148 my $ointervals = $other->_intervals;
149 OTHER
: for my $oiv (@
$ointervals) {
152 SELF
: for my $i (0..$#$intervals) {
153 my $iv = $intervals->[$i];
154 if ( _bigfloatlt
($oiv->[0],$iv->[1]) ) {
155 # both oiv lower than iv => next
158 if ( _bigfloatgt
($oiv->[1],$iv->[0]) ) {
159 # both oiv greater than iv => insert
163 # larger(left-iv,left-oiv) becomes left, smaller(right-iv,right-oiv) becomes right
164 $iv->[0] = _bigfloatmax
($oiv->[0],$iv->[0]);
165 $iv->[1] = _bigfloatmin
($oiv->[1],$iv->[1]);
168 unless (defined $splicepos) {
169 if ( _bigfloatlt
($oiv->[0], $intervals->[-1][1]) ) {
170 $splicepos = @
$intervals;
172 die "Panic: left-oiv[$oiv->[0]] should be smaller than smallest[$intervals->[-1][1]]";
175 splice @
$intervals, $splicepos, 0, [@
$oiv];
177 $intervals->[0] = [@
$oiv];
182 =head2 (void) $obj->register ( $recent_events_arrayref, $register_arrayref )
184 =head2 (void) $obj->register ( $recent_events_arrayref )
186 The first arrayref is a list of hashes that contain a key called
187 C<epoch> which is a string looking like a number. The second arrayref
188 is a list if integers which point to elements in the first arrayref to
191 The second form registers all events in $recent_events_arrayref.
196 my($self, $re, $reg) = @_;
197 my $intervals = $self->_intervals;
201 REGISTRANT
: for my $i (@
$reg) {
202 my $logfile = $self->_logfile;
205 open my $fh, ">>", $logfile or die "Could not open '$logfile': $!";
206 print $fh YAML
::Syck
::Dump
({
208 Brfinterval
=> $self->_rfinterval,
210 ($i>0 ?
("Dre-1" => $re->[$i-1]) : ()),
211 "Dre-0" => $re->[$i],
212 ($i<$#$re ? ("Dre+1" => $re->[$i+1]) : ()),
213 Eintervals
=> $intervals,
220 intervals
=> $intervals,
224 open my $fh, ">>", $logfile or die "Could not open '$logfile': $!";
225 print $fh YAML
::Syck
::Dump
({
227 intervals
=> $intervals,
234 my($self, $one) = @_;
235 my($i,$re,$intervals) = @
{$one}{qw(i re intervals)};
236 die sprintf "Panic: illegal i[%d] larger than number of events[%d]", $i, $#$re
238 my $epoch = $re->[$i]{epoch
};
239 return if $self->covered ( $epoch );
242 IV
: for my $iv (@
$intervals) {
243 my($ivhi,$ivlo) = @
$iv; # may be the same
245 && _bigfloatge
($re->[$i-1]{epoch
}, $ivlo)
246 && _bigfloatle
($re->[$i-1]{epoch
}, $ivhi)
247 && _bigfloatge
($iv->[1],$epoch)
249 # if left neighbor in re belongs to this interval,
250 # then I belong to it too; let us lower the ivlo
255 && _bigfloatle
($re->[$i+1]{epoch
}, $ivhi)
256 && _bigfloatge
($re->[$i+1]{epoch
}, $ivlo)
257 && _bigfloatle
($iv->[0],$epoch)
259 # ditto for right neighbor; increase the ivhi
263 last IV
if $registered>=2;
265 if ($registered == 2) {
266 $self->_register_one_fold2
271 } elsif ($registered == 1) {
272 $self->_register_one_fold1 ($intervals);
274 $self->_register_one_fold0
281 $intervals->[0] = [($epoch)x2
];
285 sub _register_one_fold0
{
291 for my $i (0..$#$intervals) {
292 if (_bigfloatgt
($epoch, $intervals->[$i][0])) {
297 unless (defined $splicepos) {
298 if (_bigfloatlt
($epoch, $intervals->[-1][1])) {
299 $splicepos = @
$intervals;
301 die "Panic: epoch[$epoch] should be smaller than smallest[$intervals->[-1][1]]";
304 splice @
$intervals, $splicepos, 0, [($epoch)x2
];
307 # conflate: eliminate overlapping intervals
308 sub _register_one_fold1
{
309 my($self,$intervals) = @_;
312 for my $i (0..$#$intervals-1) {
313 if (_bigfloatle
($intervals->[$i][1],
314 $intervals->[$i+1][0])) {
315 $intervals->[$i+1][0] = $intervals->[$i][0];
320 if (defined $splicepos) {
321 splice @
$intervals, $splicepos, 1;
328 sub _register_one_fold2
{
333 # we know we have hit twice, like in
334 # 40:[45,40], [40,35]
335 # 40:[45,40],[42,37],[40,35]
336 # 45:[45,40], [45,35]
337 # 45:[45,40],[42,37],[45,35]
338 # 35:[45,35], [40,35]
339 # 35:[45,35],[42,37],[40,35]
340 my($splicepos, $splicelen, %assert_between);
341 for my $i (0..$#$intervals) {
342 if ( $epoch eq $intervals->[$i][0]
343 or $epoch eq $intervals->[$i][1]
345 for (my $j = 1; $i+$j <= $#$intervals; $j++) {
346 if ( $epoch eq $intervals->[$i+$j][0]
347 or $epoch eq $intervals->[$i+$j][1]) {
348 $intervals->[$i+$j][0] = _bigfloatmax
($intervals->[$i][0],$intervals->[$i+$j][0]);
349 $intervals->[$i+$j][1] = _bigfloatmin
($intervals->[$i][1],$intervals->[$i+$j][1]);
355 $assert_between{$intervals->[$i+$j][$k]}++;
361 if (defined $splicepos) {
362 for my $k (keys %assert_between) {
363 if (_bigfloatgt
($k,$intervals->[$splicepos+$splicelen][0])
364 or _bigfloatlt
($k,$intervals->[$splicepos+$splicelen][1])){
366 require Data
::Dumper
;
367 die "Panic: broken intervals:".Data
::Dumper
::Dumper
($intervals);
370 splice @
$intervals, $splicepos, $splicelen;
373 die "Panic: Could not find an interval position to insert '$epoch'";
379 Forgets everything ever done and gives way for a new round of
380 mirroring. Usually called when the dirtymark on upstream has changed.
386 $self->_intervals(undef);
389 =head1 PRIVATE METHODS
397 $self->__intervals($set);
399 my $x = $self->__intervals;
400 unless (defined $x) {
402 $self->__intervals ($x);
407 =head1 COPYRIGHT & LICENSE
409 Copyright 2008, 2009 Andreas König.
411 This program is free software; you can redistribute it and/or modify it
412 under the same terms as Perl itself.
416 1; # End of File::Rsync::Mirror::Recentfile
420 # cperl-indent-level: 4