# ...
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