view release on metacpan or  search on metacpan

lib/File/Rsync/Mirror/Recentfile.pm  view on Meta::CPAN

    my $rfile = $self->rfile;
    unlink "$rfile.lock/process" or warn "Could not unlink lockfile '$rfile.lock/process': $!";
    rmdir "$rfile.lock" or warn "Could not rmdir lockdir '$rfile.lock': $!";;
    $self->_is_locked (0);
}

=head2 unseed

Sets this recentfile in the state of not 'seeded'.

=cut
sub unseed {
    my($self) = @_;
    $self->seeded(0);
}

=head2 $ret = $obj->update ($path, $type)

=head2 $ret = $obj->update ($path, "new", $dirty_epoch)

=head2 $ret = $obj->update ()

Enter one file into the local I<recentfile>. $path is the (usually
absolute) path. If the path is outside I<our> tree, then it is
ignored.

C<$type> is one of C<new> or C<delete>.

Events of type C<new> may set $dirty_epoch. $dirty_epoch is normally
not used and the epoch is calculated by the update() routine itself
based on current time. But if there is the demand to insert a
not-so-current file into the dataset, then the caller sets
$dirty_epoch. This causes the epoch of the registered event to become
$dirty_epoch or -- if the exact value given is already taken -- a tiny
bit more. As compensation the dirtymark of the whole dataset is set to
now or the current epoch, whichever is higher. Note: setting the
dirty_epoch to the future is prohibited as it's very unlikely to be
intended: it definitely might wreak havoc with the index files.

The new file event is unshifted (or, if dirty_epoch is set, inserted
at the place it belongs to, according to the rule to have a sequence
of strictly decreasing timestamps) to the array of recent_events and
the array is shortened to the length of the timespan allowed. This is
usually the timespan specified by the interval of this recentfile but
as long as this recentfile has not been merged to another one, the
timespan may grow without bounds.

The third form runs an update without inserting a new file. This may
be desired to truncate a recentfile.

=cut
sub _epoch_monotonically_increasing {
    my($self,$epoch,$recent) = @_;
    return $epoch unless @$recent; # the first one goes unoffended
    if (_bigfloatgt("".$epoch,$recent->[0]{epoch})) {
        return $epoch;
    } else {
        return _increase_a_bit($recent->[0]{epoch});
    }
}
sub update {
    my($self,$path,$type,$dirty_epoch) = @_;
    if (defined $path or defined $type or defined $dirty_epoch) {
        die "update called without path argument" unless defined $path;
        die "update called without type argument" unless defined $type;
        die "update called with illegal type argument: $type" unless $type =~ /(new|delete)/;
    }
    $self->lock;
    my $ctx = $self->_locked_batch_update([{path=>$path,type=>$type,epoch=>$dirty_epoch}]);
    $self->write_recent($ctx->{recent}) if $ctx->{something_done};
    $self->_assert_symlink;
    $self->unlock;
}

=head2 $obj->batch_update($batch)

Like update but for many files. $batch is an arrayref containing
hashrefs with the structure

  {
    path => $path,
    type => $type,
    epoch => $epoch,
  }



=cut
sub batch_update {
    my($self,$batch) = @_;
    $self->lock;
    my $ctx = $self->_locked_batch_update($batch);
    $self->write_recent($ctx->{recent}) if $ctx->{something_done};
    $self->_assert_symlink;
    $self->unlock;
}
sub _locked_batch_update {
    my($self,$batch) = @_;
    my $something_done = 0;
    my $recent = $self->recent_events;
    unless ($recent->[0]) {
        # obstetrics
        $something_done = 1;
    }
    my %paths_in_recent = map { $_->{path} => undef } @$recent;
    my $interval = $self->interval;
    my $canonmeth = $self->canonize;
    unless ($canonmeth) {
        $canonmeth = "naive_path_normalize";
    }
    my $oldest_allowed = 0;
    my $setting_new_dirty_mark = 0;
    my $console;
    if ($self->verbose && @$batch > 1) {
        eval {require Time::Progress};
        warn "dollarat[$@]" if $@;
        $| = 1;
        $console = new Time::Progress;
        $console->attr( min => 1, max => scalar @$batch );
        print "\n";
    }