r17901 - in /branches/upstream/libfile-modified-perl: ./ current/ current/example/ current/lib/ current/lib/File/ current/t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri Mar 21 10:21:20 UTC 2008
Author: eloy
Date: Fri Mar 21 10:21:19 2008
New Revision: 17901
URL: http://svn.debian.org/wsvn/?sc=1&rev=17901
Log:
[svn-inject] Installing original source of libfile-modified-perl
Added:
branches/upstream/libfile-modified-perl/
branches/upstream/libfile-modified-perl/current/
branches/upstream/libfile-modified-perl/current/.cvsignore (with props)
branches/upstream/libfile-modified-perl/current/Changes (with props)
branches/upstream/libfile-modified-perl/current/MANIFEST
branches/upstream/libfile-modified-perl/current/MANIFEST.skip (with props)
branches/upstream/libfile-modified-perl/current/META.yml
branches/upstream/libfile-modified-perl/current/Makefile.PL (with props)
branches/upstream/libfile-modified-perl/current/README (with props)
branches/upstream/libfile-modified-perl/current/bug.txt (with props)
branches/upstream/libfile-modified-perl/current/example/
branches/upstream/libfile-modified-perl/current/example/1.pl (with props)
branches/upstream/libfile-modified-perl/current/example/Export.cfg (with props)
branches/upstream/libfile-modified-perl/current/example/Import.cfg (with props)
branches/upstream/libfile-modified-perl/current/lib/
branches/upstream/libfile-modified-perl/current/lib/File/
branches/upstream/libfile-modified-perl/current/lib/File/Modified.pm (with props)
branches/upstream/libfile-modified-perl/current/t/
branches/upstream/libfile-modified-perl/current/t/.cvsignore (with props)
branches/upstream/libfile-modified-perl/current/t/test.t (with props)
Added: branches/upstream/libfile-modified-perl/current/.cvsignore
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/.cvsignore?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/.cvsignore (added)
+++ branches/upstream/libfile-modified-perl/current/.cvsignore Fri Mar 21 10:21:19 2008
@@ -1,0 +1,10 @@
+blib
+Makefile
+File-Modified*
+*.old
+*.tar.gz
+pm_to_blib
+.lwpcookies
+META.yml
+blibdirs.ts
+pm_to_blib.ts
Propchange: branches/upstream/libfile-modified-perl/current/.cvsignore
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/Changes?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/Changes (added)
+++ branches/upstream/libfile-modified-perl/current/Changes Fri Mar 21 10:21:19 2008
@@ -1,0 +1,25 @@
+Revision history for Perl extension File::Modified.
+
+0.01 Tue Apr 16 18:55:38 2002
+ - original version; created by h2xs 1.21 with options
+ -X File::Modified
+
+0.02 Thu May 09 2002
+ - Added checksum signature
+ - Added more tests (now up to 40)
+ - Changed MD5 fallback from mtime to checksum
+ - Added general use of the Digest:: module tree instead of MD5 only
+
+0.04 Sun Aug 11 2002
+ - Fixed stupid bug in Signature::MD5 by adding a call to binmode()
+
+0.05 Sun Aug 11 2002
+ - Adjusted number of planned tests in the distribution test file
+
+0.06 Mon Aug 12 2002
+ - Yet another test-only update : Check that the different digests
+ are actually there before using them. Apparently, MD2 isn't in
+ the Digest:: modules anymore. Added directory watching to the Todo list.
+0.07 20041205
+ - Changed a hidden submodule so it doesn't clash with File::Signature anymore.
+ - Directory cleanup (Modified.pm was distributed twice)
Propchange: branches/upstream/libfile-modified-perl/current/Changes
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/MANIFEST?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/MANIFEST (added)
+++ branches/upstream/libfile-modified-perl/current/MANIFEST Fri Mar 21 10:21:19 2008
@@ -1,0 +1,14 @@
+.cvsignore
+bug.txt
+Changes
+example/1.pl
+example/Export.cfg
+example/Import.cfg
+lib/File/Modified.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.skip
+README
+t/.cvsignore
+t/test.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libfile-modified-perl/current/MANIFEST.skip
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/MANIFEST.skip?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/MANIFEST.skip (added)
+++ branches/upstream/libfile-modified-perl/current/MANIFEST.skip Fri Mar 21 10:21:19 2008
@@ -1,0 +1,11 @@
+\.lwpcookies$
+\.cvsignore$
+\.releaserc$
+blib
+File-Modified-*
+File-Modified-*/
+CVS/
+pm_to_blib
+cvstest
+Makefile
+.releaserc
Propchange: branches/upstream/libfile-modified-perl/current/MANIFEST.skip
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/META.yml?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/META.yml (added)
+++ branches/upstream/libfile-modified-perl/current/META.yml Fri Mar 21 10:21:19 2008
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: File-Modified
+version: 0.07
+version_from: lib/File/Modified.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.24
Added: branches/upstream/libfile-modified-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/Makefile.PL?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/Makefile.PL (added)
+++ branches/upstream/libfile-modified-perl/current/Makefile.PL Fri Mar 21 10:21:19 2008
@@ -1,0 +1,18 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+# Nice-to-have prerequisites :
+foreach (qw(Digest Digest::MD5)) {
+ warn "File::Modified likes to have $_, but doesn't require it.\n"
+ unless eval "require $_; 1";
+};
+
+WriteMakefile(
+ 'NAME' => 'File::Modified',
+ 'VERSION_FROM' => 'lib/File/Modified.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/File/Modified.pm', # retrieve abstract from module
+ AUTHOR => 'Max Maischein <corion at cpan.org>') : ()),
+);
Propchange: branches/upstream/libfile-modified-perl/current/Makefile.PL
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/README?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/README (added)
+++ branches/upstream/libfile-modified-perl/current/README Fri Mar 21 10:21:19 2008
@@ -1,0 +1,28 @@
+File::Modified version 0.02
+=========================
+
+This module provides an easy way for long running processes
+(like daemons) to determine whether a file was changed since
+the last time it was checked. Also, some persistence now
+allows you to use it as a more general caching mechanism.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+Digest is optional but nice to have. If a script uses MD5 features, a fallback
+ to checksums is available.
+Test::More is needed to run the test script.
+
+COPYRIGHT AND LICENCE
+
+This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+Copyright (C) 2002 Max Maischein, corion at cpan.org
Propchange: branches/upstream/libfile-modified-perl/current/README
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/bug.txt
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/bug.txt?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/bug.txt (added)
+++ branches/upstream/libfile-modified-perl/current/bug.txt Fri Mar 21 10:21:19 2008
@@ -1,0 +1,3 @@
+The synopsis is partly incorrect :
+
+$0 eq '-e' shouldn't be watched ...
Propchange: branches/upstream/libfile-modified-perl/current/bug.txt
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/example/1.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/example/1.pl?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/example/1.pl (added)
+++ branches/upstream/libfile-modified-perl/current/example/1.pl Fri Mar 21 10:21:19 2008
@@ -1,0 +1,15 @@
+use lib '..';
+use Dependencies;
+
+my $d = Dependencies->new(Files=>['Import.cfg','Export.cfg']);
+
+while (1) {
+ my (@changes) = $d->changed;
+ if (@changes) {
+ print "$_ was changed\n" for @changes;
+ $d->update();
+ } else {
+ print "No changes detected.\n";
+ };
+ sleep 5;
+};
Propchange: branches/upstream/libfile-modified-perl/current/example/1.pl
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/example/Export.cfg
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/example/Export.cfg?rev=17901&op=file
==============================================================================
(empty)
Propchange: branches/upstream/libfile-modified-perl/current/example/Export.cfg
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/example/Import.cfg
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/example/Import.cfg?rev=17901&op=file
==============================================================================
(empty)
Propchange: branches/upstream/libfile-modified-perl/current/example/Import.cfg
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/lib/File/Modified.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/lib/File/Modified.pm?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/lib/File/Modified.pm (added)
+++ branches/upstream/libfile-modified-perl/current/lib/File/Modified.pm Fri Mar 21 10:21:19 2008
@@ -1,0 +1,372 @@
+package File::Modified;
+use strict;
+use warnings;
+
+use vars qw( @ISA $VERSION );
+
+$VERSION = '0.07';
+
+sub new {
+ my ($class, %args) = @_;
+
+ my $method = $args{method} || "MD5";
+ my $files = $args{files} || [];
+
+ my $self = {
+ 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 (defined @{"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, at 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;
+
+ # 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);
+ };
+
+ sub as_scalar {
+ my ($self) = @_;
+ return ref($self) . "|" . $self->{Filename} . "|" . $self->{Signature};
+ };
+
+ sub changed {
+ my ($self) = @_;
+ my $currsig = $self->signature();
+
+ # FIXME: Deep comparision of the two signatures instead of equality !
+ # And what's this about string comparisions anyway ?
+ if ((ref $currsig) or (ref $self->{Signature})) {
+ die "Implementation error in $self : changed() can't handle references and complex structures (yet) !\n";
+ #return $currsig != $self->{Signature};
+ } else {
+ return $currsig ne $self->{Signature};
+ };
+ };
+};
+
+{
+ package File::Modified::Signature::mtime;
+ use base 'File::Modified::Signature';
+
+ sub signature {
+ my ($self) = @_;
+
+ my @stat = stat $self->{Filename} or die "Couldn't stat '$self->{Filename}' : $!";
+
+ return $stat[9];
+ };
+};
+
+{
+ package File::Modified::Signature::Checksum;
+ use base 'File::Modified::Signature';
+
+ sub signature {
+ my ($self) = @_;
+ my $result;
+ if (-e $self->{Filename} and -r $self->{Filename}) {
+ local *F;
+ open F, $self->{Filename} or die "Couldn't read from file '$self->{Filename}' : $!";
+ binmode F;
+
+ my $buf;
+ while (read(F,$buf,32768)) {
+ $result += unpack("%32C*", $buf);
+ $result %= 0xFFFFFFFF;
+ };
+
+ close F;
+ };
+ return $result;
+ };
+};
+
+{
+ package File::Modified::Signature::Digest;
+ use base 'File::Modified::Signature';
+
+ sub digestname {
+ my ($class) = @_;
+ $class = ref $class || $class;
+ return $1 if ($class =~ /^File::Modified::Signature::([^:]+)$/);
+ };
+
+ sub digest {
+ my ($self) = @_;
+ if (! exists $self->{Digest}) {
+ my $digestclass = "Digest::" . $self->digestname;
+ eval "use $digestclass";
+ $self->{Digest} = $digestclass->new();
+ };
+ return $self->{Digest};
+ };
+
+ sub signature {
+ my ($self) = @_;
+ my $result;
+ if (-e $self->{Filename} and -r $self->{Filename}) {
+ local *F;
+ open F, $self->{Filename} or die "Couldn't read from file '$self->{Filename}' : $!";
+ binmode F;
+ $result = $self->digest->addfile(*F)->b64digest();
+ close F;
+ };
+ return $result;
+ };
+};
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Modified - checks intelligently if files have changed
+
+=head1 SYNOPSIS
+
+ use strict;
+ use File::Modified;
+
+ my $d = File::Modified->new(files=>['Import.cfg','Export.cfg']);
+
+ while (1) {
+ my (@changes) = $d->changed;
+
+ if (@changes) {
+ print "$_ was changed\n" for @changes;
+ $d->update();
+ };
+ sleep 60;
+ };
+
+Second example - a script that knows when any of its modules have changed :
+
+ use File::Modified;
+ my $files = File::Modified->new(files=>[values %INC, $0]);
+
+ # We want to restart when any module was changed
+ exec $0, @ARGV if $files->changed();
+
+=head1 DESCRIPTION
+
+The Modified module is intended as a simple method for programs to detect
+whether configuration files (or modules they rely on) have changed. There are
+currently two methods of change detection implemented, C<mtime> and C<MD5>.
+The C<MD5> method will fall back to use timestamps if the C<Digest::MD5> module
+cannot be loaded.
+
+There is another module, L<File::Signature>, which has many similar features,
+so if this module doesn't do what you need, maybe File::Signature does. There
+also is quite some overlap between the two modules, code wise.
+
+=over 4
+
+=item new %ARGS
+
+Creates a new instance. The C<%ARGS> hash has two possible keys,
+C<Method>, which denotes the method used for checking as default,
+and C<Files>, which takes an array reference to the filenames to
+watch.
+
+=item add filename, method
+
+Adds a new file to watch. C<method> is the method (or rather, the
+subclass of C<File::Modified::Signature>) to use to determine whether
+a file has changed or not. The result is either the C<File::Modified::Signature>
+subclass or undef if an error occurred.
+
+=item addfile LIST
+
+Adds a list of files to watch. The method used for watching is the
+default method as set in the constructor. The result is a list
+of C<File::Modified::Signature> subclasses.
+
+=item update
+
+Updates all signatures to the current state. All pending changes
+are discarded.
+
+=item changed
+
+Returns a list of the filenames whose files did change since
+the construction or the last call to C<update> (whichever last
+occurred).
+
+=back
+
+=head2 Signatures
+
+The module also creates a new namespace C<File::Signature>, which sometime
+will evolve into its own module in its own file. A file signature is most
+likely of little interest to you; the only time you might want to access
+the signature directly is to store the signature in a file for persistence
+and easy comparision whether an index database is current with the actual data.
+
+The interface is settled, there are two methods, C<as_scalar> and C<from_scalar>,
+that you use to freeze and thaw the signatures. The implementation of these methods
+is very frugal, there are no provisions made against filenames that contain weird
+characters like C<\n> or C<|> (the pipe bar), both will be likely to mess up your
+one-line-per-file database. An interesting method could be to URL-encode all filenames,
+but I will visit this topic in the next release. Also, complex (that is, non-scalar)
+signatures are handled rather ungraceful at the moment.
+
+Currently, I'm planning to use L<Text::Quote> as a quoting mechanism to protect against
+multiline filenames.
+
+=head2 Adding new methods for signatures
+
+Adding a new signature method is as simple as creating a new subclass
+of C<File::Signature>. See C<File::Signature::Checksum> for a simple
+example. There is one point of laziness in the implementation of C<File::Signature>,
+the C<check> method can only compare strings instead of arbitrary structures (yes,
+there ARE things that are easier in Python than in Perl). C<File::Signature::Digest>
+is a wrapper for Gisle Aas' L<Digest> module and allows you to use any module below
+the C<Digest> namespace as a signature, for example C<File::Signature::MD5> and
+C<File::Signature::SHA1>.
+
+=head2 TODO
+
+* Make the simple persistence solution for the signatures better using L<Text::Quote>.
+
+* Allow complex structures for the signatures.
+
+* Document C<File::Modified::Signature> or put it down into another namespace.
+
+* Extract the C<File::Modified::Signature> subclasses out into their own file.
+
+* Create an easy option to watch a whole directory tree.
+
+=head2 EXPORT
+
+None by default.
+
+=head2 COPYRIGHT AND LICENSE
+
+This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+Copyright (C) 2002 Max Maischein
+
+=head1 AUTHOR
+
+Max Maischein, E<lt>corion at cpan.orgE<gt>
+
+Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome !
+
+=head1 SEE ALSO
+
+L<perl>,L<Digest::MD5>,L<Digest>, L<File::Signature>.
+
+=cut
Propchange: branches/upstream/libfile-modified-perl/current/lib/File/Modified.pm
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/t/.cvsignore
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/t/.cvsignore?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/t/.cvsignore (added)
+++ branches/upstream/libfile-modified-perl/current/t/.cvsignore Fri Mar 21 10:21:19 2008
@@ -1,0 +1,1 @@
+embedded-*
Propchange: branches/upstream/libfile-modified-perl/current/t/.cvsignore
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-modified-perl/current/t/test.t
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-modified-perl/current/t/test.t?rev=17901&op=file
==============================================================================
--- branches/upstream/libfile-modified-perl/current/t/test.t (added)
+++ branches/upstream/libfile-modified-perl/current/t/test.t Fri Mar 21 10:21:19 2008
@@ -1,0 +1,171 @@
+#!/usr/bin/perl -w
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+use strict;
+
+#########################
+
+use Test::More;
+use vars qw($have_file_temp $have_digest @methods @digest_methods);
+
+BEGIN {
+ eval "use Digest;";
+ $have_digest = ! $@;
+
+ @digest_methods = ();
+
+ for (qw(MD2 MD5 SHA1 nonExistingDigest)) {
+ eval "use Digest::$_;";
+ push @digest_methods, $_ unless $@;
+ };
+
+ eval "use File::Temp qw( tempfile )";
+ $have_file_temp = ! $@;
+
+ # Now set up a list of all methods that will result in isa($method)
+ # without falling back to something else ...
+ @methods = qw(mtime Checksum);
+ push @methods, @digest_methods if $have_digest;
+
+ plan tests => 5+7 * scalar (@methods) + scalar (@digest_methods) +1;
+};
+
+BEGIN {
+ use_ok( 'File::Modified' );
+};
+
+
+#########################
+
+# Our script shouldn't have changed its identity :
+for my $method (@methods) {
+ ok( ! File::Modified->new(method=>$method,files=>[$0])->changed(), "Checking $method identity for our script");
+};
+
+# In fact, no module should have changed its identity :
+for my $method (@methods) {
+ ok( ! File::Modified->new(method=>$method,files=>[values %INC])->changed(), "Checking $method identity for values of %INC");
+};
+
+# Let's see that adding returns the right kind and number of things
+for my $method (@methods) {
+ my $m = File::Modified->new(method=>$method);
+ my @sigs = $m->addfile($0);
+ is(@sigs, 1, "$method: One file added");
+ @sigs = $m->addfile($0,$0,$0,$0,$0,$0);
+ is(@sigs, 6, "$method: Six files added");
+ isa_ok($sigs[0], "File::Modified::Signature::$method", "File::Modified->new(method=>$method)");
+};
+
+# Test that a signature can be stored and loaded :
+for my $method (@methods) {
+ my $m = File::Modified->new(method=>$method);
+ my @f = $m->addfile($0);
+ my $persistent = $f[0]->as_scalar();
+ isa_ok(File::Modified::Signature->from_scalar($persistent),ref $f[0],"Loading back $method");
+};
+
+# Now test the fallback to checksums whenever Digest:: is not available
+SKIP: {
+ skip "Digest:: is not installed", 1 unless $have_digest;
+ is( $File::Modified::Signature::Digest::fallback, undef, "Checksum fallback for MD5 correctly disabled" );
+};
+SKIP: {
+ skip "Digest:: is installed", 2 unless ! $have_digest;
+ is( $File::Modified::Signature::Digest::fallback, 1, "Checksum fallback for Digest::xx correctly enabled" );
+ my $m = File::Modified->new(method=>"MD5");
+ my $s = $m->add($0,'MD5');
+ isa_ok($s,"File::Modified::Signature::Checksum","Digest::xx fallback");
+};
+
+SKIP: {
+ skip "File::Temp is not installed", (scalar @methods)*2 unless $have_file_temp;
+
+ my %d;
+
+ my ($fh, $filename);
+ eval {
+ ($fh,$filename) = tempfile();
+ close $fh;
+ open F, "> $filename" or die "couldn't write to tempfile '$filename'\n";
+ print F "foo";
+ close F;
+
+ sleep 3;
+
+ for my $method (@methods) {
+ $d{$method} = File::Modified->new(method=>$method,files=>[$filename]);
+ };
+
+ open F, "> $filename" or die "couldn't write to tempfile '$filename'\n";
+ print F "bar";
+ close F;
+ };
+ diag $@ if $@;
+ for my $method (@methods) {
+ ok($d{$method}->changed(), "Detecting changed file via $method");
+ };
+
+ # Clean up the tempfile
+ if ($filename) {
+ unlink($filename) or diag "Couldn't remove tempfile $filename : $!\n";
+ };
+};
+
+# Now test the handling of nonexisting signature methods :
+my $d = File::Modified->new( method => 'DoesNotExist' );
+is( $d->add( 'foo' ), undef, "Nonexistent File::Modified::Signature:: classes correctly fail");
+
+TODO: {
+ local $TODO = "Deep comparision of structures not yet implemented";
+
+ {
+ package File::Modified::Signature::Complicated;
+
+ sub signature {
+ my ($self) = @_;
+ my $result = [$self->{Filename}];
+ return $result;
+ };
+ };
+
+ my $d = File::Modified->new(method => 'Complex',files => ['does_not_need_to_exist']);
+
+ ok(! $d->changed);
+};
+
+SKIP: {
+ skip "File::Temp is not installed", 1 unless $have_file_temp;
+ skip "Digest::* is not installed", 1 unless $have_digest;
+
+ my %d;
+ my $digest;
+
+ my ($fh, $filename);
+ ($fh,$filename) = tempfile();
+ close $fh;
+
+ for $digest (@digest_methods) {
+
+ eval {
+ open F, "> $filename" or die "couldn't write to tempfile '$filename'\n";
+ print F "foo\cZbaz";
+ close F;
+
+ #sleep 3;
+ $d{$digest} = File::Modified->new(method=>$digest,files=>[$filename]);
+
+ open F, "> $filename" or die "couldn't write to tempfile '$filename'\n";
+ print F "foo\cZbar";
+ close F;
+ };
+ diag $@ if $@;
+ ok($d{$digest}->changed(), "Detecting changed binary file via Digest::$digest");
+ };
+
+ # Clean up the tempfile
+ if ($filename) {
+ unlink($filename) or diag "Couldn't remove tempfile $filename : $!\n";
+ };
+};
Propchange: branches/upstream/libfile-modified-perl/current/t/test.t
------------------------------------------------------------------------------
svn:executable =
More information about the Pkg-perl-cvs-commits
mailing list