[18128] in Perl-Users-Digest
Perl-Users Digest, Issue: 288 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Feb 14 14:06:18 2001
Date: Wed, 14 Feb 2001 11:05:20 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <982177520-v10-i288@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Wed, 14 Feb 2001 Volume: 10 Number: 288
Today's topics:
Re: -f file is always false! <mjcarman@home.com>
Re: -f file is always false! (Randal L. Schwartz)
ANNOUNCE: Locale::Currency added to Locale-Codes <neilb@cre.canon.co.uk>
ANNOUNCE: Parse-Yapp-1.04 released <francois@fdesar.net>
Re: Array - reading two files. egwong@netcom.com
Re: Array - reading two files. <graham.wood@iona.com>
Call C Programs from Perl <michaelk@jbase.com>
Re: comp.infosystems.www.authoring.cgi (BUCK NAKED1)
Re: comp.infosystems.www.authoring.cgi (BUCK NAKED1)
Re: CRC-32 in Perl (was: Strings and pointers in Perl?) <bart.lateur@skynet.be>
Re: die hard <raspe@uni-trier.de>
Re: Directory listings in a table needs taint checking <mothra@nowhereatall.com>
Re: FAQ 4.24: How do I reformat a paragraph? <mischief@velma.motion.net>
Re: File stat's <mischief@velma.motion.net>
Re: File stat's <olthoff@multiboard.com>
GUI problem <shino_korah@yahoo.com>
Re: Hashes <drifter@clix.pt>
Re: Hashes <drifter@clix.pt>
Re: How bad is that Jeopardy post? <mischief@velma.motion.net>
how to find cpu time usage from within perl <qchen@snet.net>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Wed, 14 Feb 2001 07:59:16 -0600
From: Michael Carman <mjcarman@home.com>
Subject: Re: -f file is always false!
Message-Id: <3A8A8F34.FC96213B@home.com>
Alexandra wrote:
>
> I guess the -f thing checks to see if the name
> given by $file is in the current working directory eh?
Only if all you give it is a filename. If you give it a fully qualified
path such as '/usr/local/bin/perl' it will use it. And if you give it a
partial pathname like '../bin/perl' it will use the current directory as
the base.
-mjc
------------------------------
Date: 14 Feb 2001 07:45:56 -0800
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: -f file is always false!
Message-Id: <m1ofw55kuj.fsf@halfdome.holdit.com>
>>>>> "Alexandra" == Alexandra <lanaS55nospam@hotmail.com> writes:
Alexandra> Thanks, it works now. I guess the -f thing checks to see
Alexandra> if the name given by $file is in the current working
Alexandra> directory eh?
No, it just uses the name you give it. If you give it "fred", it's
the file "fred" in the current directory. No magic for that.
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Tue, 13 Feb 2001 14:23:45 GMT
From: Neil Bowers <neilb@cre.canon.co.uk>
Subject: ANNOUNCE: Locale::Currency added to Locale-Codes
Message-Id: <t8la84afrauacb@corp.supernews.com>
A Locale::Currency module has been added to the Locale-Codes bundle:
file: $CPAN/authors/id/N/NE/NEILB/Locale-Codes-1.05.tar.gz
size: 13165 bytes
md5: 65d4502de29fca0e8a2be8606c8fce15
Locale::Currency provides an interface to the ISO three letter codes
for currencies and funds, as defined in ISO 4217.
Locale::Currency was contributed to Michael Hennecke. Kudos.
The bundle also includes Locale::Language and Locale::Country,
which provide the same interface for ISO two letter codes for
language and country identification.
Neil
------------------------------
Date: Mon, 12 Feb 2001 17:23:15 +0100
From: François Désarménien <francois@fdesar.net>
Subject: ANNOUNCE: Parse-Yapp-1.04 released
Message-Id: <t8la7u4ehi8uc4@corp.supernews.com>
Parse-Yapp-1.04 has just been uploaded to CPAN. It should be
available soon on your nearest CPAN mirror.
This new version only includes cleanups, documentation upgrades,
and a new stress test but no new functionnalities nor bugfixes
(no bug has been reported since 1.02, nine months ago -- the code
seems *very* stable now).
If you're running 1.02 or 1.03, I suggest you to upgrade, but this is
not mandatory. On the other hand, if you're using releases prior to
1.02, you should consider upgrading as soon as possible.
If you have questions or ideas on how to improve Parse::Yapp, don't
hesitate to email me.
Enjoy,
François Désarménien
Here is the README file:
Parse::Yapp - Parse::Yapp Yet Another Perl Parser compiler
Compiles yacc-like LALR grammars to generate Perl OO parser modules.
COPYRIGHT
(c) 1998-2000 Francois Desarmenien, all rights reserved.
(see the Copyright section in Yapp.pm for usage and distribution rights)
IMPORTANT NOTES
The Parse::Yapp pod section is the main documentation and it assumes
you already have a good knowledge of yacc. If not, I suggest the GNU
Bison manual which is a very good tutorial to LALR parsing and yacc
grammar syntax.
The yapp frontend has its own documentation using either 'perldoc yapp'
or (on systems with man pages) 'man yapp'.
Any help on improving those documentations is very welcome.
DESCRIPTION
This is production release 1.03 of the Parse::Yapp parser generator.
It lets you create Perl OO fully reentrant LALR(1) parser modules
(see the Yapp.pm pod pages for more details) and has been designed to
be functionally as close as possible to yacc, but using the full power
of Perl and opened for enhancements.
REQUIREMENTS
Requires perl5.004 or better :)
It is written only in Perl, with standard distribution modules, so you
don't need any compiler nor special modules.
INSTALLATION
perl Makefile.PL
make
make test
make install
WARRANTY
This software comes with absolutly NO WARRANTY of any kind.
I just hope it can be useful.
FEEDBACK
Send feedback, comments, bug reports, pizze and postcards to:
Francois Desarmenien <francois@fdesar.net>
------------------------------
Date: Wed, 14 Feb 2001 15:27:07 GMT
From: egwong@netcom.com
Subject: Re: Array - reading two files.
Message-Id: <ftxi6.883$Sx5.89207@news.flash.net>
cindy <cindyann@mbox3.singnet.com.sg> wrote:
> hi,
> File1 contains
> 1010, John, 12/05/65
> 1020, Peter, 21/10/69
> 1030, May, 27/02/70
> File2 contains
> 1010, swimming, jogging, tennis
> 1020, jogging, badminton
> 1030, swimming, tennis
> I read File1 and 2 into an array
> @File1 = File1;
> @File2 = File2;
You want to join the two records, right? You should look into migrating
to a SQL database if you want to do these sorts of relational queries.
Mysql and Postgresql are popular free alternatives; commerically, Oracle
is most commonly used.
Instead of using an array, I'd stuff all of the data into a hash.
my %hash = ();
foreach my $file ( "File1", "File2" ) {
open( FH, $file ) or die "open error: $!";
while (<FH>) {
chomp(my ($key, @data) = split(/, /, $_));
push( @{$hash{$key}}, @data );
}
close FH;
}
then all of your data is accessible in the array
my ($name, $dob, @activities) = @{$hash{$id}};
See perldata for details on hashes and perlref and perlreftut on how
to use references.
This should be far more efficient since you only have to loop through
your data once to get everything, rather than having to do an additional
loop (n/2 on average) for every iteration (if you're a big-O'er, it's
O(n) rather than O(n**2)).
------------------------------
Date: Wed, 14 Feb 2001 15:59:22 -0000
From: "Graham Wood" <graham.wood@iona.com>
Subject: Re: Array - reading two files.
Message-Id: <96eam4$aa3$1@bvweb.iona.com>
To answer your questions you need to look at the keywords next and last when
used with loop labels.
For example:
OUTERLOOP: foreach(@arrayitems){
#stuff here
for($i=0;$i<10;$i++){
if($arrayitems > $i){
next OUTERLOOP; # jumps to the next iteration of OUTERLOOP
# last; would jump out of the inner loop and hence have the same
effect here
}
}
}
As an alternative to the complex loops you could use a hash.
An associative array (hash) uses strings as an index instead of the position
of the element in the array.
perldoc perldsc (perl data structures) explains how you can create a "hash
of hashes" with which you can assign values into a single data structure
from the contents of your File1 and File2 without worrying about comparing
the ID numbers in each file or whether the entry in one file has a
corresponding entry in the other one.
open(FILE1,"File1") || die "Can't open file File1 because $!\n";
while(<FILE1>){
chop;
next if(/^$/); # skip blank lines
($ID,$name,$dob)=split(',',$_);
$myhash{$ID}{name}=$name;
$myhash{$ID}{dob}=$dob;
}
close FILE1;
# at this point you will have a hash like this
# myhash{1010}{name} containing John
# myhash{1010}{dob} containing 12/05/65
# myhash{1020}{name} containing Peter
# myhash{1020}{dob} containing 21/10/69
# myhash{1030}{name} containing May
# myhash{1030}{dob} containing 27/02/70
open(FILE2,"File2")|| die "Can't open file File2 because $!\n";
while(<FILE2>){
chop;
next if(/^$/); # skip blank lines
($ID2,@hobbies)=split(',',$_);
$myhash{$ID2}{hobbies}=join(',',@hobbies);
}
close FILE2;
# you have now added entries for hobbies for the keys in File2 (they may or
# may not be identical to the keys in File1, it doesn't matter)
# myhash{1010}{hobbies} contains swimming,jogging,tennis
# myhash{1020}{hobbies} contains jogging, badminton
# myhash{1030}{hobbies} contains swimming,tennis
foreach(sort keys(%myhash)){
print "=============================\n";
print "ID: $_\n";
print " Name:$myhash{$_}{name}\n";
print " Date of Birth:$myhash{$_}{dob}\n";
print " Hobbies:$myhash{$_}{hobbies}\n";
}
Hope this helps
Graham Wood
cindy <cindyann@mbox3.singnet.com.sg> wrote in message
news:01c0968c$963f69e0$2cb115a5@default...
> hi,
>
> File1 contains
> 1010, John, 12/05/65
> 1020, Peter, 21/10/69
> 1030, May, 27/02/70
>
> File2 contains
> 1010, swimming, jogging, tennis
> 1020, jogging, badminton
> 1030, swimming, tennis
>
> I read File1 and 2 into an array
>
> @File1 = File1;
> @File2 = File2;
>
> I did a for loop
>
> foreach $file1 (@File1)
> {
> ($student_no1, $name, $birth_date) = split( /, /, $file1);
>
> foreach $file2 (@File2)
> {
> ($student_no2, $activity_1, $activity_2, $activity_3) = split( /,
/,
> $file2);
>
> if $student_no1 = $student_no2
> {
> print $student_no1, $name, $birth_date, $activity_1,
> $activity_2, $activity_3
> ( How do I ask Perl to exit from here after printing and read
> the
> next record from File1)
> }
>
> else
> { ( I am stuck here too. How do I ask Perl to exit from the
2nd
> loop and read
> the next record from File1)
> }
> } # exit from File2
> } # exit from File1
>
> I believed there are simple way to do the above. Can anyone advice me?
> Thank you.
>
> Regards,
> Cindy
>
> --
> 'Courage is standing up for what you believe in without worrying about
> the opinions of others. It's following your own heart, living your own
> life, and settling for nothing less than the best for yourself.'
> ~ Caroline Kent ~
------------------------------
Date: Wed, 14 Feb 2001 10:26:01 -0800
From: "Michael Krygowski" <michaelk@jbase.com>
Subject: Call C Programs from Perl
Message-Id: <3bAi6.305$Vf.11024@typhoon.aracnet.com>
Perl Gurus,
I have a question around this subject, and simply it's; What's the best
method? I've poured through all the docs and it appears that I have 3
options, all of which have pluses and minuses (XS, SWIG and Inline). I need
to make calls to some C code (for DB purposes- opening/reading/writing
records to a specific DB) that have already been developed. So obviously I
don't want to re-invent the wheel. I did not write the C code, so know
nothing about it really (plus I'm not a C coder). My hope was to make calls
directly to them, but according to the docs, I can't really do this without
jumping through some minor hoops. I'm also assuming that the syscall
function *only* works with the syscall.h file. Is this correct or can I
include other ".h" files?
Any suggestions/thoughts/experiences would be greatly appreciated.
Thanks in advance.
- Michael
------------------------------
Date: Wed, 14 Feb 2001 11:39:29 -0600 (CST)
From: dennis100@webtv.net (BUCK NAKED1)
Subject: Re: comp.infosystems.www.authoring.cgi
Message-Id: <1106-3A8AC2D1-38@storefull-247.iap.bryant.webtv.net>
Re: comp.infosystems.www.authoring.cgi
> (Csaba=A0Raduly)
> > And so it came to pass that dennis100@webtv.net (BUCK NAKED1) on 14
Feb 2001 wrote
> > What's wrong with this sister group?
> > No posts there since Feb 4.
> Is it because all CGI-related questions are asked in c.l.p.misc
instead ?
Maybe so. But I, for one, have tried to post all of my cgi questions
there recently instead of here, and so have a few others. I posted 3
messages there this week that disappeared into thin air. I brought this
up because Abigail refered someone to that group yesterday. No need to
refer someone to a group that's not accepting posts. We're forced to
post our perl CGI questions here now, like it or not.
Regards,
--Dennis
------------------------------
Date: Wed, 14 Feb 2001 11:59:23 -0600 (CST)
From: dennis100@webtv.net (BUCK NAKED1)
Subject: Re: comp.infosystems.www.authoring.cgi
Message-Id: <1094-3A8AC77B-28@storefull-243.iap.bryant.webtv.net>
Nevermind. I noticed that posts are now showing up there.
--Dennis
------------------------------
Date: Wed, 14 Feb 2001 16:02:26 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: CRC-32 in Perl (was: Strings and pointers in Perl?)
Message-Id: <9ial8t4cemhjm53jquco4abicuk2ajud1v@4ax.com>
Frank van Wensveen wrote:
>So what I'm looking for (call me stubborn) is a Perl-only method of
>calculating CRC32. I'll be CRC-ing strings (not huge blocks of data)
>so performance shouldn't be too much of an issue. I hope.
>
>Suggestions anyone?
Note that there's more than one definition of CRC32.
#CRC32 routine in Perl
package CRC32;
my @table;
{
my $CRC32_POLYNOMIAL = 0xEDB88320;
my($i);
for($i=0;$i<256;$i++) {
my($crc) = $i;
my($j);
for($j=8;$j>0;$j--) {
if($crc & 1) {
$crc = ( $crc >> 1 ) ^ $CRC32_POLYNOMIAL;
} else {
$crc >>= 1;
}
}
$table[$i] = $crc;
}
}
sub start {
return 0xFFFFFFFF;
}
sub finish {
return (shift ^ 0xFFFFFFFF);
}
sub accumulate{
my($string, $crc) = @_;
my $j;
for($j=0; $j<length($string); $j++) {
my $temp1 = ($crc >> 8) & 0x00FFFFFF;
my $temp2 = $table[($crc ^ ord(substr($string,$j,1))) & 0xFF];
$crc = $temp1 ^ $temp2;
}
return $crc;
}
sub CRC32 {
my($string) = @_;
return finish(accumulate($string, &start()));
}
sub import {
my $package = caller;
*{$package."::CRC32"} = \&CRC32;
}
1;
--
Bart.
------------------------------
Date: Wed, 14 Feb 2001 15:42:27 +0100
From: Martin Raspe <raspe@uni-trier.de>
Subject: Re: die hard
Message-Id: <3A8A9953.A5FB87B1@uni-trier.de>
hefe@in-time.se schrieb:
> For help, please send mail to the webmaster (webmaster@server.net), giving
> this error message and the time and date of the error."
>
> Don't want that!
>
> I just want the Error message!
If you have access to the server configuration, it's up to you to decide
what the standard error page says. If not, just don't "die", but "exit"
gracefully after printing out your own error message as a regular HTML
page.
Martin
------------------------------
Date: Wed, 14 Feb 2001 09:15:33 -0800
From: mothra <mothra@nowhereatall.com>
Subject: Re: Directory listings in a table needs taint checking
Message-Id: <3A8ABD35.2473B9D@nowhereatall.com>
Joe Schaefer wrote:
>
> Paul <schallerp@hotmail.com> writes:
>
> > I'm looking for a script that I can use that will display a directory
> > contents in a table in order of the file dates.
>
> #!/usr/bin/perl -w
> use strict;
> use CGI ":standard";
> $_ = "$ARGV[0] by date\n";
> print table( {-border=>0},
> caption($_),
> Tr ( th($_) ),
> map { Tr td($_) } `ls -ta $ARGV[0]` );
> __END__
>
> You can use this one as much as you like.
Hi Joe,
Since this script was intended for web use, you might want to add some
taint checking
something like
if ( $ARGV[0] =~ /^([-@\w.]+)$/ ) {
my $var_to_use=$1;
} else{
die " Not good data";
}
and then set $_ to the untainted var.
otherwise if $ARGV[0] contained "; rm -fr *" all of your files will go
away.
Mothra
------------------------------
Date: Wed, 14 Feb 2001 16:12:26 -0000
From: Chris Stith <mischief@velma.motion.net>
Subject: Re: FAQ 4.24: How do I reformat a paragraph?
Message-Id: <t8lbjapg9aia2c@corp.supernews.com>
Peter J. Acklam <jacklam@math.uio.no> wrote:
> From the FAQ:
>> The paragraphs you give to Text::Wrap should not contain embedded
>> newlines. Text::Wrap doesn't justify the lines (flush-right).
> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> Umm...but did we agree that the text in the FAQ ought to be
> changed? :-)
For the purposes of being correct according to currently defined
usage, yes, it should be changed to say not (flush-right). It
should instead say (spaced to be flush with both margins).
Personally, I still prefer the other usage, but it's not recognized
by any authoritative dictionaries or glossaries. Therefore, despite
my general feelings about descriptive rather than prescriptive
definitions, I would fully support this small change for extra
clarity.
Chris
--
Christopher E. Stith
Programming is a tool. A tool is neither good nor evil. It is
the user who determines how it is used and to what ends.
------------------------------
Date: Wed, 14 Feb 2001 16:29:05 -0000
From: Chris Stith <mischief@velma.motion.net>
Subject: Re: File stat's
Message-Id: <t8lcih27lce98e@corp.supernews.com>
Jeremia d. <jdb@ga.prestige.net> wrote:
comp.lang.perl is a bogus group. It officially does not exist. Your
news admin needs to be flogged for carrying it.
> Ok, I am working on a small app that will search your hdd for SUID/SGID
> files. Now I have gotten that down and got them stored into an array,
> and I can pull out each one. Now I am wondering of a easier and faster
> way to stat the files, permissions for owner, group, and world. Then
> check them perms and files against like a ACL or something similar. So
> like if /bin/su has Setuid bit set and is NOT owned by root notify user.
> I can accomplish this but just taking the file perms of each file and
> storing them to test against. Thnks
Probably the best way to get a bunch of info on a file quickly is to
use stat() in list context and assign its results to an array.
my @file_stats = stat(file);
Chris
--
Christopher E. Stith
Parking for people we like only. All other vehicles will be vandalized.
------------------------------
Date: Wed, 14 Feb 2001 13:32:51 -0500
From: "Darryl Olthoff" <olthoff@multiboard.com>
Subject: Re: File stat's
Message-Id: <96ej0k$a19$1@panther.uwo.ca>
> comp.lang.perl is a bogus group. It officially does not exist. Your
> news admin needs to be flogged for carrying it.
Perhaps none of us exist either. We all seem to be reading and posting in
something that doesn't exist. I guess the real question would be, if you
feel that this group doesn't exist, then why the hell do you feel it
necessary to waste my time posting here?
------------------------------
Date: Wed, 14 Feb 2001 09:16:09 -0800
From: "terminalsplash" <shino_korah@yahoo.com>
Subject: GUI problem
Message-Id: <96eegq$5t6@news.or.intel.com>
when i run my gui code,the compiler complains ::No -label at ....widget.pm
at line 240
this is my code (part of it)
$menubar = $top->Frame()->pack(side=>'top');
$search_mb = $menubar->Menubutton(text =>'Search',relief
=>'raised',borderwidth =>2,)->pack(side=>'top',padx=>2);
####################################error here
$search_mb->command ( label => 'Find',accelerator
=>'Meta+F',underline=>0,command=>sub {print "find\n"});
###########################################
$search_mb->seperator();
Thanks in advance
------------------------------
Date: Wed, 14 Feb 2001 18:24:19 +0000
From: Matti =?iso-8859-1?Q?S=E4rkisilta?= <drifter@clix.pt>
Subject: Re: Hashes
Message-Id: <3A8ACD53.A7CA009D@clix.pt>
aramis1631@my-deja.com wrote:
> In article <f%4g6.1387$561.8850@eagle.america.net>,
> garry@zvolve.com (Garry Williams) wrote:
> > On Wed, 07 Feb 2001 02:52:27 GMT, aramis1631@my-deja.com
> > <aramis1631@my-deja.com> wrote:
> >
> > >In article <95qbrr$cku$1@nnrp1.deja.com>,
> > > bakor@my-deja.com wrote:
> >
> > [snip]
> >
> > >> %days_in_month=(Jan,31,Feb,28,Mar,31);
> > >>
> > >> $month=`date +%b`;
> > >> print $month;
> > >> print $days_in_month($month);
> > >
> > >It appears to me, that you have parens (), when you mean to use curly
> > >braces {}.
> >
> > Nope.
> >
> > Braces will produce a reference to an anonymous hash.
>
> I do not understand what you mean by this... he was attempting to
> access a hash incorrectly.
What he thought is that you referred to the first line with
"%days_in_month=(Jan,31,Feb,28,Mar,31);"
And he's right too, although this is OOT...
If you change the "()" to "{}" that created the reference,
although you can do it also by
%days_in_month=\(Jan,31,Feb,28,Mar,31);
which is equal...("There's more then one way to do it").
> > He's got it right, but he's not using strict. That's a Bad Thing.
> strict would have pointed out his error, agreed.
I'm still wondering when all those "learn perl in 30 days" - guides will
start using strict in all the nice fine example scripts...
> Er... Garry, you seem to know a lot; but, I do not understand your
> response. Care to enlighten me? Ah, no doubt I was unclear and you
> thought I was refering to the assignment of the hash in his first line?
> I should have specified his print line, then.
>
> The hash is %days_in_month
>
> We access the hash value using a key thus,
>
> $days_in_month{$month}
> ^^^ ^^^ Curly braces around the key, not parens
>
> This does not create a reference to an anonymous hash, it returns the
> value from the key=>value pair where $month is the key.
>
> use strict; #definitely would have helped him because it would not have
> compiled it would have told him that "Global symbol "$days_in_month"
> requires explicit package name at..."
"compiled"? (this 'll start a flamewar...I can sense a great disturbance in
the force...)
--
_________________________________________
// Matti Särkisilta - www.prisma.pt/~drifter
@a=split((\d)/,"4Hacker2another3Perl1Just");
shift(@a);%a=@a;print "@a{1..4}";
\\________________________________________
--- Begin gek code ---
GIT/GCM d? s++:s-- a? C++++ UL+++ P++++ L++++ E--- W++ N-
o-- w--- O- M V PS+++ PE Y+ PGP++ t 5 X+ R+ tv-- b++ DI++
D++ G e++ h++ r* z**
--- End geek code ---
------------------------------
Date: Wed, 14 Feb 2001 18:34:09 +0000
From: Matti =?iso-8859-1?Q?S=E4rkisilta?= <drifter@clix.pt>
Subject: Re: Hashes
Message-Id: <3A8ACFA1.5F8BE8A6@clix.pt>
Uri Guttman wrote:
> >>>>> "MM" == Mike McPherson <hafateltec@hotmail.com> writes:
>
> MM> #Correct the indate for calculating leap year
> MM> my $inyear = substr($indate,0,4);
> MM> my $leap = &leap($inyear);
> MM> my %DaysInMonth =
> MM> (0,31,1,$leap,2,31,3,30,4,31,5,30,6,31,7,31,8,30,9,31,10,30,11,31);
>
> eww. why not make that a simple array indexed by 0-11?
>
> MM> my $cordate = $indate."02000000";
> MM> my @array = localtime(&CurrentLineTime($cordate));
> MM> my $month = $array[4];
> MM> #Define Days in month and there names.
>
> MM> my %NamesOfMonth = (0 => January, 1 => Febuary,
> MM> 2 => March, 3 => April,
> MM> 4 => May, 5 => June,
> MM> 6 => July, 7 => August,
> MM> 8 => September, 9 => October,
> MM> 10 => November, 11 => December);
>
> again, indexing by an integer means that should be an array.
>
> MM> #Return The name of the month and how many days it has.
> MM> my $Month = $NamesOfMonth{$month};
> MM> my $TotalDaysInMonth = $DaysInMonth{$month};
>
> MM> if ($DaysInMonth{1} eq "28") {
> MM> print "\nThis is a not a leap year";
> MM> } else {
> MM> print "\nThis is a leap year";
> MM> }
>
> better to have a boolean leap flag set rather than hard coding 28 all
> over the place.
>
> MM> foreach $today(1..$TotalDaysInMonth) {
> MM> if ($today == 1 || $today == 2 || $today == 3 || $today == 4 || $today == 5
> MM> || $today == 6 || $today == 7 || $today == 8 || $today == 9){
> MM> @day = localtime(&CurrentLineTime($indate."0".$today."000000"));
> MM> } else {
> MM> @day = localtime(&CurrentLineTime($indate.$today."000000"));
> MM> }
>
> ouch!!
>
> @day = localtime(&CurrentLineTime( sprintf "$indate%02d000000", $today));
>
> MM> my $wday = $day[6];
> MM> if ($wday eq 0) {
> MM> $table{0}++;
> MM> }
> MM> if ($wday eq 1) {
> MM> $table{1}++;
> MM> }
> MM> if ($wday eq 2) {
> MM> $table{2}++;
> MM> }
> MM> if ($wday eq 3) {
> MM> $table{3}++;
> MM> }
> MM> if ($wday eq 4) {
> MM> $table{4}++;
> MM> }
> MM> if ($wday eq 5) {
> MM> $table{5}++;
> MM> }
> MM> if ($wday eq 6) {
> MM> $table{6}++;
> MM> }
> MM> }
>
> HUH???? you have the $wday value, so why not just index with it?
>
> $table{ $wday }++ ;
>
> MM> print "\nThere are $table{0} Sundays";
> MM> print "\nThere are $table{1} Mondays";
> MM> print "\nThere are $table{2} Tuesdays";
> MM> print "\nThere are $table{3} Wednsdays";
> MM> print "\nThere are $table{4} Thursdays";
> MM> print "\nThere are $table{5} Fridays";
> MM> print "\nThere are $table{6} Saturdays\n";
>
> make that into a loop with the days looked up from another array.
>
> MM> # Format:YYYYMMDDHHMMSS
>
> MM> sub CurrentLineTime {
> MM> my $time = 0;
> MM> my $date = $_[0];
>
> don't use $_[0] in normal code. use shift or assign @_ to a list.
>
> MM> my $day = substr($date,6,2);
> MM> my $month = substr($date,4,2);
> MM> my $year = substr($date,0,4);
> MM> my %month = ("01", 0, "02", 31, "03", 59, "04", 90,
> MM> "05", 120, "06", 151, "07", 181, "08", 212,
> MM> "09", 243, "10", 273, "11", 304, "12", 334);
>
> again, if this was an array, it would be cleaner and you wouldn't need
> those keys. you have hash on the brane. arrays are good for something
> you know.
>
> MM> $time += (substr($date,0,4) - 1970) * 31536000;
>
> does that take into account all the leap years since then? you should
> check your results against timelocal which is known to be correct.
>
> MM> $time += ($month{substr($date,4,2)} + substr($date,6,2) - 1) * 86400;
>
> MM> my ($hours, $minutes, $seconds);
>
> MM> if (substr($date,8,2) eq " ") {
> MM> $hours = 0;
> MM> } elsif (substr($date,8,1) eq " ") {
> MM> $hours = substr($date,9,1);
> MM> } else {
> MM> $hours = substr($date,8,2);
> MM> }
>
> $hours = substr($date,8,2) + 0 ;
>
> MM> if (substr($date,10,2) eq "00" || substr($date,10,2) eq " "){
> MM> $minutes = 0;
> MM> }elsif (substr($date,10,1) eq "0" || substr($date,10,1) eq " "){
> MM> $minutes = substr($date,11,1);
> MM> } else {
> MM> $minutes = substr($date,10,2);
> MM> }
>
> ditto
>
> MM> if (substr($date,12,2) eq "00" || substr($date,12,2) eq " "){
> MM> $seconds = 0;
> MM> }elsif (substr($date,12,1) eq "0" || substr($date,12,1) eq " "){
> MM> $seconds = substr($date,13,1);
> MM> } else {
> MM> $seconds = substr($date,12,2);
> MM> }
>
> ditto
>
> MM> $time += ($hours * 3600);
> MM> $time += ($minutes * 60);
> MM> $time += $seconds;
>
> MM> # Total Correction = (# of leap years) + (System Clock Correction)
> MM> # There have been ? leap years since 1970.
> MM> # System clock correction is -10 hours for this specific system.
> MM> # Total Correction = ? - 10*3600 for this specific system.
> MM> #---------------------------------------------------------#
> MM> # Calculate Time correction for leap year
> MM> #---------------------------------------------------------#
> MM> my $value = ($year - 1970)/4;
>
> i don't see anything handling 2000 being a leap year. you seem to assume
> it is but that means this code breaks in the year 2100.
>
> MM> my $fixval = int($value);
> MM> my $truevalue = 0;
>
> i prefer ace hardware. :)
>
> MM> my $monthday = $month.$day;
> MM> if ($fixval eq 0 and $monthday gt "0229"){
> MM> $truevalue = 1;
> MM> } elsif ($fixval eq 0 and $monthday lt "0229") {
> MM> $truevalue = 0;
> MM> } elsif ($fixval gt 0 and $monthday gt "0229") {
> MM> $truevalue = $fixval + 1;
> MM> } else {
> MM> $truevalue = $fixval;
> MM> }
>
> you have to learn to get away from all those flags. that code is impenetrable.
>
> MM> #---------------------------------------------------------#
> MM> $time += 86400 * $truevalue ; #Correction for leap year
> MM> $time -= 36000 ; #Correction for Time Zone
>
> fixed time zone is not cool.
>
> MM> return $time;
> MM> }
>
> MM> #Determine if it is a leep year.
> MM> sub leap {
> MM> my $inyear = $_[0];
> MM> # rule leapyear is divisable by 4 except those divisable by 100 unless
> MM> divisable by 400...
> MM> my $dividedyear = $inyear / 4;
> MM> my $intyear = int($inyear / 4);
> MM> my $centryyear = $inyear / 100;
> MM> my $intcentryyear = int($inyear / 100);
> MM> if ($dividedyear == $intyear){
> MM> $leap = 29;
> MM> } elsif ($dividedyear == $intyear && $centryyear == $intcentryyear){
> MM> $leap = 28;
> MM> } else {
> MM> $leap = 28;
> MM> }
> MM> print $leap;
> MM> return $leap;
> MM> }
>
> yech.
>
> $is_leap = $year % 4 == 0 && $year % 100 || $year % 400 == 0 ;
>
> uri
Ahhem,
$year % 4 == 0 && $year % 100 || $year % 400 == 0?29:28
as it works in code:
%DaysInMonth =
(0,31,1,$year % 4 == 0 && $year % 100 || $year % 400 == 0?29:28,2,31,3,30,4,31,5,30,6,31,7,31,8,30,9,31,10,30,11,31);
// D
--
_________________________________________
// Matti Särkisilta - www.prisma.pt/~drifter
@a=split((\d)/,"4Hacker2another3Perl1Just");
shift(@a);%a=@a;print "@a{1..4}";
\\________________________________________
--- Begin gek code ---
GIT/GCM d? s++:s-- a? C++++ UL+++ P++++ L++++ E--- W++ N-
o-- w--- O- M V PS+++ PE Y+ PGP++ t 5 X+ R+ tv-- b++ DI++
D++ G e++ h++ r* z**
--- End geek code ---
------------------------------
Date: Wed, 14 Feb 2001 16:08:44 -0000
From: Chris Stith <mischief@velma.motion.net>
Subject: Re: How bad is that Jeopardy post?
Message-Id: <t8lbccehs0nae7@corp.supernews.com>
Frank Miller <no@email.com> wrote:
> What the hell does not having a sig mean, other then I am not a geek. All
> you've really created is a nerd filter.
Hey, be careful. You're treading on thin dry ice and it's about to sublimate.
Geek and nerd are not perfect synonyms. There are plenty of self-identifying
geeks out there who will take offense at being called nerds.
-----BEGIN GEEK CODE BLOCK-----
Version: 4.0
GIT/CS d@ S+:+ a- C+ UL++++ UB++ P+++ L+++(++) E- W+++ N++
o+ K+++ w O++@ M V PS+(+++) PE Y+ PGP t++@ 5 X++(+++) R+++
tv b++ DI+++ D++ G@ e+(*) h---@ r++ z++(*)
------END GEEK CODE BLOCK------
I don't see the point of eliminating posts based on no sig, but if you're
even only a bit of a Usenet snob, scroing one down just a little for no
sig is almost understandable. Scoring one down for something that should
be a sig but with no sig dashes is worth scroing down to me. ;-)
Chris
--
Christopher E. Stith
Even in the worst of times, there is always someone who's
never had it better. Even in the best of times, there is
always someone who's never had it worse.
------------------------------
Date: Wed, 14 Feb 2001 13:39:21 -0500
From: Richard Chen <qchen@snet.net>
Subject: how to find cpu time usage from within perl
Message-Id: <3A8AD0D9.AFFBC6CA@snet.net>
The CPAN modules such as Time::HiRes measure actual time passed
bewteen consecutive calls. This may vary significantly if the system
is busy. I would like to measure actual cpu times used irrespective
of the system load.
On unix flatforms there is the system call clock which does that. I
could not find
a perl interface to invoke that.
Does anyone know any modules that deal with measuring cpu times
within perl or some other ways to achieve this?
Platform dependency is ok. I am interested in solaris/linux.
Thanks for any info.
Richard
------------------------------
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 V10 Issue 288
**************************************
