p5pRT
commented
19 years ago From kunkee@ugs.com
Created by kunkee@ugs.com
When I use find (File::Find) with the options hash\, as illustrated in the code I have included here\, it fails on HP but works on Windows. The message I get is
Not a subroutine reference at /usr/local/lib/perl5/5.00502/File/Find.pm line 197.
The script takes parameters\, but all you have to do is supply 3 junk file names that don't have to exist.
My HP is HP-UX \
Here is the script:
#!/usr/local/bin/perl
#
sub printusage
{
print STDERR "Usage: CompareGroups.pl [-d][-f][-h] \
use Cwd; use Getopt::Std; use File::Find; use File::Spec;
getopts("fdh");
printusage()\, exit if $Getopt::Std::opt_h;
my $force = $Getopt::Std::opt_f; my $do_diffs = $Getopt::Std::opt_d;
$do_diffs = 1 if $force;
if (scalar @ARGV \< 3) { printusage(); exit; }
$group1 = shift @ARGV; $group2 = shift @ARGV; @dirs = @ARGV;
$curdir = getcwd();
@foundfiles;
sub list_func { push(@foundfiles\, $File::Find::name) if (-f $$File::Find::name) && ! /history$/; }
%findoptions = ( wanted => list_func\, no_chdir => "1" );
chdir $group1; find(\%findoptions\, @dirs); @group1files = @foundfiles; @foundfiles = (); @group1files = sort @group1files;
chdir $curdir;
chdir $group2; find(\%findoptions\, @dirs); @group2files = @foundfiles; @foundfiles = (); @group2files = sort @group2files;
chdir $curdir;
sub uniq_u { $input = shift; $output = shift; $previous = ""; $count = 0; foreach (@{$input}) { if ($_ ne $previous) { push @{$output}\, $previous if $count == 1; $count = 1; $previous = $_; } else { $count++; } } push @{$output}\, $previous if $count == 1; }
sub uniq_d { $input = shift; $output = shift; $previous = ""; $count = 0; foreach (@{$input}) { if ($_ ne $previous) { push @{$output}\, $previous if $count > 1; $count = 1; $previous = $_; } else { $count++; } } push @{$output}\, $previous if $count > 1; }
push @notingroup1filesx\, @group1files; push @notingroup1filesx\, @group1files; push @notingroup1filesx\, @group2files; @notingroup1filesx = sort @notingroup1filesx; uniq_u(\@notingroup1filesx\, \@notingroup1files); open FILE\, ">notingroup1.files"; print FILE @notingroup1files; close FILE;
push @notingroup2filesx\, @group1files; push @notingroup2filesx\, @group2files; push @notingroup2filesx\, @group2files; @notingroup2filesx = sort @notingroup2filesx; uniq_u(\@notingroup2filesx\, \@notingroup2files); open FILE\, ">notingroup2.files"; print FILE @notingroup2files; close FILE;
print STDERR "notingroup1.files has the files in group 2 but not in group 1\n"; print STDERR "notingroup2.files has the files in group 1 but not in group 2\n";
@inbothgroupsx = @group1files; push @inbothgroupsx\, @group2files; @inbothgroupsx = sort @inbothgroupsx; uniq_d(\@inbothgroupsx\, \@inbothgroups);
foreach $file (@inbothgroups) { chomp $file; ($fname) = ($file =~ /(\w+\.\w+)$/);
# Decide if the file's diff needs to be updated my ($f1date\, $f2date\, $dfdate); $infile1 = File::Spec->catfile($group1\, $file); $infile2 = File::Spec->catfile($group2\, $file); @f1date = stat("$infile1"); $f1date[9] = 0 if ! scalar @f1date; @f2date = stat("$infile2"); $f2date[9] = 0 if ! scalar @f2date; @dfdate = stat("$fname.diff"); $dfdate[9] = 0 if ! scalar @dfdate; next if ! $force && $f1date[9] \< $dfdate[9] && $f2date[9] \< $dfdate[9]; if ($ENV{PLAT} eq "wnti32") { $infile1 =~ s!/!\\!g; $infile2 =~ s!/!\\!g; @diffs = `fc $infile1 $infile2`; @diffs = () if $diffs[0] =~ /no differences encountered/; if ($diffs[0] =~ /^Invalid/) { print @diffs; die "bad diff return\n" } @parts = split /\s+/\, $diffs[0]; $file1 = $parts[2]; $file2 = $parts[4]; shift @diffs; $current = ""; @newdiff = (); foreach (@diffs) { if (substr($_\,0\,1) eq "*") { ($x\, $y) = split; $current = ""; if ($y eq $file1) { $current = "\< "; @partdiff1 = (); $partdiff = \@partdiff1; push @partdiff1\, $_; } elsif ($y eq $file2) { $current = "> "; @partdiff2 = (); $partdiff = \@partdiff2; push @partdiff2\, $_; } else { if (substr($partdiff1[1]\,2) eq substr($partdiff2[1]\,2)) { splice(@partdiff1\, 1\, 1); splice(@partdiff2\, 1\, 1); } if (substr($partdiff1[$#partdiff1]\,2) eq substr($partdiff2[$#partdiff2]\,2)) { $#partdiff1--; $#partdiff2--; } push @newdiff\, @partdiff1; push @newdiff\, @partdiff2; push @newdiff\, $_; } } else { push @{$partdiff}\, $current . $_; } } @diffs = @newdiff; } else { @diffs = `diff $infile1 $infile2`; }
$ltcount = scalar grep /^\< /\, @diffs; $gtcount = scalar grep /^> /\, @diffs; $stcount = scalar grep /OM\+\+ Scripted changes/\, @diffs; if ($ltcount + $gtcount != $stcount) { print "$file\n"; if ($do_diffs) { open DIFF\, ">$fname.diff"; print DIFF @diffs; close DIFF; } } else { unlink "$fname.diff" if $do_diffs; } }
Migrated from rt.perl.org#32993 (status was 'rejected')
Searchable as RT32993$