Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
use strict; package File::DiffTree; # File::DiffTree -- Compare two directory hierarchies # By Ned Konz, # $Revision$ use vars '$VERSION'; use Algorithm::Diff 1.01 (); use File::Find (); BEGIN { $File::DiffTree::VERSION = "0.1"; } sub _findFiles { my $topDir = shift; my $statFields = shift; my $reject = shift; my $topDirLength = length($topDir); my @files; File::Find::find( sub { my @stat = stat($_); if (!@stat) { warn "can't stat $File::Find::name : $!\n"; retu +rn } return if -d _; my $fileName = substr($File::Find::name, $topDirLength); return if defined($reject) && &$reject($File::Find::name, @sta +t); push(@files, [ $fileName, @stat[ @$statFields ] ]); }, $topDir); return \@files; } sub diffTree { my $dirA = shift; my $dirB = shift; my $userOptions = shift || { }; my $numberOfFields; my $numberOfSignificantFields; my $foldCase = sub { $_[0] }; # default no fold my %options = ( onlya => sub { }, onlyb => sub { }, match => sub { }, statfields => [ 7, 9 ], # size, mtime hash => sub { # default=stringize them my $arr = shift; join($;, $foldCase->($arr->[0]), @{$arr}[ 1 .. $numberOfSignificantFields ]) }, reject => undef, significantfields => undef, foldcase => 0, sort => sub { $foldCase->($a->[0]) cmp $foldCase->($b-> +[0]) }, # normalize the user's keys (DWIM) map { my $key = $_; $key =~ tr/A-Z_/a-z/d; $key, $userOptions->{$_} } keys(%$userOptions) ); $numberOfFields = scalar(@{$options{statfields}}); $numberOfSignificantFields = defined($options{significantfields}) ? $options{significantfields} : $numberOfFields; $numberOfSignificantFields = $numberOfFields if $numberOfSignificantFields > $numberOfFields; $foldCase = sub { lc($_[0]) } if $options{foldcase}; my $filesA = _findFiles($dirA, $options{statfields}, $options{reje +ct}); my $filesB = _findFiles($dirB, $options{statfields}, $options{reje +ct}); # sort by name @$filesA = sort { $options{sort}->() } @$filesA; @$filesB = sort { $options{sort}->() } @$filesB; Algorithm::Diff::traverse_sequences( $filesA, $filesB, { MATCH => sub { $options{match}->($filesA->[$_[0]], $filesB->[$_[1]]) +}, DISCARD_A => sub { $options{onlya}->($filesA->[$_[0]]) } +, DISCARD_B => sub { $options{onlyb}->($filesB->[$_[1]]) } +, }, $options{hash} ); } 1; __END__ =head1 NAME File::DiffTree - Compare two directory hierarchies =head1 SYNOPSIS use File::DiffTree; File::DiffTree::diffTree($dirA, $dirB, { Match => sub { print $_[0]->[0], " matches\n" }, # Fold_Case => 1, # if on OS that doesn't care like windoze }); =head1 DESCRIPTION C<File::DiffTree> compares the files in two directory hierarchies, cal +ling optional user-supplied callbacks for files in just one or the other di +rectory, as well as for files that match. Matching is determined by matching the name (with optional case foldin +g), as well as zero or more of the numbers output by the C<stat()> call. You +can specify how many fields from C<stat> will be looked at for a match. You can also specify how many fields from stat will be provided to you +r callback routines. See OPTIONS below for the options to C<File::DiffTree::diffTree>. =head1 OPTIONS The third argument to File::DiffTree::diffTree is a hash reference that can contain the following options. Option names may have undersco +res or capital letters as desired (that is, OnlyA, O_n_L_ya, Only_A, onlya, a +nd only_a are equivalent). Since nothing by default is done for B<only_a>, B<only_b>, or B<match> +, you must provide at least one of these for any interesting behavior. =over 4 =item B<only_a> =item B<only_b> The B<only_a> and B<only_b> options supply CODE references to user cal +lback routines that are called when a file appears in only one of the two di +rectory trees, or exists in both but has different significant stat fields. By default, nothing is done for these files. The argument to these routines is an array that contains the filename +relative to the starting directory, as well as whatever fields from stat were d +efaulted or specified with the B<stat_fields> option. File::DiffTree::diffTree( $dir1, $dir2, { only_a => sub { print "only in $dir1: ", $_[0]->[0], "\n" }, only_b => sub { print "only in $dir2: ", $_[0]->[0], "\n" }, }); Of course, you can also specify a reference to a separate subroutine t +hat you've written: File::DiffTree::diffTree( $dir1, $dir2, { only_a => \&onlyA, only_b => \&onlyB, }); =item B<match> The B<match> option supplies a CODE reference to a user callback routi +ne that is called when a file appears to match (based on name and significant +fields from the stat call). By default, nothing is done for these files. The arguments to the B<match> routine are two arrays (one for each dir +ectory) that contain the filename relative to the starting directory, as well +as whatever fields from stat were defaulted or specified with the B<stat_ +fields> option. File::DiffTree::diffTree( $dir1, $dir2, { match => sub { print "in both $dir1 and $dir2: ", $_[0]->[0], "\ +n" }, }); =item B<stat_fields> The B<stat_fields> option specifies which fields from C<stat> will be passed to the B<only_a>, B<only_b>, or B<match> user callbacks. This i +s an ARRAY reference consisting of numbers from 0 through 12. By default +, it is: stat_fields => [ 7, 9 ], That is, the size and mtime (last modified time) of the files are pass +ed. The possible field numbers are: 0 dev device number of filesystem 1 ino inode number 2 mode file mode (type and permissions) 3 nlink number of (hard) links to the file 4 uid numeric user ID of file's owner 5 gid numeric group ID of file's owner 6 rdev the device identifier (special files only) 7 size total size of file, in bytes 8 atime last access time in seconds since the epoch 9 mtime last modify time in seconds since the epoch 10 ctime inode change time (NOT creation time!) in seconds since +the epoch 11 blksize preferred block size for file system I/O 12 blocks actual number of blocks allocated If you want to compare only the name and size, but still have access t +o the modification time and inode, you can specify this using: File::DiffTree::diffTree( $dir1, $dir2, { match => sub { print "in both $dir1 and $dir2: ", $_[0]->[0], "\n" }, stat_fields => [ 7, 9, 1 ], # size, mtime, inode significant_fields => 1, # just size }); Unless the B<significant_fields> option below is specified, all of the B<stat_fields> will be considered when looking for a match. So by defa +ult, file comparisons compare name, size, and modification time. =item B<significant_fields> The B<significant_fields> option is a number that specifies how many o +f the fields from C<stat> will be considered when comparing files. By de +fault, all of the fields will be compared. If you supply a 0 for B<significan +t_fields>, only the name will be compared. This option is provided so that you can have separate control over how + many fields from C<stat> you are passed and how many of those fields are co +mpared by C<File::DiffTree>. =item B<reject> The B<reject> option is a CODE reference that can be provided to filte +r files that are unwanted. It is called from inside C<File::Find::find> with t +he full filename and all the fields from C<stat> (this is 13 arguments). Also, the C<$_> variable is set to the last component of the filename, the current directory is the directory of the file, and the C<_> pseud +o- file handle can be tested. If it returns true, the file will not be considered. For instance, to ignore files that are unreadable or end in C<.bak>, you can do this: File::DiffTree::diffTree( $dir1, $dir2, { match => sub { print "in both $dir1 and $dir2: ", $_[0]->[0], "\n" }, reject => sub { /\.bak$/ || ! -r _ } }); =item B<fold_case> If the B<fold_case> option is provided and is true, filenames will be compared ignoring case differences. The filenames passed to the user callbacks will have the actual case preserved. This is probably what is wanted under Windows. You can do this for portability: Fold_Case => ($^O eq 'Win32'), =item B<sort> The B<sort> option is a CODE reference that supplies an optional subro +utine that will be called when sorting the lists of files. It will have the +two arrays to be compared passed in via the package variables C<$File::DiffTree:: +a> and C<$File::DiffTree::b>. By default, sorting is by filename, with case f +olding if the B<fold_case> option is set. You probably won't need this option. If you do, you may have to supply + the B<hash> option as well. =item B<hash> The B<hash> option is a CODE reference that supplies an optional subro +utine that will be called to generate a key to determine uniqueness of the f +iles. By default, this key will consist of the file name, and all the stat f +ields specified by the B<significant_fields> option, turned into strings and separated by the C<$;> character (by default C<\034>). Specify the B<h +ash> option if you need to do something different. The argument to this sub +routine is an array reference like those passed to the B<only_a> and B<match> +subroutines. You shouldn't need this option. If you do, you'll probably have to sup +ply the B<sort> option as well. =back =head2 EXPORT File::DiffTree doesn't export anything. Typing is good for you. Call d +iffTree as File::DiffTree::diffTree . =head1 AUTHOR By Ned Konz, =head1 LICENSE This module is licensed under the same license as Perl itself. =head1 SEE ALSO perl(1). L<Algorithm::Diff> =cut # vim: ts=4 sw=4

