[18427] in Perl-Users-Digest
Perl-Users Digest, Issue: 595 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Mar 30 09:10:40 2001
Date: Fri, 30 Mar 2001 06:10:24 -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: <985961424-v10-i595@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Fri, 30 Mar 2001 Volume: 10 Number: 595
Today's topics:
Re: perl script to browse web site (Randal L. Schwartz)
Re: perl script to browse web site <gtoomey@usa.net>
Re: PLEASE HELP (0/1) <crt@highvision.net>
Re: Read and write a hash of arrays ? <c_clarkson@hotmail.com>
Re: regex-qr// for search and replace <bart.lateur@skynet.be>
Re: SIGCHLD handler is installed, but never called (Stefan Haller)
Re: SIGCHLD handler is installed, but never called (Anno Siegel)
Re: SIGCHLD handler is installed, but never called (Stefan Haller)
Re: Stripping path info from a filename <wyzelli@yahoo.com>
Re: Stripping path info from a filename <djberge@uswest.com>
Variable scoping/globals issue <gtoomey@usa.net>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 30 Mar 2001 05:27:24 -0800
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: perl script to browse web site
Message-Id: <m14rwbo08z.fsf@halfdome.holdit.com>
>>>>> "Gregory" == Gregory Toomey <gtoomey@usa.net> writes:
Gregory> This question gets asked so often it should be in a faq.
Gregory> The following code fragments get web page and store/send a cookie!!
Gregory> You can use this code to emulate what a browser.
[hard way to use HTTP::Cookies deleted]
Why are people always using HTTP::Cookies the hard way? Hasn't
anyone noticed the LWP::UserAgent method that tells it to use
a cookie jar?
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common;
my $ua = LWP::UserAgent->new;
$ua->cookie_jar(HTTP::Cookies->new(file => 'cookie_jar', autosave => 1));
There... now use $ua as normal. If there are incoming cookies, they'll
be saved to the jar. If a request matches cookies, they'll be added
to the request. Just like a browser. No fuss, No muss.
print "Just another Perl hacker,"
--
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: Fri, 30 Mar 2001 23:36:01 +1000
From: "Gregory Toomey" <gtoomey@usa.net>
Subject: Re: perl script to browse web site
Message-Id: <qM%w6.6124$45.34941@newsfeeds.bigpond.com>
That's a great idea.
I've only been using Perl for a few months, so I'm definitely not a guru .
But this seems to be commonly asked question.
gtoomey
-----------
"Randal L. Schwartz" <merlyn@stonehenge.com> wrote in message
news:m14rwbo08z.fsf@halfdome.holdit.com...
> >>>>> "Gregory" == Gregory Toomey <gtoomey@usa.net> writes:
>
> Gregory> This question gets asked so often it should be in a faq.
> Gregory> The following code fragments get web page and store/send a
cookie!!
> Gregory> You can use this code to emulate what a browser.
> [hard way to use HTTP::Cookies deleted]
>
> Why are people always using HTTP::Cookies the hard way? Hasn't
> anyone noticed the LWP::UserAgent method that tells it to use
> a cookie jar?
>
> use LWP::UserAgent;
> use HTTP::Cookies;
> use HTTP::Request::Common;
>
> my $ua = LWP::UserAgent->new;
> $ua->cookie_jar(HTTP::Cookies->new(file => 'cookie_jar', autosave =>
1));
>
> There... now use $ua as normal. If there are incoming cookies, they'll
> be saved to the jar. If a request matches cookies, they'll be added
> to the request. Just like a browser. No fuss, No muss.
>
> print "Just another Perl hacker,"
>
> --
> 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: Fri, 30 Mar 2001 08:24:51 -0500
From: Casey West <crt@highvision.net>
Subject: Re: PLEASE HELP (0/1)
Message-Id: <Pine.OSF.4.21.0103300824090.25301-100000@home.kiski.net>
On Mar 23 around 5:28pm, Michael Jenneson hammered out this masterpiece:
: I have to get this program working
: it is supposed to read in any number of unix commands
: and pipe them together and execute each command in
: separate processes.
: i cant get it to run
: PLEASE HELP
I don't see any program, perhaps you forget to paste it?
--
Casey West
------------------------------
Date: Fri, 30 Mar 2001 03:53:14 -0600
From: "Charles K. Clarkson" <c_clarkson@hotmail.com>
Subject: Re: Read and write a hash of arrays ?
Message-Id: <7A5B30E0A164015A.398B4C2CB5AE70BD.C8C29CD0CAB087EC@lp.airnews.net>
Rich <bigrich318@yahoo.com> wrote:
:
: "Charles K. Clarkson" <c_clarkson@hotmail.com> wrote:
:
: > Rich <bigrich318@yahoo.com> wrote:
: > :
: > : <u665313720@spawnkill.ip-mobilphone.net> wrote:
: > : > Hi,
: > : <snip>
: > :
: > : use strict;
: > :
: > : my %enzymes_hash;
: > : my $keyword;
: > :
: > : while (<DATA>) {
: > : if (/^(\w+)::$/) { $keyword = $1; next;};
: > : my ($clone, $best_hit_id, $e_value, $percent_ident,
: > : $aln_length, $species, $desc) =
: > : (/^(\w+)\s+(\w+)\s+(.*?)\s+(.*?)\s+(.*?)\s+(.*?\s+.*?)\s+(.*)/);
: > : push(@{$enzymes_hash{$best_hit_id}}, join(" ", ($e_value,
: > : $clone, $best_hit_id, $percent_ident, $aln_length, $species,
: > : $desc)));
: > : }
: >
: > There isn't a need for all those values anymore:
: >
: > while (<DATA>) {
: > if (/^(\w+)::$/) { $keyword = $1; next;};
: > my @arr =
: > (/^(\w+)\s+(\w+)\s+(.*?)\s+(.*?)\s+(.*?)\s+(.*?\s+.*?)\s+(.*)/);
: > push @{$enzymes_hash{$arr[1]}}, join ' ', @arr[2, 0, 1, 3 .. 6];
: > }
:
: There wasn't a need for them in the first place (tmtowtdi). I tried to
: provide a readable solution without changing the op's original script too
: much.
:
: Are you saying that yours is a far more efficient solution (if so, could
: you give an estimate of the milliseconds it saved?) or did you simply want
: to show that you could obfuscate the code a little?
Clarity could easily be maintained with a comment. I have rarely
checked for time savings - do you think it will really matter a lot. It
doesn't seem like it should.
As for obfuscation, I said 'There isn't a need for all those values
anymore'. That's not the same as 'There a need for confusion'.
:
: What if the values were used 600 lines later in the script?
They're lexical variables. They would be out of scope.
:
: Which would be more readable if your job was to maintain the code but you
: didn't write it?
:
: if ($arr[5]) { print "The value is $arr[5]"; }
:
: or
:
: if ($species) { print "The value is $species"; }
The second example seems much more readable to me.
Thanks for asking for my help.
:
: If you want to obfuscate, why not write all of your code like a JAPH sig.
:
:
my($kwd,%enz);while(<DATA>){$kwd=(/^(\w+)::$/)?$1:'';(/^(\w+)\s+(\w+)\s+(.*
: ?)\s+(.*?)\s+(.*?)\s+(.*?\s+.*?)\s+(.*)/)?push@{$enz{$2}},join"
: ",($3,$1,$2,$4,$5,$6,$7):next;}
But, I don't want to obfuscate.
:
: It does the same as the examples above but I'm sure that your clients
: and/or co-workers would be thoroughly impressed with your programming
: skills if you buried it in a couple of thousand lines of similar
: obfuscation.
:
: Thanks, but I'll take readability over obfuscation and micro-efficiency
any
: day.
Does your style guide prohibit comments?
# Here we change the order of the first 3 elements:
# from:
# $clone, $best_hit_id, $e_value,
# to:
# $e_value, $clone, $best_hit_id
HTH,
Charles K. Clarkson
Curiosity was framed. Ignorance killed the cat.
------------------------------
Date: Fri, 30 Mar 2001 10:44:15 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: regex-qr// for search and replace
Message-Id: <9uo8ctk0cn8nv4qcu08vvp8paqu902d87b@4ax.com>
Rick Delaney wrote:
>> In pre-5.6.0, //o and closures don't work too well together.
>
>They still don't. I get
>
>Match for 'foo' with regex 0
>Match for 'foo' with regex 1
>Match for 'fooooo' with regex 0
>Match for 'fooooo' with regex 1
>$ perl -v
>
>This is perl, v5.6.0 built for i686-linux
>
>I also get this for a couple of 5.6.1-TRIAL versions and a 5.7 track
>perl. I have seen it work properly with a particular ActiveState
>version but I don't have it anymore and can't remember which.
>
>Can you post what version of perl gives you the results you got? I'd
>like to track this down and get it fixed in the main perl distribution
>once and for all.
Gee. It works properly in ActivePerl 5.6.0 Build 623 for
MSWin32-x86-multi-thread, compiled on Dec 15 2000, and on IndigoPerl
5.6.0 from Indigostar (<www.indigostar.com>) compiled on May 6 2000.
That isn't too surprising, as IndigoPerl itself isn't a separate port,
but not much more than a recompilation on the official MSWin32 port as
per ActiveState.
It does NOT work properly, i.e. all closure instances share the same
compiled regex shared, on 5.005_03 on FreeBSD.
I'm surprised that there's this relapse.
Could it be in the patches for multi-thread support?
--
Bart.
------------------------------
Date: 30 Mar 2001 13:23:56 +0100
From: hals@babylon.icemark.ch (Stefan Haller)
Subject: Re: SIGCHLD handler is installed, but never called
Message-Id: <slrn9c8q02.88m.hals@babylon.icemark.ch>
Hi again
In article <slrn9c6doc.3e6.hals@babylon.icemark.ch>, Stefan Haller wrote:
>I have some trouble with the SIGCHLD signal handler.
I could not solve the problem yet, but I think that I found the root of
the evil in my program: semaphores...
I will describe my script in some more detail and hope that someone
can tell my, why a SIGTERM interrupts a blocking call on a semaphore,
and a SIGCHLD does not. SIGCHLD do not only not interrupt blocking
calls it seems, the signals are completely ignored and are not risen
after the blocking call has returned.
I'm programming a little daemon script for an FTP application. The daemon
uses two semaphores, one publicly available to signal new tasks to execute
and a second, private one to limit the number of childs. The actual FTP
tasks will be read from the database whenever signalled using the semaphore.
My main function looks something like this (I removed most error handling
code so it does not get too bloated):
eval {
log_debug "Setting effective user id to 'abo'.";
my $abouid = getpwnam('abo');
$> = $abouid;
unless ($> == $abouid) {
die 'Could not set effective user id';
}
log_debug 'Trying to daemonize now.';
setsid();
chdir("/");
open(STDIN, "</dev/null");
open(STDOUT, ">/dev/null");
open(STDERR, ">/dev/null");
fork && exit;
write_pidfile();
log_debug 'Getting private sempahore to control number of children.';
$CHILDREN_SEM = new IPC::Semaphore(IPC_PRIVATE, 1,
IPC_CREAT | S_IRWXU);
log_debug "Limiting number of children to ".$CFG{'transfer_count'};
$CHILDREN_SEM->setval(0, $CFG{'transfer_count'});
log_debug 'Getting signalling semaphore.';
# todo: the permissions are set wrong on the following semaphore
$SIGNAL_SEM = new IPC::Semaphore($CFG{'shared_semaphore'}, 1,
IPC_CREAT | S_IRWXU | S_IRWXG | S_IRWXO);
$SIGNAL_SEM->setval(0,1);
$SIG{CHLD} = \&sig_chld;
$SIG{TERM} = \&sig_term;
log_debug 'Start looping.';
while ($RUNNING) {
connect_db();
eval {
log_debug 'Fetching a list of tasks.';
query_tasks();
my $task;
while ($task = shift @TASKS) {
log_debug "Executing task.";
exec_task($task) if $RUNNING;
}
# disconnect from db because there may have been a
# timeout problem on the db connection in previous
# versions.
disconnect();
log_debug 'Waiting for incoming tasks.';
$SIGNAL_SEM->op(0, -1, 0);
};
if ($@) { #something }
}
};
if ($@) { #something }
Now, most children exit while the daemon is executing the
$SIGNAL_SEM->op(0, -1, 0);
statement, waiting for incoming tasks. If I send a SIGTERM, the sig_term()
function is executed as expected. If I or the daemons children send a
SIGCHLD, they are completely ignored.
Does anyone know how I could fix that?
I would really appreciate any help. Sorry for the long posting.
With kind regards
Stefan
------------------------------
Date: 30 Mar 2001 11:51:40 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: SIGCHLD handler is installed, but never called
Message-Id: <9a1s0c$l90$1@mamenchi.zrz.TU-Berlin.DE>
According to Stefan Haller <hals@mountpoint.ch>:
> Hi Everybody
>
> I have some trouble with the SIGCHLD signal handler.
>
> I got the following snipped of code:
>
> sub sig_term {
> my $signame = shift;
> $RUNNING = 0;
> }
>
> sub sig_chld {
> my $signame = shift;
> my $pid = -1;
No need to preset $pid. "do {} until ..." executes the block
at least once, so $pid will have a value when it is tested.
Further, since you re-declare $pid within the do-block, the
value will not be used anyway.
> do {
> my $pid = waitpid(-1, &WNOHANG);
> $CHILDREN_SEM->op(0, 1, 0) unless $pid == -1;
> # loathe sysV: it makes us not only reinstate
> # the handler, but place it after the wait
> $SIG{CHLD} = \&sig_chld;
> } until $pid == -1;
> }
>
> $SIG{TERM} = \&sig_term;
> $SIG{CHLD} = \&sig_chld;
>
> ...do some forking
>
> I previously used simpler handlers and after consulting the various Perl
> doc sources, I somehow merged them all together into above result.
> The problem is, that the SIGCHLD handler is never called if a child quits.
> It is not called if I do a kill -18 <proc> manually, too.
> If I send a SIGTERM, the sig_term sub is executed as expected.
>
> $CHILDREN_SEM is a semaphore which I use to control the number of parallel
> child processes running.
>
> Does anybody know why my TERM handler works and my CHLD handler doesn't.
>
> I'm working on Solaris 8 using Perl 5.6.0 which I compiled myself:
> $ uname -a
> SunOS blade 5.8 Generic_108528-05 sun4u sparc SUNW,Sun-Blade-1000
> $ perl --version
> This is perl, v5.6.0 built for sun4-solaris
I can't reproduce the behavior you describe on a random solaris system
(SunOS 5.4). The sigchld handler is called all right, but the loop
doesn't end. This is because, unlike other systems, on solaris
waitpid( ... , WNOHANG) can return 0 in certain situations where
other systems return -1. After changing the condition to
"until $pid <= 0" the handler works as expected. (I did not include
the semaphore call, but that shouldn't have anything to do with the
problem.)
Anno
------------------------------
Date: 30 Mar 2001 15:22:02 +0100
From: hals@babylon.icemark.ch (Stefan Haller)
Subject: Re: SIGCHLD handler is installed, but never called
Message-Id: <slrn9c90th.8f3.hals@babylon.icemark.ch>
Hi
In article <9a1s0c$l90$1@mamenchi.zrz.TU-Berlin.DE>, Anno Siegel wrote:
>According to Stefan Haller <hals@mountpoint.ch>:
>> I have some trouble with the SIGCHLD signal handler.
>>
..snip..
>>
>> sub sig_chld {
>> my $signame = shift;
>> my $pid = -1;
>
>No need to preset $pid. "do {} until ..." executes the block
>at least once, so $pid will have a value when it is tested.
>Further, since you re-declare $pid within the do-block, the
>value will not be used anyway.
Oh, thanks. Yes. You are right. I must have been looking at the
code for so long, that I just could not see that.
One line is missing in the function I posted. I send a
syslog message right before the do block which is never
written to the log file. THis is why I think the function
is not even called.
>> do {
>> my $pid = waitpid(-1, &WNOHANG);
>> $CHILDREN_SEM->op(0, 1, 0) unless $pid == -1;
>> # loathe sysV: it makes us not only reinstate
>> # the handler, but place it after the wait
>> $SIG{CHLD} = \&sig_chld;
>> } until $pid == -1;
>> }
>>
>> $SIG{TERM} = \&sig_term;
>> $SIG{CHLD} = \&sig_chld;
>>
>> ...do some forking
>>
..snip..
>
>I can't reproduce the behavior you describe on a random solaris system
>(SunOS 5.4). The sigchld handler is called all right, but the loop
>doesn't end. This is because, unlike other systems, on solaris
>waitpid( ... , WNOHANG) can return 0 in certain situations where
>other systems return -1. After changing the condition to
>"until $pid <= 0" the handler works as expected. (I did not include
>the semaphore call, but that shouldn't have anything to do with the
>problem.)
Thanks for the tip. I changed my code accordingly. Unfortunately,
the problems still persisted. I described it in another posting
I made to this thread an hour ago.
I was a bit fast with my suspicion in this respective posting
that the semaphore code is the problem. After some more commenting
in and out, I found out that its the database driver.
I am using:
DBI-1.14
DBD-Oracle-1.06
The DBI pod says:
The two most common uses of signals in relation to the DBI
are for canceling operations when the user types Ctrl-C
(interrupt), and for implementing a timeout using `alarm()'
and `$SIG{ALRM}'.
To assist in implementing these operations, the DBI provides
a `cancel' method for statement handles. The `cancel' method
should abort the current operation and is designed to be
called from a signal handler.
However, it must be stressed that: a) few drivers implement
this at the moment (the DBI provides a default method that
just returns `undef'); and b) even if implemented, there is
still a possibility that the statement handle, and possibly
the parent database handle, will not be usable afterwards.
Now, as I found out that after a connect() to the database,
either DBI or DBD::Oracle installs a new signal handler (or
SIG_IGN) for SIGCHLD.
My solution is now that I just install mine after each connect()
again. And now everything works.
Maybe I should not have chosen Perl to implement a daemon because
it is not signal safe. Unfortunately, I did not know that when we
choose Perl over C++ for our application. I think as long as Perl
is not signal-safe, it is nearly completely unusable for most
daemon tasks.
I will now hope and pray that there won't be too many problems
with it and I am seriously considering porting the application to
C++; without DBI then, with which I previously only made very
good experiences. I hope that there will be soon a Perl version
that is signal-safe. Keep up the good work.
Thank you for your time and help.
Stefan
------------------------------
Date: Fri, 30 Mar 2001 21:56:37 +0930
From: "Wyzelli" <wyzelli@yahoo.com>
Subject: Re: Stripping path info from a filename
Message-Id: <0X_w6.3$g32.1868@vic.nntp.telstra.net>
"Rhugga" <rhugga@yahoo.com> wrote in message
news:pn47ctopmqo687e6rk6qc5vnvksbmkcgf1@4ax.com...
>
>
>
> What is the easiest way to strip the path leading to a file name,
> regardless of how many directories it contins?
>
> ex.
>
> /some/long/path/somefile.txt
>
> I want a variable to contain only somefile.txt
>
my ($path, $file) = '/some/long/path/somefile.txt' =~ m|(.*/)(.*)|;
Wyzelli
--
#Modified from the original by Jim Menard
for(reverse(1..100)){$s=($_==1)? '':'s';print"$_ bottle$s of beer on the
wall,\n";
print"$_ bottle$s of beer,\nTake one down, pass it around,\n";
$_--;$s=($_==1)?'':'s';print"$_ bottle$s of beer on the
wall\n\n";}print'*burp*';
------------------------------
Date: Fri, 30 Mar 2001 07:47:01 -0600
From: Mr. SunRay <djberge@uswest.com>
Subject: Re: Stripping path info from a filename
Message-Id: <q70x6.25$O17.87574@news.uswest.net>
> What is the easiest way to strip the path leading to a file name,
> regardless of how many directories it contins?
>
> ex.
>
> /some/long/path/somefile.txt
>
> I want a variable to contain only somefile.txt
Please see the File::Basename module.
Dan
------------------------------
Date: Fri, 30 Mar 2001 23:46:30 +1000
From: "Gregory Toomey" <gtoomey@usa.net>
Subject: Variable scoping/globals issue
Message-Id: <fW%w6.6128$45.34652@newsfeeds.bigpond.com>
Hi everyone.
I've been writing lots of Perl scripts (*.pl) for an application.
I'm using 'use strict', so I'm forced to use 'my' to declare variables and
make them locally scoped in the script.
Is there a safe way to export variable from a .pl script?
Variables can be exported from packages but this seems overkill for what I'm
doing.
gtoomey
------------------------------
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 595
**************************************
