# ... if diff $EXPECTED/$file $OUTPUT/$file; then echo "*** file '$file' output has changed!"; fi #### package Test::File::Diff; use strict; use Carp qw(croak); use Test::Builder; use File::Basename; use File::Spec; use Algorithm::Diff 'diff'; use vars qw($VERSION @ISA @EXPORT); $VERSION = 0.01; =head1 NAME Test::File::Diff - Test files for equality =head1 SYNOPSIS use Test::More qw( tests => 2 ); use Test::File::Diff; # ... create output in output/foo.txt # and check that the output is the expected output: file_equal("output/foo.txt","expected/foo.txt"); =head1 ABSTRACT Test::File::Diff exports a suite of functions to test single files and directory trees for equality. This is very usefull if you have files created by an external program that you want to be checked. =head1 EXPORTS Two methods are currently exported : C Checks whether the two files given are equal. Outputs a diff of the two files if they are not. Both files are assumed to be "text" files. C Checks whether the two files given differ. Does not output a diff. =head1 MISSING Missing things are: =over 4 =item * User-supplied filters to fudge/kill timestamps before comparing files =item * A way to ignore whitespace (see fudging item above) =item * A way to compare binary files =item * A way to compare whole directory trees =back =cut require Exporter; @ISA = qw(Exporter); @EXPORT = qw(file_equal); my $Test = Test::Builder->new; sub import { my($self) = shift; my $pack = caller; $Test->exported_to($pack); $Test->plan(@_); $self->export_to_level(1, $self, 'file_equal', 'file_different'); } sub create_short_name { my ($file1,$file2) = @_; $_ = File::Spec->rel2abs($_) for ($file1,$file2); my $path1 = [File::Spec->splitdir($file1)]; my $path2 = [File::Spec->splitdir($file2)]; while (@$path1 + @$path2 and $path1->[0] eq $path2->[0]) { shift @$_ for ($path1,$path2); }; while (@$path1 + @$path2 and $path1->[-1] eq $path2->[-1]) { pop @$_ for ($path1,$path2); }; $file1 = File::Spec->catdir(@$path1); $file2 = File::Spec->catdir(@$path2); $file1 ||= $_[0]; $file2 ||= $_[1]; ($file1,$file2); }; sub get_diff { my ($file1,$file2) = @_; my $diff; eval { local *FILE1; local *FILE2; open FILE1, "< $file1" or croak "Couldn't open '$file1' for reading: $!"; open FILE2, "< $file2" or croak "Couldn't open '$file2' for reading: $!"; $diff = diff([],[]); }; $Test->diag( $@ ) if $@; $diff; }; sub file_equal { my($file1,$file2,$name) = @_; unless (defined $name) { my ($visual1,$visual2) = create_short_name($file1,$file2); $name = "Files $visual1 and $visual2 are equal"; }; my $result = 0; my $diff = get_diff($file1,$file2); $Test->ok($diff and @$diff == 0, $name); if (@$diff) { for (@$diff) { my $element; for $element (@$_) { $Test->diag( sprintf "%s %s", @$element[0,2] ); }; }; $Test->diag( "Files $file1 and $file2 differ!" ); }; $result; }; sub file_different { my($file1,$file2,$name) = @_; unless (defined $name) { my ($visual1,$visual2) = create_short_name($file1,$file2); $name = "Files $visual1 and $visual2 are different"; }; my $diff = get_diff($file1,$file2); $Test->ok($diff and @$diff != 0, $name); $result; }; 1; #### perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ; # The $d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider ($c = $d->accept())->get_request(); $c->send_response( new #in the HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' # web