[23291] in Perl-Users-Digest
Perl-Users Digest, Issue: 5511 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Sep 16 11:05:55 2003
Date: Tue, 16 Sep 2003 08:05:08 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 16 Sep 2003 Volume: 10 Number: 5511
Today's topics:
backtracking in regular expression matching (ccwork)
Re: backtracking in regular expression matching (Sam Holden)
Re: backtracking in regular expression matching <thens@NOSPAMti.com>
Re: boston perl classes with damian conway (Chris Marshall)
Re: boston perl classes with damian conway <uri@stemsystems.com>
Re: CGI: Help with "loading" message while processing. (Tom)
Re: Crypt::SSLeay <ama@PW.CA>
Re: Crypt::SSLeay <ama@PW.CA>
Re: date sorting module (Tad McClellan)
Hash dereferencing and object-oriented Perl <stefan@unfunked.org>
Re: Hash dereferencing and object-oriented Perl <uri@stemsystems.com>
Re: kill command in a perl script (Hugh Kang)
More on 5.8 and signals <eric@dmcontact.com>
open (RES, "/usr/bin/top -bs -n 1 |"); (Sandrine CHEN)
Re: open (RES, "/usr/bin/top -bs -n 1 |"); (Anno Siegel)
Re: open (RES, "/usr/bin/top -bs -n 1 |"); <grazz@pobox.com>
Re: Sort a hash based on values in the hash stored as a (Anno Siegel)
Re: Subtracting arrays of floats. (Anno Siegel)
Re: Subtracting arrays of floats. (Anno Siegel)
Re: Subtracting arrays of floats. <dzluk8fsxsw0001@sneakemail.com>
Re: Subtracting arrays of floats. <tassilo.parseval@rwth-aachen.de>
Re: <bwalton@rochester.rr.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 16 Sep 2003 03:14:01 -0700
From: ccwork@hotmail.com (ccwork)
Subject: backtracking in regular expression matching
Message-Id: <d0120dc8.0309160214.80fc142@posting.google.com>
Hi,
For the pattern "(((.*)cd)*)*cdcd" and string "ababcdcdcdef", can
anyone tell me the detail meachanism of backtracking? This regular
expression have two level of backtracking, the "((.*)cd)*" and
"(((.*)cd)*)*", so which one take precedence?
Thanks.
------------------------------
Date: 16 Sep 2003 10:38:05 GMT
From: sholden@flexal.cs.usyd.edu.au (Sam Holden)
Subject: Re: backtracking in regular expression matching
Message-Id: <slrnbmdq0c.n5a.sholden@flexal.cs.usyd.edu.au>
On 16 Sep 2003 03:14:01 -0700, ccwork <ccwork@hotmail.com> wrote:
> Hi,
> For the pattern "(((.*)cd)*)*cdcd" and string "ababcdcdcdef", can
> anyone tell me the detail meachanism of backtracking? This regular
> expression have two level of backtracking, the "((.*)cd)*" and
> "(((.*)cd)*)*", so which one take precedence?
Matching occurs starting at the left, each "element" being greedy (unless
specified otherwise with ?). Backtracking occurs when a match fails.
You have a '**' construct in the regex which will cause *large* amounts
of backtracking, since it leads to *lots* of ways of matching the same
string (even worse there's a .* inside that as well).
But it works from the left greedily, at each step. With backtracking
occuring when some part of the expression can't match. The backtracking
causes the previous greedy expression to match fewer characters (with
non-greedy expressions it would match more...).
--
Sam Holden
------------------------------
Date: Tue, 16 Sep 2003 17:40:54 +0530
From: Thens <thens@NOSPAMti.com>
Subject: Re: backtracking in regular expression matching
Message-Id: <20030916174054.5c20a7b0.thens@NOSPAMti.com>
On 16 Sep 2003 03:14:01 -0700
ccwork@hotmail.com (ccwork) wrote:
# Hi,
# For the pattern "(((.*)cd)*)*cdcd" and string "ababcdcdcdef", can
# anyone tell me the detail meachanism of backtracking? This regular
# expression have two level of backtracking, the "((.*)cd)*" and
# "(((.*)cd)*)*", so which one take precedence?
You can use the 're' module to throw some more debug information to
you.
use re qw /debug/;
-- or --
use re qw /debugcolor/; # same with colored output
see perldoc re for more details.
Regards,
Thens.
------------------------------
Date: 16 Sep 2003 04:58:06 -0700
From: c_j_marshall@hotmail.com (Chris Marshall)
Subject: Re: boston perl classes with damian conway
Message-Id: <cb9c7b76.0309160358.296c170d@posting.google.com>
Uri Guttman <uri@stemsystems.com> wrote in message news:<x7llsp2w17.fsf@mail.sysarch.com>...
> damian conway will be teaching these classes in boston:
>
Any chance he'll ever come to London ?
------------------------------
Date: Tue, 16 Sep 2003 14:42:41 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: boston perl classes with damian conway
Message-Id: <x73cew3icj.fsf@mail.sysarch.com>
>>>>> "A" == Abigail <abigail@abigail.nl> writes:
A> $$ Instead of regulars killfiling each other (which is a bad thing
A> for this $$ group IMHO), maybe announcements like this should be
A> flagged as such by $$ adding [ANN] or whatever to the
A> subject. Thus, people could killfile on $$ subjects instead of
A> plonking the poster.
A> No need for [ANN], given that there is a comp.lang.perl.announce
A> newsgroup. So, beside spam, it was off-topic as well.
c.l.p.announce is moderated so i can't post it there. and abigail isn't
going to take these classes anyway. as for all those sites and lists, i
can't imagine how many abigail is on since it was only announced on
use.perl.org and perlmonks.org and local perl monger lists. so she is
overreacting in her expected style. i can live with the plonking. :)
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
Damian Conway Class in Boston - Sept 2003 -- http://www.stemsystems.com/class
------------------------------
Date: 16 Sep 2003 06:28:57 -0700
From: tom@ztml.com (Tom)
Subject: Re: CGI: Help with "loading" message while processing.
Message-Id: <59b4279a.0309160528.51e9bca2@posting.google.com>
twistdpair@hotmail.com (corky) wrote in message news:<e2d5abce.0309151249.792a8e06@posting.google.com>...
> Using Perl 5.6.0. I need to temporarily show a message while I process
> in the background. The process calls an OLE component which sets a
> value in the user's cookie.
>
> The DisplaySecSubmit sub calls my "please wait" page which is static.
> The GetSecureModels sub runs the OLE process and sets the cookie.
> The DisplaySubmit sub displays a new page which uses the cookie which
> was just set.
>
> Here is where it starts:
>
> elsif ($FORM{'FUNC'} eq 'DISP_SEC_SUBMIT')
> {&RightViolation($CREATE_RIGHT) if (($createRight == 0) &&
> ($a_createRight == 0));
> &DisplaySecSubmit();
> &GetSecureModels();
> &DisplaySubmit();
> }
>
> use Win32::OLE;
> use DBI;
> use DBD::ODBC;
>
>
> sub GetSecureModels{
> if (length($trainedOn) < 1){
> $dbh = DBI->connect("dbi:ODBC:support", exsu, exsupwd)|| die "Can't
> connect !!: $DBI::errstr";
> $dbh -> {RaiseError} = 1;
> $stmt = "SELECT DISTINCT CTI_MODEL, MODEL FROM MODEL_LOOKUP WHERE
> STATUS = 'ACTIVE' AND CLASS_FAMILY IN (SELECT DISTINCT FAMILY FROM
> MODEL_FAMILY) ORDER BY MODEL;";
> $sth = $dbh->prepare($stmt)|| die "Error on prepare $DBI::errstr";
> $sth->execute()|| die "Error on Execute $DBI::errstr";
> while (@row = $sth->fetchrow_array) {
> my $server = Win32::OLE->new('auth.caller','Quit');
> $server->{Model} = $row[0];
> $server->{NSSGID} = $userID;
> my $trainstat = $server->{Verify};
> if ($trainstat ne -1 ) {
> push @trainedOn , $row[1];
> }
> }
> $trainedOn = join ',', @trainedOn;
> print "Content-type: text/html; charset=utf-8\n";
> &SetCompressedCookies('MODELS','trainedOn', $trainedOn);
> print "\n";
> }
> }
>
>
> sub DisplaySecSubmit{
> &set_submit_strings();
> &EchoFile($HTML_PATH, "traincheck.htm");
> }
>
> My problem is that it seems as though each individual CGI call will
> only return a single page of output. For example, I show my "please
> wait" message while I'm processing and when processing is done the
> results are appended to the "please wait" message instead of replacing
> it.
>
> Another problem is that the cookie stuff shows in the browser too.
>
> Is there any way to flush or start with a clear screen? Can I run the
> process on a different thread? Can I use refreshes to handle this? Or
> should I use a combination of approaches?
You can open multiple windows by simply including a JavaScript open
function in you HTML document. For example, when you submit the query
using the input form generated by the code below, the browser will
open a new window with your messages.
#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);
print header("text/html");
if(param("DISP_SEC_SUBMIT"))
{
&DisplaySecSubmit();
&GetSecureModels();
exit;
}
my $script = "form.cgi";
print <<FORM;
</head><body onUnload='javascript:msg.window.close()'>
<script language='JavaScript'>
function wait()
{
msg = window.open("","msg","width=600,height=150");
msg.document.open("text/html");
msg.document.write("Please wait...");
return true;
}
var msg;
</script>
<h3>FORM TITLE...</h3>
<form method=post action=$script onSubmit='return wait()'>
<table><tr><th>SecureModels:<td><input name='DISP_SEC_SUBMIT'
value='SecureModels value...'>
<tr><td><input type=submit></table></form>
FORM
sub DisplaySecSubmit
{
print "DisplaySecSubmit...<p>";
my $trainedOn = "SELECT DISTINCT...";
&SetCompressedCookies('MODELS','trainedOn', $trainedOn);
sleep(2);
print "\n";
}
sub SetCompressedCookies
{
print "SetCompressedCookies...<p>ARGUMENTS: @_";
sleep(2);
}
sub GetSecureModels
{
print "<hr>GetSecureModels...<p>";
}
> I only use Perl once a year or so as necessary, and as a consequence
> this may be a simple problem with a simple answer, so please forgive
> me.
>
As you can see, the above solution is more of JavaScript than PERL. So
any follow-up should be directed to the appropriated group such as
comp.lang.javascript.
Tom
Ztml.com
------------------------------
Date: Tue, 16 Sep 2003 08:50:50 -0400
From: "A. Ma" <ama@PW.CA>
Subject: Re: Crypt::SSLeay
Message-Id: <bk70vn$er66@shark.pwgsc.gc.ca>
That's where I first looked but could not find the file to download.
ActiveState says that the module passed the test but the repository does not
contain the PPD file. 'Sisyphus' suggested http://theoryx5.uwinnipeg.ca/. I
will try it today.
A.Ma
"Vlad Tepes" <minceme@start.no> wrote in message
news:bk59gp$t3q$1@troll.powertech.no...
> A. Ma <ama@PW.CA> wrote:
>
> > I am tryping to get Crypt::SSLeay to run under Windows. From CPAN, the
> > documentation says that Activestate has a compiled version available
> > already. Yet I cannot locate it when I went to Activestate. Does anyone
know
> > where I can find one? (The documentation from CPAN implied that
compiling
> > the module yourself is very problematic. That's why they suggested
getting
> > the PPM version from Activestate.)
>
>
> http://ppm.activestate.com
>
> Cheers,
> --
> Vlad
------------------------------
Date: Tue, 16 Sep 2003 09:27:32 -0400
From: "A. Ma" <ama@PW.CA>
Subject: Re: Crypt::SSLeay
Message-Id: <bk734h$er74@shark.pwgsc.gc.ca>
I just tried it. It works. Thank you so much.
A.Ma
>
> If you can't find it at AS, get it from http://theoryx5.uwinnipeg.ca/
>
> For perl 5.6:
> ppm install http://theoryx5.uwinnipeg.ca/ppmpackages/Crypt-SSLeay.ppd
>
> For perl 5.8
> ppm install http://theoryx5.uwinnipeg.ca/ppms/Crypt-SSLeay.ppd
>
> Cheers,
> Rob
>
------------------------------
Date: Tue, 16 Sep 2003 07:20:32 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: date sorting module
Message-Id: <slrnbme00g.37h.tadmc@magna.augustmail.com>
Sam <samj@austarmetro.com.au> wrote:
> I just came from cpan, after doing some searches and before I get a module,
> wanted to ask if any one out there knows of a module that takes an array of
> dates and sort them regardless of the date formate.
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
You can't.
How can you distinguish between these two formats for instance:
09-07-2003 # MM-DD-YYY - September 7
and
09-07-2003 # DD-MM-YYY - July 9
??
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Tue, 16 Sep 2003 15:42:03 +0100
From: Stefan <stefan@unfunked.org>
Subject: Hash dereferencing and object-oriented Perl
Message-Id: <bk77fs$iu7$1@news8.svr.pol.co.uk>
Hi...
For I while now I have been coding OO Perl using the $self->{member}
syntax to grab elements out of my blessed hash reference. This works
just fine, however it recently occurred to me that since $self is always
a simple scalar variable (containing a reference), I could just use the
$$self{member} syntax instead. Personally, I find this easier to deal
with - it's one character less to type and occasionally I find it useful
to use @$self{member1, member2}, something which I still haven't figured
out how to do with ->.
So my question... is there anything wrong with using this syntax? The
only reason I ask is that I have never seen an OO Perl module which uses
it... everyone seems to use the $self->{member} version. Sorry if I'm
being and idiot and missing something blatantly obvious!
Thanks
Stefan
------------------------------
Date: Tue, 16 Sep 2003 14:56:53 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: Hash dereferencing and object-oriented Perl
Message-Id: <x7znh4234a.fsf@mail.sysarch.com>
>>>>> "S" == Stefan <stefan@unfunked.org> writes:
S> Hi... For I while now I have been coding OO Perl using the
S> $self->{member} syntax to grab elements out of my blessed hash
S> reference. This works just fine, however it recently occurred to me
S> that since $self is always a simple scalar variable (containing a
S> reference), I could just use the $$self{member} syntax
S> instead. Personally, I find this easier to deal with - it's one
S> character less to type and occasionally I find it useful to use
S> @$self{member1, member2}, something which I still haven't figured
S> out how to do with ->.
S> So my question... is there anything wrong with using this syntax?
S> The only reason I ask is that I have never seen an OO Perl module
S> which uses it... everyone seems to use the $self->{member}
S> version. Sorry if I'm being and idiot and missing something
S> blatantly obvious!
first off, the way you dereference a hash ref (or any ref) has nothing
to do with OO perl. OO perl uses refs but you can use refs anywhere you
want without any OO code at all.
the main way to dereference is to put the proper sigil in front of the
ref value like %{$href} or ${$href}{$key}. but most (not you it seems)
find the latter hard to visually parse and larry gave us the syntactic
sugar of -> thus allowing $href->{$key}. it is your choice as to which
deref style to use but the vast majority use -> when accessing single
elements from array or hash refs.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
Damian Conway Class in Boston - Sept 2003 -- http://www.stemsystems.com/class
------------------------------
Date: 16 Sep 2003 06:47:30 -0700
From: skang@leaguedata.com (Hugh Kang)
Subject: Re: kill command in a perl script
Message-Id: <257137ea.0309160547.3d14a032@posting.google.com>
Jim Gibson <jgibson@mail.arc.nasa.gov> wrote in message news:<150920031752553144%jgibson@mail.arc.nasa.gov>...
> In article <257137ea.0309150913.11f08d49@posting.google.com>, Hugh Kang
> <skang@leaguedata.com> wrote:
>
> > I just started learning Perl and I am trying to do followings;
> >
> > ps -ef | grep java >pidfile
> > In pidfile, there are 3 PIDs for weblogic processes.
> >
> > root 1769 1758 TS 0 0 17:55:26 vt02 44:38
> > /opt/java2-1.3.1/bin/./../bin/x86at/native_threads/java -Xms512m
> > -Xmx512m -Dweb
> > root 27464 27453 TS 29 0 09:15:55 vt04 91:55
> > /opt/java2-1.3.1/bin/./../bin/x86at/native_threads/java -Xms1024m
> > -Xmx1024m -Dw
> > root 27533 27522 TS 49 0 09:21:45 vt03 2:35
> > /opt/java2-1.3.1/bin/./../bin/x86at/native_threads/java -Xms32m
> > -Xmx200m -Dwebl
> >
> > What I want is get the largest PID which is 27533 in this case, and
> > then
> > kill -3 the PID.
> >
> > So I made a simple one for this:
> >
> > #!/usr/bin/perl
> > #
> > # This is a test script to get wls managed server pid
> > #
> > #
> > open(JAVAPIDS,"pidfile") or die "can't open input file:$!\n";
> > $pidcnt=0;
> > while($line=<JAVAPIDS>) {
> > #
> > ($user,$pid1,$pid2,$it4,$it5,$it6,$it7,$it8,$it9,$it10,$it11,$it12,$it13,$it14,
> > $it15)=split("
> > ",$line);
>
> The above line is unnecessary because of the following line.
>
> > ($user,$pid1)=split(" ",$line);
> > $pidfile{$pid1}=$pid1;
> > $pid_comp[$pidcnt]=$pidfile{$pid1};
> > # print "pid$pidcnt : $pid_comp[$pidcnt] \n";
> > if ($pidcnt gt 0) {
> > if ($pid_comp[0] < $pid_comp[$pidcnt]) {
> > $pid_comp[0] = $pid_comp[$pidcnt];
> > }
> > }
> > $pidcnt++;
> >
> > }
> > print "pidcnt : $pidcnt \n";
> > print "Largest PID for java is : $pid_comp[0] \n";
> >
> > ------------------------------------------
> >
> > Q1) How do I do 'kill -3 $pid_comp[0] in this script?
>
> kill 3, $pid_comp[0]
>
> See 'perldoc -f kill'
>
> > Q2) Is there any way that I can do the followings:
> >
> > In a Unix script,
> >
> > ps -ef |grep java >pidfile
> >
> > ./perl_script
> > ...
> > ...
> > kill -3 $pid_comp[0]
>
> Not easily, and not necessary because of answer to 1.
>
> >
> >
> > Q3) Any other way to get what I want?
>
> Yes. You can get the filtered output of the ps command using backtics:
>
> [tested in part ("No processes were actually killed in the development
> of this program")]
>
> #!/opt/perl/bin/perl
>
> use strict;
> use warnings;
>
> my @lines = `ps -ef|grep java`; # <--notice backtics, not single quotes
> my @pids = ();
> foreach ( @lines) {
> my ($user,$pid) = split;
> push(@pids,$pid);
> }
> my $largest = ((sort(@pids)))[$#pids];
> kill 3, $largest;
>
> [end program]
>
> >
> >
> > Can anyone help me out with this issue please?
>
> Hope I have.
>
> >
> > Many thanks in advance!
> >
> > Hugh
Thanks a lot. I have three more things to ask please.
q1) When I do my @lines = `ps -ef | grep java`;, pid for "grep java" from ps -ef
is included in @lines. I'd like to exclude this one. How do I do that?
When I do, ps -ef | grep java > pidfile on Unix shell, I don't see the pid
for 'grep java' in pidfile.
q2) Later I'd like to check the 11th column which can be "-Xms1024m" and issue
kill -3 $pid if it is "-Xms1024m". How do I check it using the above script?
q3) kill -3 $pid is not killing the process. It makes a thread dump for weblogic
server. In Unix script, I check an error from log file and want to take a
thread dump using the perl script when the error occurs. How can I run the perl
script in Unix script? Or any other way to do this?
I just ordered Perl manuals to study and practice more.
Thanks again.
Hugh
------------------------------
Date: Tue, 16 Sep 2003 14:46:12 GMT
From: Eric Frazier <eric@dmcontact.com>
Subject: More on 5.8 and signals
Message-Id: <3F66F3AB.403BF63E@dmcontact.com>
Hi,
I am pretty desparate to get this working, and if anyone wants to earn
some cash helping me fix things PLEASE call me at 250 655-9513.
Thanks to a guy on comp.lang.perl.misc I know that there is a change in
how signals are handled, they call it deferred signal handling because
Perl now is suppose to wait until the Interpeter is in a safe state. As
I understand it this might avoid some things like core dumps or other
errors related to dieing while trying to do something besides dieing.
The thing is somehow this ends up killing off my parent process, just
like in this post:
http://www.mail-archive.com/beginners@perl.org/msg43989.html
So this is happening to me as well, however the guy in the above example
had his problem solved by using Errno and looking for EINTR if that
error is raised then catch it and move on. This isn't working for me, or
else I don't know how to use the advice I was given about it.
I did get one maybe helpfull thing from my log:
Erro was %! --------
./franken_socket.pl 8607: got - CHLD
at Tue Sep 16 02:17:42 2003
I got forked
./franken_socket.pl 8599: begat 8607 at Tue Sep 16 02:17:40 2003
begat 8607
./franken_socket.pl 8599: got - CHLD
at Tue Sep 16 02:17:54 2003
./franken_socket.pl 8599: main 8607 -- reaped 1 at Tue Sep 16 02:17:54
2003
reaped 1Erro was No child processes %! --------
So it looks like the parent got killed on that error "No child process"
This code works just fine on 5.6 since it is about 150% from examples :)
The above is the result of connecting, doing a "who", and doing "dienow"
to test the alarm.
I also found this:
http://archive.develooper.com/macosx@perl.org/msg03022.html
Which totaly describes my problem as well, but shows it happening with
perl 5.8.1..
>I'd imagine that your accept() isn't being restarted. How does it work
>if you change the loop to look like this?
> use Errno;
> while (1) {
> my $client = $server->accept or do {
> next if $!{EINTR};
> last;
> };
> spawn(\&function, "whatever");
> }
#!/usr/bin/perl -w
## new frankenstein!
use strict;
use POSIX ();
use POSIX 'WNOHANG';
use Errno;
use IO::Socket;
use FindBin ();
use File::Basename ();
use File::Spec::Functions;
use Net::hostent;
use Carp;
$|=1;
my $pid;
open (DIED, ">>/var/log/daemon_log") or warn "$!";
sub logmsg { print DIED "$0 $$: @_ at ", scalar localtime, "\n" }
my $listen_socket = IO::Socket::INET->new(LocalPort => 1081,
LocalAddr => '127.0.0.1',
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1 )
or die "can make a tcp server on port 1080 $!";
# make the daemon cross-platform, so exec always calls the script
# itself with the right path, no matter how the script was invoked.
my $script = File::Basename::basename($0);
my $SELF = catfile $FindBin::Bin, $script;
# POSIX unmasks the sigprocmask properly
my $sigset = POSIX::SigSet->new();
my $action = POSIX::SigAction->new('sigHUP_handler',
$sigset,
&POSIX::SA_NODEFER);
my $action_alrm = POSIX::SigAction->new('sigALRM_handler',
$sigset,
&POSIX::SA_NODEFER);
POSIX::sigaction(&POSIX::SIGHUP, $action);
POSIX::sigaction(&POSIX::SIGALRM, $action_alrm);
sub sigHUP_handler {
print "got SIGHUP\n";
exec($SELF, @ARGV) or die "Couldn't restart: $!\n";
}
sub sigALRM_handler {
print "got ALARM timeout\n";
}
$SIG{CHLD} = \&REAPER_NEW;
sub REAPER {
$SIG{CHLD} = \&REAPER; # loathe sysV
my $waitedpid = wait;
logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}
sub REAPER_NEW {
logmsg "got - @_\n";
my $wpid = undef;
while ($wpid = waitpid(-1,WNOHANG)>0) {
logmsg "main $pid -- reaped $wpid" . ($? ? " with exit
$?" : '')
;
print DIED "reaped $wpid" . ($? ? " with exit $?" : '');
}
}
print "PID: $$\n";
print "ARGV: @ARGV\n";
print "[Server $0 accepting clients]\n";
#while (my $connection = $listen_socket->accept()) {
while (1) {
my $connection = $listen_socket->accept() or do {
next if $!{EINTR};
last;
};
print DIED "Erro was $! %! --------\n";
$connection->autoflush(1); ## missing seemed to cause client problem,
but not telnet
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
}elsif ($pid) {
logmsg "begat $pid";
print DIED "begat $pid\n";
}else{
# else i'm the child -- go spawn
print $connection "Command?";
while ( <$connection> ){
my $return_value = undef;
if (/quit|exit/i) {
last; }
elsif (/closeme/i )
{$connection->close(); }
elsif (/date|time/i) { printf $connection "%s\n",
scalar localtime; }
elsif (/who/i ) { print $connection `who
2>&1`;}
elsif (/dienow/i ) { alarm 2; }
elsif (/dieT/i ) {
die; }
#REAPER_NEW($pid) if $return_value;
print $connection "Command?";
print DIED "I got forked\n";
}
exit(0);
#STDIN->fdopen($connection,"r") || die "can't dup client to
stdin";
#STDOUT->fdopen($connection,"w") || die "can't dup client to
stdout"
;
#STDERR->fdopen($connection,"w") || die "can't dup stdout to
stderr";
### FORKed code here..
} ## end while <$connection>
} ## end else
close ($listen_socket);
------------------------------
Date: 16 Sep 2003 05:49:28 -0700
From: sandrinechen@hotmail.com (Sandrine CHEN)
Subject: open (RES, "/usr/bin/top -bs -n 1 |");
Message-Id: <ae32ff57.0309160449.4b3d1f25@posting.google.com>
Thank you to tell me why:
I have one program like following, it could display results on HTML
page on one machine, but not on another which has the same kernel of
2.4.18-3, Redhat Linux, I star to wonder is it that i haven't written
the program in a way more popular, or there is other point that i need
to check or take care?
What's more, on the same machine(that result couldn't display), if i
run the script manually under command line, it couldn't display
results. :( Why!
____________________________________________
#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
print "<html>\n";
print "<test of result>";
print "<body>";
open (RES, "/usr/bin/top -bs -n 1 |");
while (<RES>) {
print $_,"<br>";
}
close RES;
print "</body>";
____________________________________________
thank u very much...
print "</html>";
------------------------------
Date: 16 Sep 2003 13:28:32 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: open (RES, "/usr/bin/top -bs -n 1 |");
Message-Id: <bk7360$ksd$2@mamenchi.zrz.TU-Berlin.DE>
Sandrine CHEN <sandrinechen@hotmail.com> wrote in comp.lang.perl.misc:
> Thank you to tell me why:
>
> I have one program like following, it could display results on HTML
> page on one machine, but not on another which has the same kernel of
> 2.4.18-3, Redhat Linux, I star to wonder is it that i haven't written
> the program in a way more popular, or there is other point that i need
> to check or take care?
>
> What's more, on the same machine(that result couldn't display), if i
> run the script manually under command line, it couldn't display
> results. :( Why!
So obviously there is a difference between the two machines.
What does it mean when you say "couldn't display results"? Does the
program show no output at all? Does it show part of the expected
output, and if so, where does it stop. Does the program finish normally,
finish with a return code, or not finish at all (hang)?
Without you telling us more, there is no chance of guessing what the
difference may be.
> ____________________________________________
> #!/usr/bin/perl -w
>
> print "Content-type: text/html\n\n";
> print "<html>\n";
> print "<test of result>";
> print "<body>";
>
> open (RES, "/usr/bin/top -bs -n 1 |");
You should check the return value of open(). That may give you
a first hint.
> while (<RES>) {
> print $_,"<br>";
> }
> close RES;
>
> print "</body>";
> ____________________________________________
>
> thank u very much...
> print "</html>";
Anno
------------------------------
Date: Tue, 16 Sep 2003 13:44:14 GMT
From: Steve Grazzini <grazz@pobox.com>
Subject: Re: open (RES, "/usr/bin/top -bs -n 1 |");
Message-Id: <OsE9b.4$U6.2@nwrdny03.gnilink.net>
Sandrine CHEN <sandrinechen@hotmail.com> wrote:
>
> open (RES, "/usr/bin/top -bs -n 1 |");
> while (<RES>) {
> print $_,"<br>";
> }
> close RES;
>
The error-checking for piped open works like this:
#
# open can also fail on fork(), pipe() or exec()
#
open my $top, '-|', qw(/usr/bin/top -bs -n 1)
or die "Couldn't start top: $!";
print while <$top>;
#
# close also fails if wait() yields nonzero exit status
#
close($top) or die "close: ", $! || $?;
Without any error checks, of course you don't know what went wrong.
If the open() fails, then perl will give you the right error. If
"top" is failing and you want to capture the diagnostic (i.e. not just
the wait() status) use IPC::Open3 to catch its stderr.
--
Steve
------------------------------
Date: 16 Sep 2003 10:14:51 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Sort a hash based on values in the hash stored as arrays of hashes
Message-Id: <bk6nqr$dff$1@mamenchi.zrz.TU-Berlin.DE>
Tore Aursand <tore@aursand.no> wrote in comp.lang.perl.misc:
> Hmm. I'm not quite sure if I got the subject right, but I'll try to
> explain. :-)
>
> I've got a hash of elements stored like this:
>
> $VAR1 = {
> 'element_id' => '8',
> 'elementtype_id' => '3',
> 'children' => [],
> 'parents' => [
> {
> 'position' => '5',
> 'parent_id' => '3'
> },
> {
> 'position' => '3',
> 'parent_id' => '11'
> }
> ]
> };
>
> Records like the one above is stored in a hash (called %hierarchy), with
> the 'element_id' as key (yeah, I want that value in the hash itself, too).
>
> The problem: Each element can have more than one parent (as illustrated
> above), a parent with a position assigned to it. The element above will
> exist two places in the hierarchy, as you might figure.
I don't follow. If the elements are stored under their element_id, there
*can* only be one element with id 8 in the hash. How can it exist in two
places?
> How should I proceed when I want to sort this hash? I want to sort it by
> 'parent_id', then 'position'.
Since an element can have multiple parents, which parent-id and position
are you going to sort by? Can an element also have no parents?
Anno
------------------------------
Date: 16 Sep 2003 12:26:00 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Subtracting arrays of floats.
Message-Id: <bk6vgo$j50$1@mamenchi.zrz.TU-Berlin.DE>
Jonas Nilsson <dzluk8fsxsw0001@sneakemail.com> wrote in comp.lang.perl.misc:
> Hello.
> I have an optimization problem.
>
> I have two arrays of floats (millions of items in each). I need the absolut
> sum of each pairwise difference.
That looks like a problem for the Perl Data Language, available as
PDL from CPAN. I can't offer an immediate solution -- I never got
around to using PDL myself -- but that's the kind of problem it was
designed for.
An individual XS solution, as Tassilo suggests in another reply may
be the absolute fastest one attainable. If you use the Inline module,
it doesn't have to look quite as formidable. See my followup to
Tassilo's post.
[useful explanation of problem snipped]
Anno
------------------------------
Date: 16 Sep 2003 13:11:58 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Subtracting arrays of floats.
Message-Id: <bk726u$ksd$1@mamenchi.zrz.TU-Berlin.DE>
Tassilo v. Parseval <tassilo.parseval@post.rwth-aachen.de> wrote in comp.lang.perl.misc:
> Also sprach Jonas Nilsson:
>
> > I have an optimization problem.
>
> Rather a language problem.
>
> > I have two arrays of floats (millions of items in each). I need the absolut
> > sum of each pairwise difference.
> > I would prefer to have the arrays as packed arrays (double or single
> > precision will both work) since I would otherwise need to much memory.
> >
> > I need to do this quite quickly. The code that i now use takes about 5 days
> > to run on a 2GHz pentium. Is there any trick, with bitwise operators or some
> > other tweak what would significantly speed op this code? I'm sad so say that
> > I don't have the knowledge about using C.
>
> This is the right moment to learn it. Honestly, the real problem here is
> the choice of tools. Perl is not the right one. Here's a solution
> written in XS (that is the C dialect used to create Perl modules).
> Create the module stub like this:
>
> h2xs -A -b 5.5.3 -n Math::PairwiseDiff
[good instructions how to build the XS module snipped]
The Inline module makes simple things simple. It knows a lot about
XS that the user doesn't have to know (at least in simple cases like
this one). Here is how a similar function (named "distance" here) can
be set up using Inline. We pass in two strings that contain the packed
doubles, plus the number of data points. The latter is just for
convenience, we could determine the length of one of the strings and
use that.
#!/usr/bin/perl
use strict; use warnings; $| = 1; # @^~`
# number of data points
use constant N => 100_000;
# set up the data arrays
my ( $array1_d, $array2_d);
for ( 0 .. N-1 ) {
$array1_d .= pack 'd', rand() - 0.5;
$array2_d .= pack 'd', rand() - 0.5;
}
my $res = distance( $array1_d, $array2_d, N);
print "$res\n";
use Inline C => <<EOC;
double distance( char* x, char* y, int n) {
/* cast pointers */
double* xx = (double *) x;
double* yy = (double *) y;
/* build sum */
double sum = 0.0;
while ( n-- ) {
sum += fabs( *xx++ - *yy++);
}
return( sum);
}
EOC
__END__
Anno
------------------------------
Date: Tue, 16 Sep 2003 16:41:40 +0200
From: "Jonas Nilsson" <dzluk8fsxsw0001@sneakemail.com>
Subject: Re: Subtracting arrays of floats.
Message-Id: <bk77e5$qig$1@news.island.liu.se>
"Anno Siegel" <anno4000@lublin.zrz.tu-berlin.de> wrote in message
news:bk726u$ksd$1@mamenchi.zrz.TU-Berlin.DE...
> The Inline module makes simple things simple. It knows a lot about
> XS that the user doesn't have to know (at least in simple cases like
> this one). Here is how a similar function (named "distance" here) can
> be set up using Inline. We pass in two strings that contain the packed
> doubles, plus the number of data points. The latter is just for
> convenience, we could determine the length of one of the strings and
> use that.
Ok. Call me thick, but I'm not an expert, to say the least.
To compile C either in Inline module or as a separate XS-module i guess I
need a C-compiler. So I don't have one... The nmake utility for Windows
isn't a C-compiler or is it?
When I try to run/make code in one of the above ways I get DOS complaining
about the lack of cl command. Is this a compiler?
What exactly do I need to run this?
I've got:
1. A computer
2. An operating system (Windows 2000)
3. perl5.6.1 from activestate
4. nmake15 (from windows support) for WinNT/Win95. I couldn't find one for
Win2000.
5. The Inline module via ppm from
http://ppm.ActiveState.com/cgibin/PPM/ppmserver.pl?urn:/PPMServer
And nothing more (...well I've got a nice espresso machine, but I doubt it
would influence much).
When I try to use the Inline C i get from DOS:
'cl' is not recognized as an internal or external command, operable program
or batch file. (and a lot more)
Please tell me what I need.
/jN
>
>
> #!/usr/bin/perl
> use strict; use warnings; $| = 1; # @^~`
>
> # number of data points
> use constant N => 100_000;
>
> # set up the data arrays
> my ( $array1_d, $array2_d);
> for ( 0 .. N-1 ) {
> $array1_d .= pack 'd', rand() - 0.5;
> $array2_d .= pack 'd', rand() - 0.5;
> }
>
> my $res = distance( $array1_d, $array2_d, N);
> print "$res\n";
>
> use Inline C => <<EOC;
>
> double distance( char* x, char* y, int n) {
> /* cast pointers */
> double* xx = (double *) x;
> double* yy = (double *) y;
> /* build sum */
> double sum = 0.0;
> while ( n-- ) {
> sum += fabs( *xx++ - *yy++);
> }
> return( sum);
> }
> EOC
> __END__
>
> Anno
------------------------------
Date: 16 Sep 2003 14:52:35 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: Subtracting arrays of floats.
Message-Id: <bk783j$o47$1@nets3.rz.RWTH-Aachen.DE>
Also sprach Anno Siegel:
> Tassilo v. Parseval <tassilo.parseval@post.rwth-aachen.de> wrote in comp.lang.perl.misc:
>> This is the right moment to learn it. Honestly, the real problem here is
>> the choice of tools. Perl is not the right one. Here's a solution
>> written in XS (that is the C dialect used to create Perl modules).
>> Create the module stub like this:
>>
>> h2xs -A -b 5.5.3 -n Math::PairwiseDiff
>
> [good instructions how to build the XS module snipped]
>
> The Inline module makes simple things simple. It knows a lot about
> XS that the user doesn't have to know (at least in simple cases like
> this one). Here is how a similar function (named "distance" here) can
> be set up using Inline. We pass in two strings that contain the packed
> doubles, plus the number of data points. The latter is just for
> convenience, we could determine the length of one of the strings and
> use that.
Very terse, nice! Nonetheless I keep thinking that Inline::C only makes
those things simple that are simple by nature (and therefore simple in
XS). :-)
But it looks less scary which is a good thing for someone starting with C
extensions for Perl.
> #!/usr/bin/perl
> use strict; use warnings; $| = 1; # @^~`
>
> # number of data points
> use constant N => 100_000;
>
> # set up the data arrays
> my ( $array1_d, $array2_d);
> for ( 0 .. N-1 ) {
> $array1_d .= pack 'd', rand() - 0.5;
> $array2_d .= pack 'd', rand() - 0.5;
> }
>
> my $res = distance( $array1_d, $array2_d, N);
> print "$res\n";
>
> use Inline C => <<EOC;
>
> double distance( char* x, char* y, int n) {
> /* cast pointers */
> double* xx = (double *) x;
> double* yy = (double *) y;
Using pack() and these casts is quite smart. Besides being a fast way
it'll also use very little memory.
In my solution, 1_000_000 floats stored in 'ARY*' need around 480kB
memory (at least on machines with a memory-alignment of 4 or 8 bytes
which should be common enough). So that's ok. But perl still has to
build a million scalars and put them onto the stack. And since perl
will only reluctantly give the memory back to the OS (if ever), this
could be a real problem.
> /* build sum */
> double sum = 0.0;
> while ( n-- ) {
> sum += fabs( *xx++ - *yy++);
> }
> return( sum);
> }
> EOC
> __END__
One minor thing: you use fabs() from math.h. Is Inline::C smart enough
to automatically link against libm? It might be necessary to add a
use Inline C => Config =>
LIBS => '-lm';
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: Sat, 19 Jul 2003 01:59:56 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re:
Message-Id: <3F18A600.3040306@rochester.rr.com>
Ron wrote:
> Tried this code get a server 500 error.
>
> Anyone know what's wrong with it?
>
> if $DayName eq "Select a Day" or $RouteName eq "Select A Route") {
(---^
> dienice("Please use the back button on your browser to fill out the Day
> & Route fields.");
> }
...
> Ron
...
--
Bob Walton
------------------------------
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 5511
***************************************
