[22596] in Perl-Users-Digest
Perl-Users Digest, Issue: 4817 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Apr 4 18:05:57 2003
Date: Fri, 4 Apr 2003 15:05:08 -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 Fri, 4 Apr 2003 Volume: 10 Number: 4817
Today's topics:
Re: Algorithm Suggestion <goldbb2@earthlink.net>
Re: Can Perl mimic the awk '/start/,/end/' syntax <bart.lateur@pandora.be>
Re: cpan <goldbb2@earthlink.net>
Re: cpan <goldbb2@earthlink.net>
Re: CSV parse to array <goldbb2@earthlink.net>
Re: DBI webserver reports error 503 when SQL-statement <goldbb2@earthlink.net>
Re: how it works ! <goldbb2@earthlink.net>
Re: IPC::Open2 and bad file descriptor <goldbb2@earthlink.net>
Re: new Perl feature request: call into shared libs <hpa@zytor.com>
Re: Next token ??? Error <nobull@mail.com>
Re: Next token ??? Error <sbour@niaid.nih.gov>
Re: Next token ??? Error <usenet@tinita.de>
Re: Next token ??? Error <sbour@niaid.nih.gov>
Re: Next token ??? Error (Jay Tilton)
Re: Problem with redirecting STDOUT and STDERR <nobull@mail.com>
Re: Problem with redirecting STDOUT and STDERR <grazz@nyc.rr.com>
Re: Problem with redirecting STDOUT and STDERR <grazz@nyc.rr.com>
This script won't work for me...why!? <Verbalx2@hotmail.com>
Re: Trouble addressing a variable <none@none.com>
Re: Trouble addressing a variable <goldbb2@earthlink.net>
Re: Which is better - hashes or subroutines <goldbb2@earthlink.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 04 Apr 2003 15:41:10 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Algorithm Suggestion
Message-Id: <3E8DEDE6.E74647A8@earthlink.net>
Ed Napier wrote:
>
> I'm looking for suggestions on a fast algorithm to do the following:
>
> I have a list (thousands) of computers and IP addresses (10.10.10.20)
> and flat file with thousands of entries relating to subnets and
> gateways. The format is:
>
> First.3.Octets,lower range, upper range, gatewayname
>
> which ends up looking something like this:
>
> 172.18.121,0,15,gateway1
> 172.18.121,16,30,gateway2
> 172.18.121,31,100,gateway3
>
> What I need to do is find the gateway that corresponds to each
> computer. Now, I can come up with BFI algorithm to do it, but I was
> hoping that someone out there has a suggestion that borders on magic.
use Socket qw(inet_aton);
my %ip2gates;
open INPUT, "<", "first file" or die horribly;
while( <INPUT> ) {
my ($ip, undef, undef, $g) = split /,/;
$ip = inet_aton($ip); chop $ip;
push @{$ip2gates{$ip}}, $g;
}
open INPUT, "<", "second file" or die horribly;
local $" = ", ";
while( <INPUT> ) {
chomp;
my $ip = gethostbyname($_); chop $ip;
if( my $gates = $ip2gates{$ip} ) {
print "Gateways for host $_ are @$gates\n";
} else {
print "Ip $_ has no gateways\n";
}
}
close INPUT;
__END__
[untested]
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: Fri, 04 Apr 2003 21:05:26 GMT
From: Bart Lateur <bart.lateur@pandora.be>
Subject: Re: Can Perl mimic the awk '/start/,/end/' syntax
Message-Id: <7qsr8vgmcuspo920ar36e9vgg9fae2f1dn@4ax.com>
Uri Guttman wrote:
> WR> perl -pe 'undef $_ unless /start/../end/' myfile.txt
>
>bah! that will spit out warnings.
Not if this was the exact command line.
But presonally, I'd prefer to use the -n switch (not -p) and do "print
if ...".
perl -npe 'print if /start/../end/' myfile.txt
--
Bart.
------------------------------
Date: Fri, 04 Apr 2003 14:57:58 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: cpan
Message-Id: <3E8DE3C6.1801523A@earthlink.net>
Abigail wrote:
>
> Benjamin Goldberg (goldbb2@earthlink.net) wrote on MMMDIII September
> MCMXCIII in <URL:news:3E8CD896.46A0A17A@earthlink.net>:
> ==
> == Those are countries, not continents.
> ==
> == Try "north america", "south america", "europe", "asia", "africa". You
> == can also enter "central america" or "oceana", which aren't technically
> == continents.
> ==
> == If you are in antarctica, then you're out of luck. :)
>
> Australia is seen as a continent as well since it does have places
> with a "land climate".
Austrailia is considered to be a part of the continent of oceana, at
least according to:
http://www.cpan.org/SITES.html
:)
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: Fri, 04 Apr 2003 15:09:39 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: cpan
Message-Id: <3E8DE683.2460ECC5@earthlink.net>
Andras Malatinszky wrote:
>
> news@roaima.freeserve.co.uk wrote:
>
> >
> > [...] What CPAN is trying to help you
> > select is a mirror site that has high bandwidth and low latency *for
> > you*.
>
> What exactly does latency mean in this context? The only meaning I'm
> familiar with is "being hidden," which does not quite jive here. You're
> not trying to say a network with high latency is *late* in responding,
> are you?
For some networks, it takes a long time to connect (high latency), but
once it does, the download goes quickly (high bandwidth).
You want a combo of quick connect time, and fast download time once the
connection has occured.
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: Fri, 04 Apr 2003 15:26:57 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: CSV parse to array
Message-Id: <3E8DEA91.116CC149@earthlink.net>
sclozza wrote:
>
> I have a script that (among other things) reads in a list of files, in
> the form "file.html, file2.html, file3.html"
>
> I want to put file.html into @index[0], file2.html into @index[1] and
> so on
>
> elsif ($_ =~ /^DirectoryIndex:\s/) {
>
> $count++; # counter
> $csvindex = substr($_, 16); #count in 16 places
> $csvindex =~ s/,//g; # remove ','
> my @tmp = split(" ", $csvindex);
> my $item;
> foreach $item ( @tmp ) {
> $item =~ s/^ *//; # kill leading
> $item =~ s/ *$//; # and trailing spaces
> push (@index, $item);
> }
> }
>
> I cant get it to push the data into the array properly
Try writing this as:
++$count;
substr($csvindex, 0, 16) = "";
$csvindex =~ tr/,/ /;
push @index, split ' ', $csvindex;
Note that split will automatically remove leading and trialing spaces,
for the special case of "split ' '"
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: Fri, 04 Apr 2003 15:59:44 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: DBI webserver reports error 503 when SQL-statement returns error.
Message-Id: <3E8DF240.79AE1A4C@earthlink.net>
stig wrote:
>
> hi
>
> in a script running on a webserver, doing UPDATE on a table with a
> column that has the property UNIQUE set, when a user tries to change
> one email address to an email address that already exists, insted of
> feching the error the error kills the process and the webserver reports
> error 503 to the user, not very nice.
>
> here is the code that is supposed to update the email address.
> i would like to fetch the error somehow so that i can report to the
> user that this email is already existing.
>
> how should i do to fetch the error?
>
> ---START CODE---
> my $dbh = DBI->connect("DBI:mysql:someDB:localhost:3306", '?', '?',
> { RaiseError => 1, AutoCommit => 1 });
Normally, having RaiseError set is a GOOD thing. Normally.
But since you have a database operation which might fail for a perfectly
valid reason, then you should turn it off and explicitly check for
errors yourself.
my $dbh = DBI->connect("DBI:mysql:someDB:localhost:3306", '?', '?',
{ RaiseError => 1, AutoCommit => 1 });
my $sth = $dbh->prepare(q[
UPDATE persons SET email=? WHERE personID=?
]);
$sth->{RaiseError} = 0;
$sth->execute( $personEmail, $personID );
$sth->{RaiseError} = 1;
if( $sth->err ) {
failure. Check $sth->err, die if it's from any other
error than violation of uniqueness constraint.
} else {
success.
}
$sth->disconnect;
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: Fri, 04 Apr 2003 15:20:58 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: how it works !
Message-Id: <3E8DE92A.16C60DE5@earthlink.net>
Alexander Eisenhuth wrote:
[snip]
> sub exitThread {
> my ($obj) = @_;
> $obj->{running} = 0;
> }
>
> sub watchDevice {
> my ($comObj) = @_;
> # remember: shared object lies in another part of memory,
> # but are tied together
> print "threadLoop comObj >>>",$comObj, "<<<\n";
> while ($comObj->{running}) {
> print "threadLoop($comObj->{running}) id:$comObj->{threadId}\n";
> sleep 1;
> };
> print "thread finished($comObj->{running})\n";
> }
This is better, but still not quite right, since you're reading from and
writing to $obj without doing any locking.
sub exitThread {
my ($obj) = @_;
lock $obj;
$obj->{running} = 0;
}
sub watchDevice {
my ($comObj) = @_;
# remember: shared object lies in another part of memory,
# but are tied together
print "threadLoop comObj >>>",$comObj, "<<<\n";
my $id = threads->self->tid;
LOOP: while (1) {
{ lock $comObj; last LOOP if !$comobj->{running}; }
print "thread $id looping\n";
sleep 1;
};
print "thread $id finished\n";
}
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: Fri, 04 Apr 2003 15:29:43 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: IPC::Open2 and bad file descriptor
Message-Id: <3E8DEB37.825ACE00@earthlink.net>
Thomas Erskine wrote:
>
> Hi folks.
>
> I've been using IPC::Open2 to:
> - invoke another program
> - pass it something to do
> - the other program does its thing and passes back the result
>
> The application is too large to post here. The core code looks like:
>
> $pid = open2( $rdfh, $wrfh, @cmd) or die "open2: $!";
> print $wrfh "GO\n" or die "go: $!";
>
> The invoked program does some initialization and then:
>
> print STDOUT "IDLE\n" or die "idle: $!";
>
> and that's what gives me the "bad file descriptor" error.
>
> The other program works fine running it interactively with the same
> args.
>
> It works fine in my test harness, that I built using IPC::Open2.
>
> What would cause "bad file descriptor" here?
It means that the filedescriptor behind STDOUT is closed or negative.
Could you show two minimal but complete perl scripts which demonstrate
your problem?
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: 4 Apr 2003 12:18:07 -0800
From: "H. Peter Anvin" <hpa@zytor.com>
Subject: Re: new Perl feature request: call into shared libs
Message-Id: <b6kp9v$2o3$1@cesium.transmeta.com>
Followup to: <MPG.18f6a5d9d4bbf1809898e1@news>
By author: Jerry Coffin <jcoffin@taeus.com>
In newsgroup: comp.lang.asm.x86
>
> I'd go along with the statement that useful programs can't be written in
> "strictly conforming" C.
>
Baloney. However, what *is* true is that such a program is only
useful in the presence of a set of libraries, or a kernel, which
themselves cannot be written solely in strictly conforming C.
However, useful programs can be, and are, written in strictly
conforming C. They just rely on C's fairly rich set of standardized
libraries to do dirty work like I/O for them.
-hpa
--
<hpa@transmeta.com> at work, <hpa@zytor.com> in private!
"Unix gives you enough rope to shoot yourself in the foot."
Architectures needed: ia64 m68k mips64 ppc ppc64 s390 s390x sh v850 x86-64
------------------------------
Date: 04 Apr 2003 20:54:51 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Next token ??? Error
Message-Id: <u9d6k26nsk.fsf@wcl-l.bham.ac.uk>
Stephan Bour <sbour@niaid.nih.gov> writes:
> I have the following script that emails me my current IP address. When I try
> to run it I get a syntax error with a ³next token ???² explanation.
I don't think that's a Perl error. Are you sure you cut and pasted the
error message _exactly_?
Perhaps you are trying to run the program under some different script
interpreter.
Come to think of it I think that "next 2 tokens" or somesuch was
something that used to appear in Perl error messages way back in the
days of Perl4. Largely before my time I'm affraid. I've only been
using Perl seriously for less than half a decade, I only dabbled
before 1995.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Fri, 04 Apr 2003 15:49:00 -0500
From: Stephan Bour <sbour@niaid.nih.gov>
Subject: Re: Next token ??? Error
Message-Id: <BAB359EC.6F35%sbour@niaid.nih.gov>
in article u9d6k26nsk.fsf@wcl-l.bham.ac.uk, Brian McCauley at
nobull@mail.com wrote on 4/4/03 14:54:
> Stephan Bour <sbour@niaid.nih.gov> writes:
>
>> I have the following script that emails me my current IP address. When I try
>> to run it I get a syntax error with a ³next token ???² explanation.
>
> I don't think that's a Perl error. Are you sure you cut and pasted the
> error message _exactly_?
>
> Perhaps you are trying to run the program under some different script
> interpreter.
>
> Come to think of it I think that "next 2 tokens" or somesuch was
> something that used to appear in Perl error messages way back in the
> days of Perl4. Largely before my time I'm affraid. I've only been
> using Perl seriously for less than half a decade, I only dabbled
> before 1995.
Here is the full error message:
syntax error at IPsend.pl line 28, next token ???
Execution of IPsend-SBour.pl aborted due to compilation errors.
... And here is the full text of the script (the previous copy I provided
didn't have some of the commented sections).
#!/usr/bin/perl -w
use SendMail 2.09
use strict
#---------------------------------------------------------------------------
# Script Name: IPsend.pl
# Script Version: 1.0
#
# Date: 04/01/03
#
# Author: Stephan Bour
#
# Description: Automatically sends email containing your current IP address
#
# Tested Platforms: Macintosh OS X version 10.2 or higher
#
# Requirements: SendMail.pl (http://www.tneoh.zoneit.com/perl/SendMail/)
#
# Revision History:
# € 1.0: Original version.
#
#--------USER CONFIGURATION BEGIN----------------
# Enter your settings below: $To is your email address, $errors_to is the
email address for errors
# (usually same as $To) and $SMTP is the address of your SMTP server.
# WARNING: email addresses in variables must include a \ in front of the @
such as jdoe\@niaid.nih.gov
my $subject = "Today's IP address"; <=LINE 28
my $To = "jdoe\@foo.com";
my $errors_to = "jdoe\@foo.com";
my $SMTP = "smtp.foo.com";
#--------END OF USER CONFIGURATION----------------
$output = `ifconfig`;
#print "the full text is $output\n";
@split = split (/inet/, $output);
#print "The array is @split\n";
#print "$split[5]\n";
@split2 = split (/netmask/, $split[5]);
#print "The array is now @split2\n";
#print "Your IP address is $split2[0] on ".`date`;
{send_mail ($subject, $To, $To);}
{
#Send the actual email
#(0=Subject, 1=To, 2=From)
sub send_mail
{
$smobj = new SendMail ($SMTP);
$smobj->setDebug($smobj->ON);
$smobj->ErrorsTo($errors_to);
$smobj->Subject($_[0]);
$smobj->To($_[1]);
$smobj->From($_[2]);
$smobj->setMailBody("Your IP address is $split2[0] on ".`date`);
if ($smobj->sendMail() != 0)
{
print $smobj->{'error'}."\n";
exit -1;
}
print "Done\n\n";
exit 0;
}
}
------------------------------
Date: 4 Apr 2003 21:52:21 GMT
From: Tina Mueller <usenet@tinita.de>
Subject: Re: Next token ??? Error
Message-Id: <tinhcua36$68f$tina@news01.tinita.de>
Stephan Bour <sbour@niaid.nih.gov> wrote:
> I have the following script that emails me my current IP address. When I try
> to run it I get a syntax error with a ³next token ???² explanation. Any idea
what's your perl-version?
type "perl -v"
error messages like "next token" came from perl4...
maybe you would like to upgrade?
--
http://www.tinita.de/ \ enter__| |__the___ _ _ ___
http://Movies.tinita.de/ \ / _` / _ \/ _ \ '_(_-< of
http://www.perlquotes.de/ \ \ _,_\ __/\ __/_| /__/ perception
http://www.tinita.de/peace/link.html - Spread Peace
------------------------------
Date: Fri, 04 Apr 2003 16:59:45 -0500
From: Stephan Bour <sbour@niaid.nih.gov>
Subject: Re: Next token ??? Error
Message-Id: <BAB36A81.6F44%sbour@niaid.nih.gov>
in article tinhcua36$68f$tina@news01.tinita.de, Tina Mueller at
usenet@tinita.de wrote on 4/4/03 16:52:
> Stephan Bour <sbour@niaid.nih.gov> wrote:
>> I have the following script that emails me my current IP address. When I try
>> to run it I get a syntax error with a ³next token ???² explanation. Any idea
>
> what's your perl-version?
> type "perl -v"
>
> error messages like "next token" came from perl4...
> maybe you would like to upgrade?
Getting weirder by the minute:
perl -v
This is perl, v5.6.0 built for darwin
Copyright 1987-2000, Larry Wall
------------------------------
Date: Fri, 04 Apr 2003 22:11:34 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: Next token ??? Error
Message-Id: <3e8e02a5.18073061@news.erols.com>
Stephan Bour <sbour@niaid.nih.gov> wrote:
: Here is the full error message:
: syntax error at IPsend.pl line 28, next token ???
: Execution of IPsend-SBour.pl aborted due to compilation errors.
:
: ... And here is the full text of the script (the previous copy I provided
: didn't have some of the commented sections).
:
: #!/usr/bin/perl -w
:
: use SendMail 2.09
^
: use strict
^
Missing semicolons.
------------------------------
Date: 04 Apr 2003 20:16:33 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Problem with redirecting STDOUT and STDERR
Message-Id: <u9he9e6pke.fsf@wcl-l.bham.ac.uk>
googlegroups@scottsavarese.com (Scott) writes:
> I want to redirect standard out and stderr into a Log module that I
> created. I created a Log.pm and performed the following tie:
>
> # Redirect STDERR and STDOUT to logfile
> tie( *STDOUT, 'Log', $syswatch->getval( 'logfile' ),
> $syswatch->getval( 'logfilerotateinterval' ) )
> or die "Can't tie variable: $!\n";
> autoflush STDOUT 1;
> *STDERR = *STDOUT;
> ...message is not getting redirected to the Log
> module. I guess it is because the error message is generated by perl
> and not by the program.
Tied STDERR was not honoured by Perl error messages in 5.6.
Do you have an old Perl?
> ...errors, like the following:
>
> Undefined subroutine &Plugins::Foo::_do_check called at
> lib/Plugins/Foo.pm line 48.
But hang on that is a true _error_ not just output to STDOUT. Errors
are exceptions. Uncaught exceptions are going to tear down your whole
stack of cards including your tied file handle.
You need to be trapping exceptions using the eval{} or $SIG{__DIE__}
mechanisms.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Fri, 04 Apr 2003 21:40:50 GMT
From: Steve Grazzini <grazz@nyc.rr.com>
Subject: Re: Problem with redirecting STDOUT and STDERR
Message-Id: <CZmja.270$py2.120@twister.nyc.rr.com>
Scott <googlegroups@scottsavarese.com> wrote:
> Steve Grazzini <grazz@nyc.rr.com> wrote:
>> $SIG{__WARN__} = sub { print STDERR @_ };
>
> This doesn't help. I still get the same message.
Hmm... Works here with 5.8.0, but not 5.6.1.
But you'll need a $SIG{__WARN__} handler in any event, because
internal warnings don't go through STDERR.
>
> However, when I change it to 'sub {print @_}; it works fine...
> So my guess is that I am not redirecting STDERR correctly...
This might not be your fault. OTOH it would be cleaner (and
marginally more efficient) to do something like
my $object = tie *STDOUT, ...
$SIG{__WARN__} = sub { $object->log_msg(@_) };
Or you could let client code create the Log object ahead of
time and pass it as an argument to tie().
my $logger = Log->new(%config);
tie *STDOUT, 'Log', $logger;
tie *STDERR, 'Log', $logger;
$SIG{__WARN__} = sub { $logger->warning(@_) };
HTH
--
Steve
------------------------------
Date: Fri, 04 Apr 2003 21:57:40 GMT
From: Steve Grazzini <grazz@nyc.rr.com>
Subject: Re: Problem with redirecting STDOUT and STDERR
Message-Id: <odnja.857$Tu4.808601@twister.nyc.rr.com>
Brian McCauley <nobull@mail.com> wrote:
> googlegroups@scottsavarese.com (Scott) writes:
>
>> ...message is not getting redirected to the Log
>> module. I guess it is because the error message is generated by perl
>> and not by the program.
>
> Tied STDERR was not honoured by Perl error messages in 5.6.
5.8.0 still ignores the tie when issuing (internal) warnings.
--
Steve
------------------------------
Date: Fri, 04 Apr 2003 22:43:19 GMT
From: "Josh Morrison" <Verbalx2@hotmail.com>
Subject: This script won't work for me...why!?
Message-Id: <bUnja.50959$0X.9898645@twister.columbus.rr.com>
#!/usr/local/bin/perl
####################################################################
#################################################################### #What's
the path to the 5-day accuweather data file? $five_data="/data/5day.txt";
#What's the path to the 5-day accuweather template?
$five_template="fiveday.html"; #What's the path to the current accuweather
file? $current_data="data/localcur.txt"; #What's the path to the current
accuweather template? $current_template="current.html"; #What's the path to
the accuweather button template? $button_template="button.html"; #What's the
path to the accuweather view2 template? $view2_template="view2.html"; #
LET'S ROLL
####################################################################
&get_time; $show=$ENV{'QUERY_STRING'}; if (uc($show) eq "CURRENT"){
$count=0; &open_file("CURRENT","",$current_data); foreach $line
(&read_file("CURRENT")) { # split the fields at the | character @tabledata =
split(/\s*\|\s*/,$line ,11); $station=$tabledata[0]; $sky = $tabledata[1];
$current_temp = $tabledata[2]; $feel_temp = $tabledata[3]; $humidity=
$tabledata[4]; $wind_dir = $tabledata[5]; $wind_speed= $tabledata[6];
$pressure = $tabledata[7]; $visibility = $tabledata[8]; $icon =
$tabledata[9]; $redundant = $tabledata[10]; chop($tabledata[10]); $count++;
if($count ==3){ $template=$current_template; print
"content-type:text/html\n\n"; print &read_template; exit; } } } elsif
(uc($show) eq "BUTTON"){ $count=0; &open_file("CURRENT","",$current_data);
foreach $line (&read_file("CURRENT")) { # split the fields at the |
character @tabledata = split(/\s*\|\s*/,$line ,11); $station=$tabledata[0];
$sky = $tabledata[1]; $current_temp = $tabledata[2]; $feel_temp =
$tabledata[3]; $humidity= $tabledata[4]; $wind_dir = $tabledata[5];
$wind_speed= $tabledata[6]; $pressure = $tabledata[7]; $visibility =
$tabledata[8]; $icon = $tabledata[9]; $redundant = $tabledata[10];
chop($tabledata[10]); $count++; if($count ==3){ $template=$button_template;
print "content-type:text/html\n\n"; print &read_template; exit; } } } elsif
(uc($show) eq "5DAY"){ &open_file("FIVE","",$five_data); foreach $line
(&read_file("FIVE")) { # split the fields at the | character @tabledata =
split(/\s*\|\s*/,$line ,5); $col1[$count]=$tabledata[0]; $col2[$count] =
$tabledata[1]; $col3[$count] = $tabledata[2]; $col4[$count] = $tabledata[3];
$col5[$count]= $tabledata[4]; chop($tabledata[4]); $count++; }
$template=$five_template; print "content-type:text/html\n\n"; print
&read_template; exit; } elsif (uc($show) eq "VIEW2"){
&open_file("FIVE","",$five_data); foreach $line (&read_file("FIVE")) { #
split the fields at the | character @tabledata = split(/\s*\|\s*/,$line ,5);
$col1[$count]=$tabledata[0]; $col2[$count]=$tabledata[1];
$col3[$count]=$tabledata[2]; $col4[$count]=$tabledata[3];
$col5[$count]=$tabledata[4]; chop($tabledata[4]); $count++; } $count=0;
&open_file("CURRENT","",$current_data); foreach $line
(&read_file("CURRENT")) { # split the fields at the | character @tabledata =
split(/\s*\|\s*/,$line ,11); $station=$tabledata[0]; $sky = $tabledata[1];
$current_temp = $tabledata[2]; $feel_temp = $tabledata[3]; $humidity=
$tabledata[4]; $wind_dir = $tabledata[5]; $wind_speed= $tabledata[6];
$pressure = $tabledata[7]; $visibility = $tabledata[8]; $icon =
$tabledata[9]; $redundant = $tabledata[10]; chop($tabledata[10]);
$count++; } $template=$view2_template; print "content-type:text/html\n\n";
print &read_template; exit; } sub read_template{ $tag=""; $pretag="";
$output=""; open(OUTPUT, "$template") || print "no file found $template!";
while() { $output .= $_; } close(OUTPUT); $output =~ s/!DATE!/$daze/gm;
$output =~ s/!TIME!/$time/gm; $output =~ s/!STATION!/$station/gm; $output =~
s/!SKY!/$sky/gm; $output =~ s/!CURRENT_TEMP!/$current_temp/gm; $output =~
s/!FEEL_TEMP!/$feel_temp/gm; $output =~ s/!HUMIDITY!/$humidity/gm; $output
=~ s/!WIND_DIR!/$wind_dir/gm; $output =~ s/!WIND_SPEED!/$wind_speed/gm;
$output =~ s/!PRESSURE!/$pressure/gm; $output =~
s/!VISIBILITY!/$visibility/gm; $output =~ s/!ICON!/$icon/gm; $output =~
s/!DAY1!/$col1[1]/gm; $output =~ s/!DAY1_ICON!/$col2[1]/gm; $output =~
s/!DAY1_FORECAST!/$col3[1]/gm; $output =~ s/!DAY1_HIGH!/$col4[1]/gm; $output
=~ s/!DAY1_LOW!/$col5[1]/gm; $output =~ s/!DAY2!/$col1[2]/gm; $output =~
s/!DAY2_ICON!/$col2[2]/gm; $output =~ s/!DAY2_FORECAST!/$col3[2]/gm; $output
=~ s/!DAY2_HIGH!/$col4[2]/gm; $output =~ s/!DAY2_LOW!/$col5[2]/gm; $output
=~ s/!DAY3!/$col1[3]/gm; $output =~ s/!DAY3_ICON!/$col2[3]/gm; $output =~
s/!DAY3_FORECAST!/$col3[3]/gm; $output =~ s/!DAY3_HIGH!/$col4[3]/gm; $output
=~ s/!DAY3_LOW!/$col5[3]/gm; $output =~ s/!DAY4!/$col1[4]/gm; $output =~
s/!DAY4_ICON!/$col2[4]/gm; $output =~ s/!DAY4_FORECAST!/$col3[4]/gm; $output
=~ s/!DAY4_HIGH!/$col4[4]/gm; $output =~ s/!DAY4_LOW!/$col5[4]/gm; $output
=~ s/!DAY5!/$col1[5]/gm; $output =~ s/!DAY5_ICON!/$col2[5]/gm; $output =~
s/!DAY5_FORECAST!/$col3[5]/gm; $output =~ s/!DAY5_HIGH!/$col4[5]/gm; $output
=~ s/!DAY5_LOW!/$col5[5]/gm; return "$output\n"; } sub get_time {
$time=time; $time2=localtime($time); ($wday, $month, $day, $time, $year) =
split(" ",$time2,5); $year = substr($year,2,2); $month = uc($month); if
($month eq "DEC"){ $month="12";} elsif ($month eq "NOV"){ $month="11";}
elsif ($month eq "OCT"){ $month="10";} elsif ($month eq "SEP"){ $month="9";}
elsif ($month eq "AUG"){ $month="8";} elsif ($month eq "JUL"){ $month="7";}
elsif ($month eq "JUN"){ $month="6";} elsif ($month eq "MAY"){ $month="5";}
elsif ($month eq "APR"){ $month="4";} elsif ($month eq "MAR"){ $month="3";}
elsif ($month eq "FEB"){ $month="2";} elsif ($month eq "JAN"){ $month="1";}
$daze="$month/$day/$year"; } # READ LISTINGS sub read_file {
local($file_var) = @_; local(@file_lines) = (); while(<$file_var>) { chop;
push(@file_lines, $_); } close($file_var); return(@file_lines); } # OPEN
LISTING sub open_file { local ($filevar, $filemode, $listings) = @_; open
($filevar,$filemode . $listings) || die ("Can't open $listings"); }
------------------------------
Date: Fri, 4 Apr 2003 12:38:34 -0700
From: "Mark Holt" <none@none.com>
Subject: Re: Trouble addressing a variable
Message-Id: <b6kmu4$hag$1@terabinaries.xmission.com>
in the place of @OLC_0 .. @OLC_9, use @{"OLC_$num"}. You must remember to
include 'no strict "refs"' in your code, in the same scope as the
dereference. Also, the arrays must appear in the symbol table (they cannot
be declared with "my").
"Andrew Fayle" <andrew.fayle@dilithiumnetworks.com> wrote in message
news:dc3b4479.0304040053.6f54e87@posting.google.com...
> Hi,
>
> I have a set of arrays numbered @OLC_0 through @OLC_9. I need to write
> some code that will allow me to access any of these arrays depending
> on the vailue of $num. I know this sound like I should just use a 2
> dimensional array but that is not possible because this data needs to
> be shared between two threads.
> I have tried the code below but it doesn't work. Does anyone know how
> to change this code so that it will doi what I want.
>
> my $num=0;
> my $vars = "@OLC_$num";
> print STDOUT $vars."\n";
> push("$vars", 5);
> printf STDOUT "NUMBER = ".$OLC_0[0]."\n";
>
>
> Any help is greatly appreciated
> Andrew
------------------------------
Date: Fri, 04 Apr 2003 16:06:01 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Trouble addressing a variable
Message-Id: <3E8DF3B9.FC890AC8@earthlink.net>
Andrew Fayle wrote:
>
> Hi,
>
> I have a set of arrays numbered @OLC_0 through @OLC_9. I need to write
> some code that will allow me to access any of these arrays depending
> on the vailue of $num. I know this sound like I should just use a 2
> dimensional array but that is not possible because this data needs to
> be shared between two threads.
> I have tried the code below but it doesn't work. Does anyone know how
> to change this code so that it will doi what I want.
>
> my $num=0;
> my $vars = "@OLC_$num";
> print STDOUT $vars."\n";
> push("$vars", 5);
> printf STDOUT "NUMBER = ".$OLC_0[0]."\n";
my $num = 0;
my $var = $OLC[$num] ||= []; # ||= &share( [] );
print STODUT $var;
push @$var, 5;
print STDOUT "NUMBER = $OLC[$var][0]\n";
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
Date: Fri, 04 Apr 2003 15:11:36 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Which is better - hashes or subroutines
Message-Id: <3E8DE6F8.1A0A256C@earthlink.net>
"Tassilo v. Parseval" wrote:
[snip]
> Perhaps. When I wrote it I was more concerned with letting perl inline
> the above. The shift() should make this impossible. I am no longer sure
> whether mine can be inlined, but this should allow it:
>
> *$AUTOLOAD = sub () { "$self->{$var}" };
Sorry, that wouldn't work either, for getting perl to inline it. You'd
need to do:
my $thevar = $self->{$var};
*$AUTOLOAD = sub () { $thevar };
--
$a=24;split//,240513;s/\B/ => /for@@=qw(ac ab bc ba cb ca
);{push(@b,$a),($a-=6)^=1 for 2..$a/6x--$|;print "$@[$a%6
]\n";((6<=($a-=6))?$a+=$_[$a%6]-$a%6:($a=pop @b))&&redo;}
------------------------------
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 4817
***************************************