Here's a little demo program:

#!/usr/bin/perl -w # This is a demo program to show the use of File::DiffTree # by Ned Konz use strict; use File::DiffTree; use File::Compare; if (@ARGV != 2) { print STDERR "usage: $0 dir1 dir2\n"; exit(1); } my $dirA = shift; my $dirB = shift; sub onlyA { print "Only in $dirA: ", $_[0]->[0], "\n" } sub onlyB { print "Only in $dirB: ", $_[0]->[0], "\n" } # This will be called if names match. # The file size or contents (or mtimes or inodes) could still be diffe +rent. sub match { my $arr1 = shift; my $arr2 = shift; my $fn1 = $dirA . $arr1->[0]; my $fn2 = $dirB . $arr2->[0]; my $compare = $arr1->[1] <=> $arr2->[1]; # different if sizes d +iffer if (! $compare) { my $retval = File::Compare::compare($fn1, $fn2); if ($retval == -1) { print STDERR "Problems opening $fn1 or $fn2: $!\n"; return; } $compare = $retval; } if (! $compare) { print "Match: ", join('|', @$arr1), "\t", join('|', @$arr2), " +\n" } else { print "Different: ", join('|', @$arr1), "\t", join('|', @$arr2 +), "\n" } } File::DiffTree::diffTree($dirA, $dirB, { Only_A => \&onlyA, Only_B => \&onlyB, Match => \&match, Significant_Fields => 0, # just name (not size, mtime or inode) Reject => sub { /(?:~|\.bak|\.tmp)$/ || ! -r _ }, Fold_Case => ($^O eq 'Win32'), # if on OS that doesn't care l +ike windoze }); # vim: ts=4 sw=4

In reply to Directory Tree Comparison Module (File::DiffTree) by bikeNomad

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others meditating upon the Monastery: (7)
    As of 2018-04-26 14:17 GMT
    Find Nodes?
      Voting Booth?