# New Ticket Created by "Kunkee, Steve"
# Please include the string: [perl #32993]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=32993 >
This is a bug report for perl from [EMAIL PROTECTED],
generated with the help of perlbug 1.34 running under perl v5.8.0.
-----------------------------------------------------------------
[Please enter your report here]
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 <node> B.11.00 E 9000/785 2012164768.
Here is the script:
#!/usr/local/bin/perl
#
sub printusage
{
print STDERR "Usage: CompareGroups.pl [-d][-f][-h] <group1> <group2> <dir>
...\n";
print STDERR "\n";
print STDERR "Where:\n";
print STDERR " -d if present indicates that .diff files are to be
produced\n";
print STDERR " for each file that is different. If -d is not
specified,\n";
print STDERR " all .diff files are left alone. If it is
specified, extra\n";
print STDERR " .diff files are deleted.\n";
print STDERR " -f if present indicates that .diff files are to be
updated\n";
print STDERR " regardless of whether the .diff file seems to
be up to date.\n";
print STDERR " -f implies -d.\n";
print STDERR " -h if present indicates that the usage message is
to be printed.\n";
print STDERR " Any other option or input is ignored.\n";
print STDERR " <group1> is the first group to compare, usually '.'.\n";
print STDERR " <group2> is the second group to compare\n";
print STDERR " <dir> ... is the list of directories within each group to
compare\n";
}
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([EMAIL PROTECTED], [EMAIL PROTECTED]);
open FILE, ">notingroup1.files";
print FILE @notingroup1files;
close FILE;
push @notingroup2filesx, @group1files;
push @notingroup2filesx, @group2files;
push @notingroup2filesx, @group2files;
@notingroup2filesx = sort @notingroup2filesx;
uniq_u([EMAIL PROTECTED], [EMAIL PROTECTED]);
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([EMAIL PROTECTED], [EMAIL PROTECTED]);
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 = [EMAIL PROTECTED];
push @partdiff1, $_;
}
elsif ($y eq $file2)
{
$current = "> ";
@partdiff2 = ();
$partdiff = [EMAIL PROTECTED];
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;
}
}
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=utilities
severity=medium
---
Site configuration information for perl v5.8.0:
Configured by pabiadzi at Thu Jun 19 14:16:53 PDT 2003.
Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration:
Platform:
osname=hpux, osvers=11.00, archname=hpp-thread-multi
uname='hp-ux cyhprt23 b.11.00 e 9000785 2008795644 8-user license '
config_args='-Dmksymlinks -Ud_sigsetjmp -Dusethreads -Duseithreads
-Ulocincpth -Uloclibpth -Duselargefiles -Darchname=hpp -Uversion
-Dprefix=/ips/udu4/tools/perl -Uinstallusrbinperl
-Dbin=/ips/udu4/tools/perl/bin/hpp -Dscriptbin=/ips/udu4/tools/perl/bin
-Dbin=/ips/udu4/tools/perl/bin/hpp -Dscriptbin=/ips/udu4/tools/perl/bin
-Dsitebin=/ips/udu4/tools/perl/bin/hpp -Dsitescriptbin=/ips/udu4/tools/perl/bin
-Dsitelib=/ips/udu4/tools/perl/site/lib
-Dsitearch=/ips/udu4/tools/perl/site/lib/hpp
-Darchlib=/ips/udu4/tools/perl/lib/hpp -Dprivlib=/ips/udu4/tools/perl/lib -des'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define
usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags =' -D_POSIX_C_SOURCE=199506L -D_REENTRANT -Ae
-D_HPUX_SOURCE -Wl,+vnocompatwarnings -D_LARGEFILE_SOURCE
-D_FILE_OFFSET_BITS=64 ',
optimize='+O2 +Onolimit',
cppflags='-Aa -D__STDC_EXT__ -D_HPUX_SOURCE -D_POSIX_C_SOURCE=199506L
-D_REENTRANT -Ae -D_HPUX_SOURCE -Wl,+vnocompatwarnings'
ccversion='A.11.01.21505.GP', gccversion='', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='/usr/bin/ld', ldflags =''
libpth=/lib /usr/lib /usr/ccs/lib /usr/local/lib
libs=-lnsl -lnm -lndbm -lmalloc -ldld -lm -lndir -lcrypt -lsec -lpthread -lc
perllibs=-lnsl -lnm -lmalloc -ldld -lm -lndir -lcrypt -lsec -lpthread -lc
libc=/lib/libc.sl, so=sl, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_hpux.xs, dlext=sl, d_dlsymun=undef, ccdlflags='-Wl,-E
-Wl,-B,deferred '
cccdlflags='+Z', lddlflags='-b +vnocompatwarnings'
Locally applied patches:
ACTIVEPERL_LOCAL_PATCHES_ENTRY
---
@INC for perl v5.8.0:
/ips/udu4/tools/perl/lib/hpp
/ips/udu4/tools/perl/lib
/ips/udu4/tools/perl/site/lib/hpp
/ips/udu4/tools/perl/site/lib
/ips/udu4/tools/perl/site/lib
.
---
Environment for perl v5.8.0:
HOME=/users/kunkee
LANG=C
LANGUAGE (unset)
LD_LIBRARY_PATH=/ntap/psa_data/arch/omxx_kunkee/workproj/hpp/lib:/ntap/psa_data/arch/omxx_kunkee/hpp/lib:/ntap/ips/ugnx40/ip3/hpp/lib:/ntap/ips/ugnx40/ip3/hpp/kits/ugii:/ntap/ips/ugnx40/ip3/NX/dbin/hpp:/ntap/ips/udu4/tools/lib/hpp
LOGDIR (unset)
PATH=.:/users/kunkee/bin:/ntap/ips/ugnx40/ip3/dbin/hpp:/ntap/ips/ugnx40/ip3/NX/dbin/hpp:/ntap/ips/ugnx40/ip3/dbin/unx:/ntap/ips/ugnx40/ip3/NX/dbin/unx:/ntap/ips/ugnx40/ip3/dbin:/ntap/ips/ugnx40/ip3/NX/dbin:/ntap/ips/ugnx40/ip3/p4cms:/ntap/ips/ugnx40/ip3/dbin/athena:/ntap/ips/ugnx40/ip3/dbin/omxx:/ntap/ips/udu4/tools/lib/hpp:/ntap/ips/udu4/tools:/ntap/ips/udu4/tools/bin/unx:/ips/udu4/tools/bin/unx/../../perl/bin/hpp:/bin:/usr/bin:/usr/dt/bin:/usr/bin/X11:/opt/ansic/bin:/usr/ccs/bin:/usr/contrib/bin:/opt/hpnpl//bin:/opt/nettladm/bin:/opt/fc/bin:/opt/fcms/bin:/opt/upgrade/bin:/opt/aCC/bin:/usr/contrib/bin/X11:/opt/langtools/bin:/opt/pd/bin:/opt/graphics/phigs/bin:/opt/hparray/bin:/opt/graphics/common/bin:/opt/imake/bin:/etc:/usr/local/bin:/ntap/psa_data/arch/omxx_kunkee/workproj/pre_src/scripts:/ntap/psa_data/arch/omxx_kunkee/pre_src/scripts
PERL5LIB_SAV=
PERL_BADLANG (unset)
PERL_SAV=
SHELL=/bin/ksh
