[19151] in Perl-Users-Digest
Perl-Users Digest, Issue: 1346 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Jul 21 00:05:37 2001
Date: Fri, 20 Jul 2001 21:05:12 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <995688312-v10-i1346@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Fri, 20 Jul 2001 Volume: 10 Number: 1346
Today's topics:
Re: Any perl module for XML Explorer tree display/edit? (isterin)
Appanding to hash_key_value (Nipa)
Re: Appanding to hash_key_value <bwalton@rochester.rr.com>
Re: Broken WWW::Search engines ? (Mike)
Collin hates subject lines. <collin@crosslink.net>
Re: Determing if a variable is a number? (Tad McClellan)
exec 2 processes, get pid and kill (dave)
Re: fetchall_arrayref <jboes@qtm.net>
Re: localtime() returns GMT <dbe@wgn.net>
Re: localtime() returns GMT <Patrick_member@newsguy.com>
LWP Question (Grod)
Re: LWP Question <gisle@ActiveState.com>
Perl - CGI - Npulse (Jon)
Re: Problem wih DBD::Sybase 09.1- Set Autocommit fails <mpeppler@peppler.org>
Re: Redirecting STDERR <dbe@wgn.net>
Re: redirecting system() call output into variable <krahnj@acm.org>
Re: redirecting system() call output into variable <bwalton@rochester.rr.com>
Re: Regex help <qumsieh@sympatico.ca>
Re: Repetitive if statements <jboes@qtm.net>
Re: Repetitive if statements <godzilla@stomp.stomp.tokyo>
Re: Repetitive if statements <godzilla@stomp.stomp.tokyo>
Re: Repetitive if statements <godzilla@stomp.stomp.tokyo>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 19 Jul 2001 22:18:04 -0700
From: isterin@hotmail.com (isterin)
Subject: Re: Any perl module for XML Explorer tree display/edit?
Message-Id: <db67a7f3.0107192118.8d5b5dc@posting.google.com>
"M.L." <mel2000@hotmaildot.com> wrote in message news:<9j6v8s$mltff$1@ID-19545.news.dfncis.de>...
> I'm a newbie to XML currently reading up on various Perl modules to
> manipulate XML. My first goal is to find a module that can easily slurp an
> XML tree into a hash, and then back to an XML tree. With all the
> possibilities, I'm having trouble making up my mind.
Use XML::Simple if that is all you are looking for. It will create a
perl like data structure and then dump it back to XML.
>
> After that task my greatest concern will be displaying and modifying the
> tree. Ideally, I would like to:
>
> 1. Convert my spreadsheet-like database to an expanding/collapsing XML
> folder tree resembling that of Windows Explorer
Use XML::Excel or XML::SAXDriver::Excel to convert a spreadsheet to
XML.
>
> 2. Tree display should collapse to 1 folder by default (stylesheet needed?)
>
> 3. User must be able to add new record(s) to top of folder tree just as in
> Explorer
That you might have to code on your own, and is not very easy if you
are talking about doing it in the browser. But there must be apps to
handle some part of this.
Ilya
>
> 4. User must be allowed to add new tag(s) to each record, but since each
> record is symmetrical, each new tag must be added to all records/folders in
> the tree.
>
> I'd like to know if there is a Perl or Javascript module that can do most of
> what I am asking for as far as displaying and modifying the XML tree (as
> well as slurping/restoring).
>
> Thanks
------------------------------
Date: 20 Jul 2001 15:53:13 -0700
From: npatel@webley.com (Nipa)
Subject: Appanding to hash_key_value
Message-Id: <24d1a4c3.0107201453.15b64d53@posting.google.com>
Hi every one,
Here's something that's been driving me nuts for a while now( almost
two days). What's driving me nuts is that, it is so simple and I can't
figure it out.
I have tried many different approch to this problem but none them seem
to be working.
here is my question: How do i append to an existing key's value in a
Hash
this is that the code looks like:
if($formdata{$key})
{
$formdata{$key} .= "$value";
}
else { $fromdata{$key} = $value; }
now, the problem is in appanding the value to an existing 'key' value.
What I need to do is, if i find a key that already exist and appand to
it's value.
One question would be, when I do ' if($formdata{$key}) ' does it mean
that i am checking the existance of a value or a key in a hash. I have
also tried using 'join' function but the output it not what i want. it
doesn't appand to the original value, rather it overwrites it. since
the original value (string) is quite long, I can see the over
writting.
I have tried all kinds of different approches, doing something like
this too:
$previous_value = $formdata{$key};
undef $formdata{$key};
$formdata{$key} = "$previous_value $new_value";
for some unknown reason(at least it's unknown to me :) ) it also
overwrites an existing string and that's not what i want.
Believe me or not, but I have sent close to 4 hr figuring this out,
and still haven't figured it. Thus i am asking for your help.
help appreciated
Thanks
Nipa
------------------------------
Date: Sat, 21 Jul 2001 03:19:46 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: Appanding to hash_key_value
Message-Id: <3B58F4ED.3AABC7C6@rochester.rr.com>
Nipa wrote:
...
> here is my question: How do i append to an existing key's value in a
> Hash
> this is that the code looks like:
> if($formdata{$key})
The above line tests for a true value stored in a hash as the value
corresponding to a key. If the value is 0, the empty string, or undef,
the test will take the false branch. You want to use the exists
function for this (see perldoc -f exists). But why are you doing this
test in the first place?
> {
> $formdata{$key} .= "$value";
> }
> else { $fromdata{$key} = $value; }
-----------^^
You have two hashes here.
>
> now, the problem is in appanding the value to an existing 'key' value.
> What I need to do is, if i find a key that already exist and appand to
> it's value.
>
> One question would be, when I do ' if($formdata{$key}) ' does it mean
> that i am checking the existance of a value or a key in a hash. I have
No. It means you are testing for a true value stored in a hash under a
key. As stated above, you want the "exists" function for this job.
> also tried using 'join' function but the output it not what i want. it
"join" joins array elements.
> doesn't appand to the original value, rather it overwrites it. since
> the original value (string) is quite long, I can see the over
> writting.
One question: would this be a tied hash tied to a dbm-type file
implementation which has a limited length for values which you might be
exceeding (not every dbm-type file implementation supports unlimited
key/value lengths)? If so, you could get odd behavior. Or if the hash
is tied to some other thing?
...
> Nipa
It should be quite simple:
$formdata{$key}.=$value;
ought to do the trick. There should be no need to test for the
existence of a key or any other complicated mechanism.
--
Bob Walton
------------------------------
Date: 19 Jul 2001 14:00:34 -0700
From: michael_of_neb@yahoo.com (Mike)
Subject: Re: Broken WWW::Search engines ?
Message-Id: <5a10590e.0107191300.51c9335e@posting.google.com>
michael_of_neb@yahoo.com (Mike) wrote in message news:<5a10590e.0107171052.2be446f2@posting.google.com>...
> Has anybody else been having problems using the following WWW::Search
> modules ?
>
> HotBot.pm
> LookSmart.pm
> AlltheWeb.pm
> Snap.pm
snip a long messsage
Well, no sooner said than done.
The very recently released LookSmart and Allthe Web engines are up on
the web, and in a new repository too.
www.idexer.com/backends
Check it out.
I'm still testing the HotBot.pm module, and I haven't heard anything
from anyone else about the Snap.pm module, so that's on my agenda as
well.
The AltaVista and MetaCrawler .pm's are getting periodic errors that
are caused by some kind of internal error that may be related to
WWW::Search rather than themselves, so I'm still trying to get a
proof.
Thanks for the support.
Mike
------------------------------
Date: Fri, 20 Jul 2001 23:33:55 -0400
From: "Collin E Borrlewyn" <collin@crosslink.net>
Subject: Collin hates subject lines.
Message-Id: <3b58f78b$0$23492@dingus.crosslink.net>
I'm writing a signup script for part of a larger message board. Everything
else works, but I've been having trouble with preferences. I've tracked the
problem down to the following subroutine. (I don't know if the indentation
will hold.)
sub update_info(){
open(DATA,"$userdir/$_[0]") || return 0;
flock(DATA,2) unless $^O =~ /Win/;
my($data,@sig) = <DATA>;
close(DATA);
my @data = split(/\t/,$data);
chomp($data);
my %data;
foreach(@data){
my @namval = split(/\*/,$_);
$data{$namval[0]} = $namval[1];
}
$data{'SIG'} = join('',@sig);
$data{$_[1]} = $data{$_[2]}; # Updates the element
my $out = '';
foreach(keys %data){
$out .= "$_*$data{$_}\t" unless $_ eq 'SIG';
}
chop($out); # Remove final tab
open(DATA,">$userdir/$_[0]") || return 0;
flock(DATA,2) unless $^O =~ /Win/;
print DATA $out."\n".$data{'SIG'};
close(DATA) || return 0;
return 1;
}
$userdir is a directory, usually ./uids and $_[0] is a file, the one I've
been experimenting on is called '1005'
The contents of this file are as follows:
USERNAME*TestMan5<tab>PASSWORD*test<tab>EMAIL*test@test.test
Signature goes here
and on any
further lines.
Where <tab>'s are actual tab marks.
Now, the idea is to send update_info() a user ID (1005, in $_[0]), an
element name ('EMAIL', in $_[1]) and a new value ('testsuperman@test.test',
in $_[2]) and have the information be altered and resaved.
What ends up happening is that whatever element name I tell it to update, it
instead simply empties (setting the elemnt to '' ?). I've checked closely,
but can find no reason. Perhaps I'm doing something incorrectly? Maybe it's
a quirk I don't know about?
Any help is appreciated.
------------------------------
Date: Fri, 20 Jul 2001 20:07:05 -0400
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Determing if a variable is a number?
Message-Id: <slrn9lhht9.3o7.tadmc@tadmc26.august.net>
Stan Brown <stanb@panix.com> wrote:
>
>I need o
>figure out which of these variables are numbers.
Perl FAQ, part 4:
"How do I determine whether a scalar is a number/whole/integer/float?"
>I looke in the Perl cookbook, and came up with a solutin using //, but it
>complains when I hand it a non numeric value.
>
>How can I make this work withou perl complaining?
^^^^
^^^^
What this? Did you mean to include some code in your post?
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 20 Jul 2001 06:22:26 -0700
From: dmbourke@hotmail.com (dave)
Subject: exec 2 processes, get pid and kill
Message-Id: <6685c8a4.0107200522.606fe92@posting.google.com>
I've seen posts similar to the question I'm asking but only for one
process. I need to launch two processes at the same time and kill them
both at user input. This is what I have for one process:
sub fork_process
{
$pid=fork;
if ($pid == 0) {
exec "program";
}
elsif ( defined $pid ) {
while (1) {
print "\n\n\n\tNow running: program\n";
print "\tHit the f key then enter when finished: ";
chomp(my $finish = <STDIN>);
if ($finish eq "f") {
print "\n\tkilling $pid...\n\n";
kill 9, $pid; last;
}
}
} else {
die "fork error: Could not fork kernel_stats: $!\n";
}
}
While the first program is running I would like to execute a second
program as well. When the user hits f, both programs will be killed
and the Perl script will continue.
Does anyone know how to do this?
Thanks.
------------------------------
Date: Fri, 20 Jul 2001 22:44:22 -0400
From: Jeff Boes <jboes@qtm.net>
Subject: Re: fetchall_arrayref
Message-Id: <0rqhltgrro97mme811mj8sfj8nc0tddbio@4ax.com>
At some point in time, costas@othermedia.com (cmavroudis) wrote:
>Im querying a db and want to retrieve an array of hashes. BUt am
>having trouble and cant seem to quite get it right. This is the syntax
>i am using to query and retrieve the db.
>
>my $sql = "SELECT url, status, tag, category FROM url";
>my $sth = $dbh->prepare( $sql );
>$sth->execute();
>
>my $goodrow = ();
Um, that's not doing what you think. It sets $goodrow to the number of elements
in the list of the RHS, namely zero.
>$goodrow = $sth->fetchall_arrayref;
The DBI perldoc for this function will reveal that if you pass in a hashref, you
will get back a ref to an array of hashrefs. That's usually more useful than the
default, which is a ref to an array of arrayrefs. So
my $rows = $sth->fetchall_arrayref({ });
>
>I am then getting an error message
>"Can't coerce array into hash at addpage_details.cgi line 70. " when i
>try to loop through the array as so.
>
>my $row;
>foreach $row ($goodrow)
>{
>$goodrow->{'status'};
>}
>
Here, you need to de-reference your arrayref before you can loop through it:
foreach $row (@$rows) {
print $row->{status}, "\n";
}
--
~~~~~~~~~~~~~~~~|It is by caffeine alone I set my mind in motion,
Jeffery Boes |It is by the beans of Java that thoughts acquire speed,
jboes@qtm.net |The hands acquire shaking, the shaking becomes a warning,
UIN 3394914 |It is by caffeine alone I set my mind in motion.
------------------------------
Date: Fri, 20 Jul 2001 18:27:28 -0700
From: "$Bill Luebkert" <dbe@wgn.net>
Subject: Re: localtime() returns GMT
Message-Id: <3B58DA80.61EE67BF@wgn.net>
Patrick Flaherty wrote:
>
> Curiouser and curioser. When I compare the output of localtime() with gmtime(),
> I find that localtime() is in fact returning gmt+1 when in fact I'm in
> California (gmt-8 or 9 I believe).
Check your clock setting (right click on clock in taskbar) and see what TZ you
are set to. If that doesn't help, try adding 'SET TZ=PST8PDT' to your autoexec.bat
or equiv setting of env on 2000.
--
,-/- __ _ _ $Bill Luebkert ICQ=14439852
(_/ / ) // // DBE Collectibles Mailto:dbe@todbe.com
/ ) /--< o // // http://dbecoll.webjump.com/ (Free site for Perl)
-/-' /___/_<_</_</_ Castle of Medieval Myth & Magic http://www.todbe.com/
------------------------------
Date: 20 Jul 2001 17:25:21 -0700
From: Patrick Flaherty <Patrick_member@newsguy.com>
Subject: Re: localtime() returns GMT
Message-Id: <9jai5h01u3b@drn.newsguy.com>
In article <tlhfmo5e3s7343@corp.supernews.com>, cberry@cinenet.net says...
>
>Patrick Flaherty (Patrick_member@newsguy.com) wrote:
>: Curiouser and curioser. When I compare the output of localtime() with
>gmtime(),
>: I find that localtime() is in fact returning gmt+1 when in fact I'm in
>: California (gmt-8 or 9 I believe).
>
>PST is GMT-8, PDT (current) is GMT-7.
>
>Sounds like the system has the right DST settings but the wrong default
>timezone set.
Well yes that what it had looked like to me too. However Clock was showing the
right day and time. In addition, checking the Date/Time Control Panel (this is
W2000) I see that the timezone is indeed PST.
>
>--
> | Craig Berry - http://www.cinenet.net/~cberry/
> --*-- "Brute force done fast enough looks slick."
> | - William Purves
------------------------------
Date: 20 Jul 2001 06:46:56 -0700
From: ggrothendieck@volcanomail.com (Grod)
Subject: LWP Question
Message-Id: <ffd662ea.0107200546.2b1db6cb@posting.google.com>
Why does the following output "getstore successful" but not "get
successful"? That is, why should getstore work and get not work on the
same URL?
use LWP::Simple;
$u = "http://news.morningstar.com/university/display_article/0,1845,2937,00.html";
$rc = getstore($u,"mstr.htm");
print "getstore successful\n" if is_success($rc);
$s = get($u);
print "get successful\n" if defined($s);
------------------------------
Date: Sat, 21 Jul 2001 03:16:37 GMT
From: Gisle Aas <gisle@ActiveState.com>
Subject: Re: LWP Question
Message-Id: <m3r8vbotmn.fsf@ActiveState.com>
ggrothendieck@volcanomail.com (Grod) writes:
> Why does the following output "getstore successful" but not "get
> successful"? That is, why should getstore work and get not work on the
> same URL?
The reason is that getstore() always invoke the full LWP underneath
but get() tries to use a simpler implementation so that it does not
have to load the full set of LWP modules. This simpler implementation
did not know how to deal with non-absolute redirects. This should not
really happen as the HTTP specs clearly specify that the Location
header should always be an absolute URI. The server is buggy.
Anyway, you can force LWP::Simple::get to use full LWP by importing
the $ua variable:
use LWP::Simple qw(get $ua);
Or you can apply this patch:
Index: lib/LWP/Simple.pm
===================================================================
RCS file: /cvsroot/libwww-perl/lwp5/lib/LWP/Simple.pm,v
retrieving revision 1.34
diff -u -p -u -r1.34 Simple.pm
--- Simple.pm 2001/04/10 17:16:34 1.34
+++ Simple.pm 2001/07/21 03:07:41
@@ -281,6 +281,12 @@ sub _get
return _trivial_http_get($host, $port, $path);
} else {
_init_ua() unless $ua;
+ if (@_ && $url !~ /^\w+:/) {
+ # non-absolute redirect from &_trivial_http_get
+ my($host, $port, $path) = @_;
+ require URI;
+ $url = URI->new_abs($url, "http://$host:$port$path");
+ }
my $request = HTTP::Request->new(GET => $url);
my $response = $ua->request($request);
return $response->is_success ? $response->content : undef;
@@ -320,7 +326,7 @@ sub _trivial_http_get
# redirect
my $url = $1;
return undef if $loop_check{$url}++;
- return _get($url);
+ return _get($url, $host, $port, $path);
}
return undef unless $code =~ /^2/;
$buf =~ s/.+?\015?\012\015?\012//s; # zap header
Regards,
Gisle
------------------------------
Date: 19 Jul 2001 06:11:15 -0700
From: jooten@lynksystems.com (Jon)
Subject: Perl - CGI - Npulse
Message-Id: <6880a040.0107190511.5458af63@posting.google.com>
I am trying to install Npulse and I am getting the following error
from Perl.
HTTP/1.0 500 Perl execution failed Server: MiniServ/0.01 Date: Thu, 19
Jul 2001 11:56:25 GMT Content-type: text/html Connection: close
Error - Perl execution failed
Function CGI::Object::FETCH does not exist at /opt/npulse/npulse.cgi
line 57
I am open to any and all relevent suggestions.
Jon
------------------------------
Date: Fri, 20 Jul 2001 18:07:05 -0700
From: "Michael Peppler" <mpeppler@peppler.org>
Subject: Re: Problem wih DBD::Sybase 09.1- Set Autocommit fails after prepare
Message-Id: <tlhldqb683cn87@corp.supernews.com>
In article <ef37b807.0107181906.8adf6eb@posting.google.com>, "MunishK"
<mkfaltu@yahoo.com> wrote:
> DBD::Sybase 0.91
> I have to do a transaction after preparing a statement but before
> executing them. For that I set Autocommit off, that fails giving error
> that says
> "panic: can't set AutoCommit with active statement handles" Is it a bug
> or limitation? Can somebody suggest a work around, Idea is to prepare
> the statement once and use within or without transaction. H.E.L.P. !!
This won't work. You need to set the autocommit flag before the prepare.
The reason is that if there are active statements then DBD::Sybase could
get confused about the state of transactions.
Use explicit transactions (i.e. issue a BEGIN TRAN manually), or
re-execute the prepare() when you need the transaction support.
Michael
--
Michael Peppler - Data Migrations Inc. - http://www.mbay.net/~mpeppler
mpeppler@peppler.org - mpeppler@mbay.net
International Sybase User Group - http://www.isug.com
------------------------------
Date: Fri, 20 Jul 2001 18:17:32 -0700
From: "$Bill Luebkert" <dbe@wgn.net>
Subject: Re: Redirecting STDERR
Message-Id: <3B58D82C.F0F695B@wgn.net>
Fred wrote:
>
> Hi,
>
> I am trying to redirect the errors generated by one script on win32. I use
There are lots of Win32 OS's - be specific.
> the following command:
>
> scriptname > out.txt 2>&1
>
> If the STDOUT is correctly redirected, none of the error messages are sent
> to the file.
>
> Any idea why??
If you're using command.com (9x) instead of cmd.exe (NT/2k), you can't do it.
--
,-/- __ _ _ $Bill Luebkert ICQ=14439852
(_/ / ) // // DBE Collectibles Mailto:dbe@todbe.com
/ ) /--< o // // http://dbecoll.webjump.com/ (Free site for Perl)
-/-' /___/_<_</_</_ Castle of Medieval Myth & Magic http://www.todbe.com/
------------------------------
Date: Sat, 21 Jul 2001 03:39:44 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: redirecting system() call output into variable
Message-Id: <3B58F981.E70048B6@acm.org>
Graham wrote:
>
> Hi,
>
> I am using the system() call within perl (I am writing a simple menu
> driven shell), but I wish to do something semantically the same as the
> following:
>
> $output = system("command");
>
> Where the output of the command is placed into $output, and not just
> printed on the terminal. I would like to do this in order to reformat
> the output of various commands. Of course, $output in the above
> example at the moment will return the return code of command, which I
> don't need yet.
>
> I have also tried the following:
>
> open (CMD, "|command 2>&1");
> @lines = <CMD>;
> close(CMD);
>
> and variants, but with no luck. A nasty hack would be to write the
> output to a file, then read it back in within Perl...
my $output = `command`;
# OR
my $output = qx( "command" );
John
--
use Perl;
program
fulfillment
------------------------------
Date: Sat, 21 Jul 2001 03:49:00 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: redirecting system() call output into variable
Message-Id: <3B58FBC7.1AD526C1@rochester.rr.com>
Graham wrote:
...
> I am using the system() call within perl (I am writing a simple menu
> driven shell), but I wish to do something semantically the same as the
> following:
>
> $output = system("command");
>
> Where the output of the command is placed into $output, and not just
> printed on the terminal. I would like to do this in order to reformat
...
> Graham
See:
perldoc perlop
particularly the section on Quote and Quote-like Operators, with an eye
toward the qx or backticks operator. That is used like:
$output=`$command`;
and will place the standard output of the command in $command into
$output. Note that those are backticks (to the left of the one key on
many keyboards).
--
Bob Walton
------------------------------
Date: Fri, 20 Jul 2001 23:50:03 -0400
From: "Ala Qumsieh" <qumsieh@sympatico.ca>
Subject: Re: Regex help
Message-Id: <iT667.17602$ca3.1636004@news20.bellglobal.com>
"mc" <nospam@home.com> wrote in message news:3b5870a2.50826284@news...
> On Fri, 20 Jul 2001 13:15:09 -0400, Ed Napier <napes@attglobal.net>
> wrote:
>
> >I'm trying to extract "running" from the html code below. My regex is
> >just not cutting it. Can someone help?
> >
> >Thanks,
> >Ed
> >
> >my $txt = '<html> <head> <title>LCF Daemon</title></title> <!<body
> >BGCOLOR="ffffff" TEXT="000000"> <h2 align=center><center> TMA Daemon
> >Status Page </center></h2> <pre> </pre> <FONT SIZE="+1">
> >Version : <FONT color="#ff0000">93</font><br>Interp :
> ><FONT color="#ff0000">Windows NT</font><br> Endpoint Label : <FONT
> >color="#ff0000">b00c04fd0223e</font><br> Hostname : <FONT
> >color="#ff0000">b00c04fd0223e</font><br> NIC Address : <FONT
> >color="#ff0000"
> >>0.0.0.0+9495</font><br> Gateway Address : <FONT
> >color="#ff0000">uswrdntsg08s.bankamerica.com
> >(171.177.193.248+9494)</font><br> Status : <FONT
> >color="#ff0000">running</font><br> Last Restart : <FONT
> >color="#ff0000">Jul 20 12:25:29 Eastern Daylight Time</FONT><br> </FONT>
> ><pre> </pre> <hr> <FONT SIZE="+1"> Operations: <STRONG> <P> <UL
> >TYPE=SQUARE>
> > <LI><A HREF="logfile">Show Logfile</A><BR> <LI><A HREF="methcache">List
> >Method Cache</A><BR> <LI><A HREF="stats">Display Usage
> >Statistics</A><BR> <LI><A HREF="config">Show Config Settings</A><BR>
> ><LI><A HREF="tlog">Show Trace Log</A><BR> <LI><A HREF="addr">Network
> >Addresses Configuration</A><BR> </UL> </FONT> </STRONG> </html>
> ><!END_PAGE>';
> >
> > $txt =~ /Status\s*\:\s*<[\w\s]+>(\w+)/g;
> > #$txt =~ /(<[\w\s]+>)/;
> > $status = $1;
> >print "Status: $status\n";
> > $txt =~ /Status\: [^<]*/; print("$&\n");
>
> The main problem is that your <FONT > tag
> contains some punctuation characters. How about:
>
> $txt =~ /Status\s*\:\s*<[\w\s"=#]+?>(\w+)/g;
>
> Or consider:
>
> $txt =~ /Status\s*\:\s*<.*?>(\w+)/g;
I would stick a /s at the end to let the . match newlines in case there are
newlines inside the tag.
--Ala
------------------------------
Date: Fri, 20 Jul 2001 22:13:15 -0400
From: Jeff Boes <jboes@qtm.net>
Subject: Re: Repetitive if statements
Message-Id: <40jhltkkq4r5csdn0dqs96aan7r07g3svd@4ax.com>
At some point in time, "Brian D. Green" <greenbd@u.washington.edu> wrote:
>Hello,
>
>I'm trying to write some code that will take the results of a survey and
>translate each of the five possible values of the survey into a different
>graphic. I've figured out something that works, but it seems very
>repetitive and inefficient. Right now, I have it doing:
>
>if ($q1 == 1) {
>$q1 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
>}
>if ($q2 == 1) {
>$q2 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
>}
>if ($q3 == 1) {
>$q3 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
>}
>if ($q4 == 1) {
>$q4 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
>}
>if ($q5 == 1) {
>$q5 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
>}
>if ($q6 == 1) {
>$q6 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
>}
>if ($q7 == 1) {
>$q7 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
>}
>
>if ($q1 == 2) {
>$q1 = "<img src='/legsim/img/da.gif' height='18' width='180'>";
>}
>...and so on for each of the five values. Could someone suggest how I
>might simplify it?
Happy to help:
my @strings = ("<img src='/legsim/img/sd.gif' height='18' width='180'>",
"<img src='/legsim/img/da.gif' height='18' width='180'>",
... and so on
);
foreach ($q1,$q2,$q3,$q4,$q5,$q6,$q7) {
$_ = $strings[$_];
}
which takes advantage of the fact that inside a 'foreach', $_ is an *alias* for
the element of the list.
--
~~~~~~~~~~~~~~~~|It is by caffeine alone I set my mind in motion,
Jeffery Boes |It is by the beans of Java that thoughts acquire speed,
jboes@qtm.net |The hands acquire shaking, the shaking becomes a warning,
UIN 3394914 |It is by caffeine alone I set my mind in motion.
------------------------------
Date: Fri, 20 Jul 2001 20:12:32 -0700
From: "Godzilla!" <godzilla@stomp.stomp.tokyo>
Subject: Re: Repetitive if statements
Message-Id: <3B58F320.6A4CF06A@stomp.stomp.tokyo>
Jeff Boes wrote:
> Brian D. Green wrote:
> >I'm trying to write some code that will take the results of a survey and
> >translate each of the five possible values of the survey into a different
> >graphic. I've figured out something that works, but it seems very
> >repetitive and inefficient. Right now, I have it doing:
> >if ($q1 == 1) {
> >$q1 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
(snipped)
> Happy to help:
> my @strings = ("<img src='/legsim/img/sd.gif' height='18' width='180'>",
> "<img src='/legsim/img/da.gif' height='18' width='180'>",
> ... and so on
> );
> foreach ($q1,$q2,$q3,$q4,$q5,$q6,$q7) {
> $_ = $strings[$_];
> }
> which takes advantage of the fact that inside a 'foreach', $_ is an *alias* for
> the element of the list.
It is prudent to test code before posting.
For my test conditions per the originating author's
parameters, all "q" variables should be null except
for $q3 which should be:
<img src='/legsim/img/5.gif' height='18' width='180'>
Godzilla!
--
#!perl
print "Content-type: text/plain\n\n";
$q3 = 5;
my @strings = ("<img src='/legsim/img/1.gif' height='18' width='180'>",
"<img src='/legsim/img/2.gif' height='18' width='180'>",
"<img src='/legsim/img/3.gif' height='18' width='180'>",
"<img src='/legsim/img/4.gif' height='18' width='180'>",
"<img src='/legsim/img/5.gif' height='18' width='180'>");
foreach ($q1,$q2,$q3,$q4,$q5,$q6,$q7)
{ $_ = $strings[$_]; }
if ($q1)
{ print "Script Is FUBAR\n\n"; }
if ($q2)
{ print "Script Is FUBAR\n\n"; }
if ($q3 ne "<img src='/legsim/img/5.gif' height='18' width='180'>")
{ print "Script Is FUBAR\n\n"; }
else
{ print "$q3\n"; }
if ($q4)
{ print "Script Is FUBAR\n\n"; }
if ($q5)
{ print "Script Is FUBAR\n\n"; }
if ($q6)
{ print "Script Is FUBAR\n\n"; }
if ($q7)
{ print "Script Is FUBAR\n\n"; }
exit;
PRINTED RESULTS:
________________
Script Is FUBAR
Script Is FUBAR
Script Is FUBAR
Script Is FUBAR
Script Is FUBAR
Script Is FUBAR
Script Is FUBAR
------------------------------
Date: Fri, 20 Jul 2001 20:14:55 -0700
From: "Godzilla!" <godzilla@stomp.stomp.tokyo>
Subject: Re: Repetitive if statements
Message-Id: <3B58F3AF.AB30725F@stomp.stomp.tokyo>
David Marshall wrote:
> OK, for some moderately strong "simplification," supposing that the five
> graphics are 'sd.gif', 'da.gif', 'g3.gif', 'g4.gif', and 'g5.gif'...
> @images = (undef, 'sd.gif', 'da.gif', 'g3.gif', g4.gif', 'g5.gif');
> $tag = q(<img src='/legsim/img/%s' height='18' width='180'>);
> foreach ($q1, $q2, $q3, $q4, $q5, $q6, $q7) {
> ($_ >= 1) && ($_ <= @images) && ($_ = sprintf $tag, $images[$_]);
> }
> But wait!
(snipped)
It is prudent to test code before posting.
Godzilla!
--
TEST SCRIPT:
____________
#!perl
print "Content-type: text/plain\n\n";
$q3 = 5;
@images = (undef, 'sd.gif', 'da.gif', 'g3.gif', g4.gif', 'g5.gif');
$tag = q(<img src='/legsim/img/%s' height='18' width='180'>);
foreach ($q1, $q2, $q3, $q4, $q5, $q6, $q7)
{ ($_ >= 1) && ($_ <= @images) && ($_ = sprintf $tag, $images[$_]); }
if ($q1)
{ print "Script Is FUBAR\n\n"; }
if ($q2)
{ print "Script Is FUBAR\n\n"; }
if ($q3 ne "<img src='/legsim/img/g5.gif' height='18' width='180'>")
{ print "Script Is FUBAR\n\n"; }
else
{ print "$q3\n"; }
if ($q4)
{ print "Script Is FUBAR\n\n"; }
if ($q5)
{ print "Script Is FUBAR\n\n"; }
if ($q6)
{ print "Script Is FUBAR\n\n"; }
if ($q7)
{ print "Script Is FUBAR\n\n"; }
exit;
PRINTED RESULTS:
________________
Bad name after gif' at test1.pl line 7.
------------------------------
Date: Fri, 20 Jul 2001 20:39:26 -0700
From: "Godzilla!" <godzilla@stomp.stomp.tokyo>
Subject: Re: Repetitive if statements
Message-Id: <3B58F96E.AE913D60@stomp.stomp.tokyo>
Brian D. Green wrote:
> I'm trying to write some code that will take the results of a survey and
> translate each of the five possible values of the survey into a different
> graphic. I've figured out something that works, but it seems very
> repetitive and inefficient. Right now, I have it doing:
> if ($q1 == 1) {
> $q1 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> }
> if ($q2 == 1) {
> $q2 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> }
(snipped)
> if ($q7 == 1) {
> $q7 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> }
> if ($q1 == 2) {
> $q1 = "<img src='/legsim/img/da.gif' height='18' width='180'>";
> }
> ...and so on for each of the five values. Could someone suggest how I
> might simplify it?
You have this pretty close to being efficient. I will provide
some advice which will increase your efficiency in ways you
probably don't expect.
Rename your graphics to,
1.gif 2.gif 3.gif 4.gif 5.gif
... and use the value of your "q" variables to create
a path to your graphics. Much easier this way.
For my test script below my signature, you will notice
I deleted your image sizing. Rather than force a resize
via html tags, resize your thumbnails with a graphics
program such as photoshop or paint shop pro, to the
actual size you want; 18 by 180 pixels.
Your method of tag resizing graphics changes the visual
size of your graphics but not the file size. A browser
will still load the full size bytes and produce a scaled
downed visual graphic. This really slows down a browser.
Avoid this. Make "real" thumbnails and full size images
as needed, with a clickable link to a full size. Your
visitors will appreciate this although no word of thanks
will come your way. Don't use tag resizing, it's not good.
This test script of mine is a simple rewrite of your own
method. You do have the right idea. You will discover what
I have done is significantly fast and efficient. Lots of
code yes, but works great compared to other codes.
A cautionary technical note. Be sure those "q" variables
which are not to be used, are null; no value content.
If this is not possible, establish some conditional
to null unused "q" variables or similar to protect
my use of "if (q variable) then do this..." logic.
Rename your graphics as indicated, create true size
thumbnails and use my code or variations upon it,
you will be pleased with results. I have included some
benchmark tests, after repairing another's code, to show
you why you will be pleased.
Never believe these geeks who promulgate shorter code is,
better code.
Godzilla!
--
TEST SCRIPT:
____________
#!perl
print "Content-type: text/plain\n\n";
$q3 = 5;
if ($q1)
{ $q1 = "<img src=\"/legsim/img/$q1.gif\">"; }
if ($q2)
{ $q2 = "<img src=\"/legsim/img/$q2.gif\">"; }
if ($q3)
{ $q3 = "<img src=\"/legsim/img/$q3.gif\">"; }
if ($q4)
{ $q4 = "<img src=\"/legsim/img/$q4.gif\">"; }
if ($q5)
{ $q5 = "<img src=\"/legsim/img/$q5.gif\">"; }
if ($q6)
{ $q6 = "<img src=\"/legsim/img/$q6.gif\">"; }
if ($q7)
{ $q7 = "<img src=\"/legsim/img/$q7.gif\">"; }
print $q3;
exit;
PRINTED RESULTS:
________________
<img src="/legsim/img/5.gif">
BENCHMARK COMPARISON:
_____________________
#!perl
print "Content-type: text/plain\n\n";
use Benchmark;
print "Run One:\n\n";
&Time;
print "\n\nRun Two:\n\n";
&Time;
print "\n\nRun Three:\n\n";
&Time;
sub Time
{
timethese (100000,
{
'name1' =>
'$q3 = 5;
if ($q1)
{ $q1 = "<img src=\"/legsim/img/$q1.gif\">"; }
if ($q2)
{ $q2 = "<img src=\"/legsim/img/$q2.gif\">"; }
if ($q3)
{ $q3 = "<img src=\"/legsim/img/$q3.gif\">"; }
if ($q4)
{ $q4 = "<img src=\"/legsim/img/$q4.gif\">"; }
if ($q5)
{ $q5 = "<img src=\"/legsim/img/$q5.gif\">"; }
if ($q6)
{ $q6 = "<img src=\"/legsim/img/$q6.gif\">"; }
if ($q7)
{ $q7 = "<img src=\"/legsim/img/$q7.gif\">"; }',
'name2' =>
'$q3 = 5;
@images = (undef, "sd.gif", "da.gif", "g3.gif", "g4.gif", "g5.gif");
$tag = q(<img src=/legsim/img/%s height=18 width=180>);
foreach ($q1, $q2, $q3, $q4, $q5, $q6, $q7)
{ ($_ >= 1) && ($_ <= @images) && ($_ = sprintf $tag, $images[$_]); }',
} );
}
exit;
PRINTED RESULTS:
________________
Run One:
Benchmark: timing 100000 iterations of name1, name2...
name1: 1 wallclock secs ( 0.50 usr + 0.00 sys = 0.50 CPU) @ 200000.00/s
name2: 3 wallclock secs ( 3.19 usr + 0.00 sys = 3.19 CPU) @ 31347.96/s
Run Two:
Benchmark: timing 100000 iterations of name1, name2...
name1: 1 wallclock secs ( 0.55 usr + 0.00 sys = 0.55 CPU) @ 181818.18/s
name2: 3 wallclock secs ( 3.24 usr + 0.00 sys = 3.24 CPU) @ 30864.20/s
Run Three:
Benchmark: timing 100000 iterations of name1, name2...
name1: 1 wallclock secs ( 0.55 usr + 0.00 sys = 0.55 CPU) @ 181818.18/s
name2: 3 wallclock secs ( 3.18 usr + 0.00 sys = 3.18 CPU) @ 31446.54/s
------------------------------
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 1346
***************************************
