view release on metacpan or  search on metacpan

lib/File/Modified.pm  view on Meta::CPAN

    Defaultmethod => $method,
    Files => {},
  };

  bless $self, $class;

  $self->addfile(@$files);

  return $self;
};

sub _make_digest_signature {
  my ($self,$digest) = @_;

  eval "use Digest::$digest";

  if (! $@) {
    no strict 'refs';
    if (@{"Digest::${digest}::ISA"}) {
      @{"File::Modified::Signature::${digest}::ISA"} = qw(File::Modified::Signature::Digest);
      return 1;
    };
  };
  return undef;
};

sub add {
  my ($self,$filename,$method) = @_;
  $method ||= $self->{Defaultmethod};

  my $signatureclass = "File::Modified::Signature::$method";
  my $s = eval { $signatureclass->new($filename) };
  if (! $@) {
    return $self->{Files}->{$filename} = $s;
  } else {
    # retry and try Digest::$method

    if ($self->_make_digest_signature($method)) {
      my $s = $signatureclass->new($filename);
      return $self->{Files}->{$filename} = $s;
    } else {
      return undef;
    };
  };
};

sub addfile {
  my ($self,@files) = @_;

  my @result;

  # We only return something if the caller wants it
  if (defined wantarray) {
    push @result, $self->add($_) for @files;
    return @result;
  } else {
    $self->add($_) for @files;
  };
};

sub update {
  my ($self) = @_;

  $_->initialize() for values %{$self->{Files}};
};

sub changed {
  my ($self) = @_;

  return map {$_->{Filename}} grep {$_->changed()} (values %{$self->{Files}});
};

1;

{
  package File::Modified::Signature;
$File::Modified::Signature::VERSION = '0.10';
  # This is a case where Python would be nicer. With Python, we could have (paraphrased)
  # class File::Modified::Signature;
  #       def initialize(self):
  #           self.hash = self.identificate()
  #           return self
  #       def signature(self):
  #           return MD5(self.filename)
  #       def changed(self):
  #           return self.hash != self.signature()
  # and it would work as expected, (almost) regardless of the structure that is returned
  # by self.signature(). This is some DWIMmery that I sometimes miss in Perl.
  # For now, only string comparisions are allowed.

  sub create {
    my ($class,$filename,$signature) = @_;

    my $self = {
      Filename => $filename,
      Signature => $signature,
    };

    bless $self, $class;
  };

  sub new {
    my ($class,$filename) = @_;

    my $self = $class->create($filename);
    $self->initialize();

    return $self;
  };

  sub initialize {
    my ($self) = @_;
    $self->{Signature} = $self->signature();
    return $self;
  };

  sub from_scalar {
    my ($baseclass,$scalar) = @_;
    die "Strange value in from_scalar: $scalar\n" unless $scalar =~ /^([^|]+)\|([^|]+)\|(.+)$/;
    my ($class,$filename,$signature) = ($1,$2,$3);
    return $class->create($filename,$signature);