[16949] in Perl-Users-Digest
Perl-Users Digest, Issue: 4361 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Sep 18 14:15:40 2000
Date: Mon, 18 Sep 2000 11:15:22 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <969300921-v9-i4361@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Mon, 18 Sep 2000 Volume: 9 Number: 4361
Today's topics:
script critique requested <stevea@wrq.com>
Re: script critique requested nobull@mail.com
STDOUT/STDERR to a file? howto? <jeep@waltz.rahul.net>
Re: STDOUT/STDERR to a file? howto? <bkennedy@hmsonline.com>
Re: STDOUT/STDERR to a file? howto? nobull@mail.com
Re: Substring Golf? <lr@hpl.hp.com>
Re: Using range operator <jeffp@crusoe.net>
Re: Using range operator <godzilla@stomp.stomp.tokyo>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 18 Sep 2000 09:12:51 -0700
From: Steve Allan <stevea@wrq.com>
Subject: script critique requested
Message-Id: <u3dixn0fw.fsf@wrq.com>
For those who have the time and interest, I could really benefit from
some constructive criticism. I've been teaching myself Perl for the
last 8 months and have learned a lot from lurking around on this
forum. But there's no substitute for writing code and having people
disect it.
Below is a script I wrote for work which compares two directories.
The directories are meant to be nearly identical in content, and the
script's task is to create output files telling me
1) which files are in dir1 but not dir2.
2) which files are in dir2 but not dir1.
3) common files.
A command line option will cause the script to do a binary comparison
on the common files and report those results as well (we have need of
both types of behavior).
Any and all criticism (style, efficiency, etc.) are welcome.
Thanks in advance for any time you can spare for this, and please let
me know if this is an inappropriate request.
--
-- Steve __
#!/usr/bin/perl -w
#
# File: dirdiff.pl
#
# Description: compares contents of two directories and reports
# files that differ, files that are the same, and files that
# are in one directory but not the other. For usage, type
#
# dirdiff.pl -h
#
# Author: Steve Allan 09/2000
#
require 5.004;
use strict;
use File::Find;
use File::Basename 'basename';
use Getopt::Long;
use File::Compare 'cmp';
use Cwd 'cwd';
my(
$dir1, $dir2, # directories to compare
@dir1files, @dir2files, # lists of files
$start_dir, # where we started
%count, # hash counting each file
@dir1_only, @dir2_only, # holds files unique to dir
@dir1_dir2, # files common to both dirs
@files_same, @files_diff, # results of file compare
);
#--------------------------------------------------
#
# parse command line args
#
#--------------------------------------------------
my($compare, $stdout, $help);
GetOptions(
"compare" => \$compare,
"stdout" => \$stdout,
"help" => \$help,
);
usage() and exit 0 if $help;
$dir1 = shift or usage() and exit 1;
$dir2 = shift or usage() and exit 1;
#--------------------------------------------------
#
# Record where we started - we need to come back
# here before running find in case directories
# are relative to this spot. Also need to get
# back here to write the report files.
#
#--------------------------------------------------
$start_dir = cwd();
#--------------------------------------------------
#
# open file handles
#
#--------------------------------------------------
if($stdout) {
open(ONLYONE, ">&STDOUT") or die "Can't dupe STDOUT: $!";
open(ONLYTWO, ">&STDOUT") or die "Can't dupe STDOUT: $!";
open(SAME, ">&STDOUT") or die "Can't dupe STDOUT: $!";
if($compare) {
open(DIFFER, ">&STDOUT") or die "Can't dupe STDOUT: $!";
}
}
else {
my $base1 = $dir1 eq '.' ? basename($start_dir) : basename($dir1);
my $base2 = $dir2 eq '.' ? basename($start_dir) : basename($dir2);
if($base1 eq $base2) {
$base1 .= '.1';
$base2 .= '.2';
}
my $only_dir1_rpt = 'only.' . $base1;
my $only_dir2_rpt = 'only.' . $base2;
open(ONLYONE, ">$only_dir1_rpt") or
die "Can't open $only_dir1_rpt for writing: $!";
open(ONLYTWO, ">$only_dir2_rpt") or
die "Can't open $only_dir2_rpt for writing: $!";
if($compare) {
my $files_same_rpt = 'files_same.' . $base1 . '.' . $base2;
my $files_differ_rpt = 'files_differ.' . $base1 . '.' . $base2;
open(SAME, ">$files_same_rpt") or
die "Can't open $files_same_rpt for writing: $!";
open(DIFFER, ">$files_differ_rpt") or
die "Can't open $files_differ_rpt for writing: $!";
}
else {
my $files_same_rpt = 'files_common.' . $base1 . '.' . $base2;
open(SAME, ">$files_same_rpt") or
die "Can't open $files_same_rpt for writing: $!";
}
}
#--------------------------------------------------
#
# get lists of files in each directory stripping
# off leading ./
#
#--------------------------------------------------
chdir($dir1) or die "Can't cd to $dir1: $!";
find sub { push @dir1files, substr $File::Find::name, 2 unless /^\.$/ }, '.';
chdir($start_dir) or die "Can't cd back to $start_dir: $!";
chdir($dir2) or die "Can't cd to $dir2: $!";
find sub { push @dir2files, substr $File::Find::name, 2 unless /^\.$/}, '.';
chdir($start_dir) or die "Can't cd back to $start_dir: $!";
#--------------------------------------------------
#
# Compute set differences and intersection
# * walk list one and assign 1 to hash
# * walk list two and add 2 to hash
# - values of 1 list 1 only
# - values of 2 list 2 only
# - values of 3 intersection
#
#--------------------------------------------------
for (@dir1files) { $count{$_} = 1 }
for (@dir2files) { $count{$_} += 2 }
while(my($k, $v) = each %count) {
if($v == 1) { push @dir1_only, $k }
elsif($v == 2) { push @dir2_only, $k }
elsif($v == 3) { push @dir1_dir2, $k }
else { warn "program error - invalid value $v for $k" }
}
print ONLYONE $stdout ? "=== $dir1 only ===\n" : '',
join "\n", sort @dir1_only, "\n" if @dir1_only;
print ONLYTWO $stdout ? "=== $dir2 only ===\n" : '',
join "\n", sort @dir2_only, "\n" if @dir2_only;
#--------------------------------------------------
#
# Binary comparison of common files
#
#--------------------------------------------------
if($compare) {
#run compare on the intersection files
chdir($start_dir) or die "Can't cd to $start_dir: $!";
for(@dir1_dir2) {
my $path1 = $dir1 . '/' . $_;
my $path2 = $dir2 . '/' . $_;
next if -d $path1 and -d $path2;
push @{ cmp($path1, $path2) == 0 ? \@files_same : \@files_diff }, $_;
}
print SAME $stdout ? "=== Files Same ===\n" : '',
join "\n", sort @files_same, "\n" if @files_same;
print DIFFER $stdout ? "=== Files Differ ===\n" : '',
join "\n", sort @files_diff, "\n" if @files_diff;
}
else {
print SAME $stdout ? "=== Common Files ===\n" : '',
join "\n", @dir1_dir2, "\n" if @dir1_dir2;
}
#--------------------------------------------------
#
# wrapup
#
#--------------------------------------------------
close ONLYONE;
close ONLYTWO;
close SAME;
close DIFFER if $compare;
exit 0;
#--------------------------------------------------
#
# Usage subroutine
#
#--------------------------------------------------
sub usage {
print <<EOF;
Usage: $0 [-compare] dir1 dir2
Compares all files and subdirectories within the two input
directories. Prints a list of files that are in dir1 but not in dir2,
in dir2 but not in dir1, and files that are in both. Results are
written to files named only.dir1, only.dir2 (using basename of dir1
and dir2, not full path) and either one or two other files are
created, depending on the options used. See below.
Options:
compare : common files are compared to see if they have identical
content. Results are written to files named
files_same.dir1.dir2 files_differ.dir1.dir2
Without this option, common file names are reported without
doing a binary comparison (much faster) and the two summary
files above are replaced with the single file
files_common.dir1.dir2
stdout : Instead of writing results to 3 or four separate files,
a single report is printed to stdout.
EOF
}
__END__
------------------------------
Date: 18 Sep 2000 18:05:51 +0100
From: nobull@mail.com
Subject: Re: script critique requested
Message-Id: <u97l89hbps.fsf@wcl-l.bham.ac.uk>
Steve Allan <stevea@wrq.com> writes:
> Any and all criticism (style, efficiency, etc.) are welcome.
Basically I can't fault it.
The only trivial stylistic matters I can think of are that you use the
explicit concatenation operator where most Perl hackers would use
interpolation and you unnecessarily explicitly quote words on the LHS
of a => fat comma.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: 18 Sep 2000 16:49:01 GMT
From: Jeff Lacki <jeep@waltz.rahul.net>
Subject: STDOUT/STDERR to a file? howto?
Message-Id: <8q5h1t$bd4$1@samba.rahul.net>
I want to write both the STDOUT and STDERR to a file,
however I found I got an error doing:
open(FH, ">& ./outfile") or die "ERROR\n";
The file dies at this point with "ERROR\n" above.
Ive never worked with stderr within perl, so I assume
this is an easy fix? Can someone give me the example that
works for this?
thanks in advance
Jeff
------------------------------
Date: Mon, 18 Sep 2000 17:10:30 GMT
From: "Ben Kennedy" <bkennedy@hmsonline.com>
Subject: Re: STDOUT/STDERR to a file? howto?
Message-Id: <a0sx5.31457$AW2.517514@news1.rdc2.pa.home.com>
"Jeff Lacki" <jeep@waltz.rahul.net> wrote in message
news:8q5h1t$bd4$1@samba.rahul.net...
> I want to write both the STDOUT and STDERR to a file,
> however I found I got an error doing:
>
> open(FH, ">& ./outfile") or die "ERROR\n";
>
> The file dies at this point with "ERROR\n" above.
>
> Ive never worked with stderr within perl, so I assume
> this is an easy fix? Can someone give me the example that
> works for this?
All you need to do is re open() STDOUT and STDERR to whatever you want, like
open(STDERR, ">error_log.txt") or die "Cannot open STDERR: $!";
My understanding is that STDOUT and friends are usefully pre-opened for you,
but beyond that they are ordinary file handles and can be treated as such,
despite the fact that various functions default to them. Also note the "$!"
in the error message, as this tells you the error message that describes why
open() failed
--Ben Kennedy
------------------------------
Date: 18 Sep 2000 18:14:07 +0100
From: nobull@mail.com
Subject: Re: STDOUT/STDERR to a file? howto?
Message-Id: <u94s3dhbc0.fsf@wcl-l.bham.ac.uk>
Jeff Lacki <jeep@waltz.rahul.net> writes:
> I want to write both the STDOUT and STDERR to a file,
> however I found I got an error doing:
>
> open(FH, ">& ./outfile") or die "ERROR\n";
Where did you get that? That's attempting to redirect FH not STDIN or
STDOUT.
To redirect STDOUT to a file:
open(STDOUT, ">./outfile") or die;
To redirect STDERR to STDERR
open(STDERR, ">&STDOUT") or die;
> Ive never worked with stderr within perl, so I assume
> this is an easy fix?
Nothing special about STDERR, the above works for any filehandles.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Mon, 18 Sep 2000 10:07:05 -0700
From: Larry Rosler <lr@hpl.hp.com>
Subject: Re: Substring Golf?
Message-Id: <MPG.142feb98533bb00d98ad7e@nntp.hpl.hp.com>
In article <m1hf7dhkxj.fsf@rt158.private.realtime.co.uk> on 18 Sep 2000
14:46:48 +0100, Piers Cawley <pdcawley@bofh.org.uk> says...
> "Wyzelli" <wyzelli@yahoo.com> writes:
>
> > I am looking for a neater/shorter way of achieving the following:
> >
> > my $num = shift;
> > $num =~ s/ //g;
> >
> > my $numa = substr $num,0,4;
> > my $numb = substr $num,4,4;
> > my $numc = substr $num,8,4;
> > my $numd = substr $num,12,4;
> >
> > Any ideas? One liners?
>
> my($num=shift)=~y/ //d;($numa,$numb,$numc,$numd)=split/(.{4})/,$num
>
> It's quite short, and reasonably neat...
It would be much neater if it compiled correctly.
--
(Just Another Larry) Rosler
Hewlett-Packard Laboratories
http://www.hpl.hp.com/personal/Larry_Rosler/
lr@hpl.hp.com
------------------------------
Date: Mon, 18 Sep 2000 12:24:54 -0400
From: Jeff Pinyan <jeffp@crusoe.net>
Subject: Re: Using range operator
Message-Id: <Pine.GSO.4.21.0009181216570.14683-100000@crusoe.crusoe.net>
On Sep 18, Godzilla! said:
>Logan Shaw wrote:
>> What if we have "$number = 5.1;" instead? :-)
>
>What do you mean "we" Ofni Lakna?
[off-topic questions starting with "What if"]
It's a figure of speech, at worst.
>$number = 5.1;
>$number =~ s/\.//g;
>Range, 50 to 60
This requires extra work on your part. Making code that takes care of
unexpected cases is a good idea. Following your style:
$bottom = 1;
$top = 10;
$target = 5.1;
$target =~ s/\.//g;
$bottom *= 10;
$top *= 10;
for ($i = $bottom; $i <= $top; $i++) {
if ($i == $target) { ... }
}
Now, what if $target is 5.15? You need to know ahead of time how many
digits there are after the decimal point:
$decimal = length($target - int($target)) - 1; # - 1 b/c of the .
$target =~ s/\.//g; # why is it /g? numbers should have at most one .
$bottom *= 10**$decimal;
$top *= 10**$decimal;
for ($i = $bottom; $i <= $top; $i++) {
if ($i == $target) { ... }
}
This is great deal of work to do, when two (at most) simple comparisons
can get the job done for you.
if ($bottom <= $target and $target <= $top) { ... }
Just so you know, the <= operator does exist in Perl 4. It's not a Perl
5-ism. In fact, I'm quite sure you'll find people doing this type of
range checking in C and C++:
if (bottom <= target && target <= top) { /* ... */ }
Are they guilty of cargo-cultism?
--
Jeff "japhy" Pinyan japhy@pobox.com http://www.pobox.com/~japhy/
PerlMonth - An Online Perl Magazine http://www.perlmonth.com/
The Perl Archive - Articles, Forums, etc. http://www.perlarchive.com/
CPAN - #1 Perl Resource (my id: PINYAN) http://search.cpan.org/
------------------------------
Date: Mon, 18 Sep 2000 09:52:53 -0700
From: "Godzilla!" <godzilla@stomp.stomp.tokyo>
Subject: Re: Using range operator
Message-Id: <39C64865.8A06BD58@stomp.stomp.tokyo>
Jeff Pinyan wrote:
> Godzilla! wrote:
> >Logan Shaw wrote:
> >> What if we have "$number = 5.1;" instead? :-)
> [off-topic questions starting with "What if"]
> It's a figure of speech, at worst.
WHAT IF! people are AOL lame brainers who take delight
in working hard at finding some idiotic exception to
whatever to afford a chance to engage in nothing more
than ego masturbation via impotently attempting to
degrade another. Such fools.
> >$number = 5.1;
> >$number =~ s/\.//g;
> >Range, 50 to 60
> This requires extra work on your part. Making code that takes care of
> unexpected cases is a good idea. Following your style:
(random snippage)
> Now, what if $target is 5.15? You need to know ahead of time how many
> digits there are after the decimal point:
> $target =~ s/\.//g;
# why is it /g? numbers should have at most one .
Well, WHAT IF! an input number has multiple decimal points?
My use of a global gobbler is to sucker WHAT IF! people.
Although I have stated my intent, there are many WHAT IF!
suckers out there who will still eat this, hook, line
and sinker. Such easy Marks for a talented con such as
myself and, I don't mean a French con although almost all
here like to think of me as a con, in French street lingo.
> Just so you know, the <= operator does exist in Perl 4.
Kinda figured with using this operator on a regular basis.
Seems to work everytime, that is "seems" as one person
would have us express.
Yeah, my logic is similar to yours. Easy enough to knock
out a decimal point, grab the first digit, add as many
zeroes as decimal places for your beginning range, bump
this grabbed first digit by one to create your ending
range and add an equal number of zeroes.
Wallah! Some might think this to be magic. It is.
This is White Magic. Adding back in decimal points
for your printed output, is Black Magic and should
be avoided at all times. Black Magic is evil and
will often backfire, turning you into an ugly toad.
Godzilla!
--
Dr. Kiralynne Schilitubi ¦ Cooling Fan Specialist
UofD: University of Duh! ¦ ENIAC Hard Wiring Pro
BumScrew, South of Egypt ¦ HTML Programming Class
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V9 Issue 4361
**************************************
