[13425] in Perl-Users-Digest
Perl-Users Digest, Issue: 835 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Sep 17 20:07:32 1999
Date: Fri, 17 Sep 1999 17:05:09 -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: <937613109-v9-i835@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Fri, 17 Sep 1999 Volume: 9 Number: 835
Today's topics:
Re: [Help] Problem with AuthCookie on Apache Server <gellyfish@gellyfish.com>
Re: Case insensitive SQL query mrbog@my-deja.com
Re: Code examples of threads in Perl <tchrist@mox.perl.com>
Re: Code examples of threads in Perl <gellyfish@gellyfish.com>
Re: help! <gellyfish@gellyfish.com>
Re: Lambda calculus stuff in Perl <mike@yawp.com>
Re: List files in a dir <makkulka@cisco.com>
Re: PERL/HTML Interaction problems with <ACTION... comm <makkulka@cisco.com>
Re: perl5.005_0 Install problem HELP !! <gellyfish@gellyfish.com>
Re: Problem with XS and MakeMaker (Win98) <randy@theory.uwinnipeg.ca>
Problems with Format (Warren Brown)
Re: send mail perl->OLE->Lotus <gellyfish@gellyfish.com>
Use of backticks (`` or qx) on NT with no console eric_poulsen@my-deja.com
Re: What happens with this slice? <gellyfish@gellyfish.com>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 17 Sep 1999 23:25:43 -0000
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: [Help] Problem with AuthCookie on Apache Server
Message-Id: <7ruiln$v9$1@gellyfish.btinternet.com>
On Thu, 16 Sep 1999 18:40:02 GMT Kragen Sitaker wrote:
> In article <Ox591NGA$GA.275@cpmsnbbsa03>,
> Nguyen Nguyen <nguyen.nguyen@infosoft-consulting.com> wrote:
>>I am trying to setup AuthCookie to work with
>>our Apache server. The AuthCookie comes
>>with a sample script called "login.pl". In that
>>script, it has a line of
>>
>>my $r = Apache->request;
>>
>>which produces the following error message in the
>>Apache error log file:
>
> How are you running the script? I think this is a mod_perl script
> (with no justification except for a hunch, as I haven't used
> mod_perl).
I have a feeling that that is the problem - there aint no mod_perl here is
my suspicion. The original poster might want to determine if mod_perl
has been compiled into the httpd - if he is unsure how to do this he
will want to ask in the newsgroup comp.infosystems.www.servers.unix.
/J\
--
Jonathan Stowe <jns@gellyfish.com>
<http://www.gellyfish.com>
Hastings: <URL:http://dmoz.org/Regional/UK/England/East_Sussex/Hastings>
------------------------------
Date: Fri, 17 Sep 1999 23:15:10 GMT
From: mrbog@my-deja.com
Subject: Re: Case insensitive SQL query
Message-Id: <7rui1k$1lk$1@nnrp1.deja.com>
> >Well then you're proving my point FOR me. If there are so many people
> >getting to the questions before you can, then there's PLENTY of room
> >for more questions!
>
> No, they're getting to the questions before I do because I check in
> about every two weeks.
>
Well, guess what? Messages last longer than a day. So if you check in
every two weeks, you will see messages from two weeks ago as well.
> >
> >YES, I DO, because there are 2400 people to answer them.
>
> More like a couple dozen. And they're here to help answer questions
> about Perl. Why make busy-work for them? They're doing a nice thing
> for us. It's only fair to avoid making extra demands.
>
couple dozen?! Try a couple thousand. The more people posting
questions, the more people there are to answer them.
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
------------------------------
Date: 17 Sep 1999 17:53:35 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Code examples of threads in Perl
Message-Id: <37e2d47f@cs.colorado.edu>
[REPOST: This disappeared. This seems to happening a lot.]
In comp.lang.perl.misc,
Brundle <brundlefly76@hotmail.com> writes:
:Does anyone have any good code examples in Perl of thread usage?
:
:I need to multithread a TCP/IP client in order to saturate a remote
:server.
:
:Right now I open 5 socket connections to the server and send to them
:round-robin, but this does not work as it is still serial.
:
:Given a list of messages to deliver, I need to send the list to all 5
:and not wait for the response on each before moving to the next.
:
:I am open to alternative reccommendations or suggestions as well.
You should consider whether to be forking processes not spawning threads.
Threads are not really very portable/robust at this time.
Here are various examples.
--tom
# This is a shell archive. Save it in a file, remove anything before
# this line, and then unpack it by entering "sh file". Note, it may
# create directories; files and directories will be owned by you and
# have default permissions.
#
# This archive contains:
#
# dns-fork
# dns-queue
# dns-sema
# procpool
# thrpool
# fwdport
#
echo x - dns-fork
sed 's/^X//' >dns-fork << 'END-of-dns-fork'
X#!/usr/bin/perl
X# dns-fork -- dvk@lonewolf.com
X
Xuse FileHandle;
Xuse Socket;
X
X# Don't "use strict 'vars'" - we'll be using soft references
X
X$parallel = 10;
X@ip_need = read_unknown_ips(); # Not shown here, part of a larger program...
Xinit_resolvers();
Xresolve_ip();
Xexit;
X
Xsub init_resolvers { # Create the background processes
X my ($fd, $ipn, $host);
X print "Parallelizing $parallel IP lookup processes...\n";
X for $fd (1..$parallel) {
X pipe "read$fd", OUT;
X if ($pid[$fd] = open ("feed$fd", "|-")) { # In parent
X close OUT;
X }
X else { # In child
X close "read$fd";
X if (!defined($pid[$fd])) {
X # If here, then fork failed, and we're in parent!
X close OUT;
X $parallel = $fd - 1;
X warn "Only able to fork $parallel processes\n";
X last; # Don't try any more forks
X }
X #
X # The rest of this is the child - do lookups until
X # done by reading 4 bytes (an IPv4 address sent to
X # the child by parent) and writing 3 bytes of length
X # followed by the looked-up name.
X #
X OUT->autoflush(1);
X while (sysread (STDIN, $ipn, 4)) {
X $host = lc (gethostbyaddr ($ipn, AF_INET)) || "-";
X printf OUT "%03d%s", length($host), $host;
X }
X exit 0;
X }
X }
X}
X
Xsub resolve_ip {
X my ($counter, $ip, $ipn, $host, $cnt, $fd, $Npar, @query);
X
X # Prime the pump and set up the select vector
X $rin = "";
X $Npar = 0;
X for $fd (1..$parallel) {
X if ($query[$fd] = shift @ip_need) {
X syswrite ("feed$fd", pack("N", $query[$fd]), 4);
X vec ($rin, fileno("read$fd"), 1) = 1;
X $Npar++;
X }
X else {
X kill 'TERM', $pid[$fd];
X close ("feed$fd");
X }
X }
X return if $Npar == 0; # Done (all fd's closed)
X $parallel = $Npar;
X # Cycle the background processes with names to lookup
X IP: while (select ($rout = $rin, undef, undef, undef)) {
X for $fd (1..$parallel) {
X if (vec ($rout, fileno ("read$fd"), 1)) {
X ($nbytes=sysread ("read$fd", $cnt, 3)) == 3
X || die "Size error ($cnt=$nbytes) on read$fd";
X ($nbytes=sysread ("read$fd", $host, $cnt)) == $cnt
X || die "Name error ($host=$nbytes) on read$fd";
X printf "%s\t%s\n",
X join (".",unpack("C4",pack("N",$query[$fd]))), $host;
X if ($query[$fd] = shift @ip_need) {
X syswrite ("feed$fd", pack("N", $query[$fd]), 4);
X }
X else {
X vec ($rin, fileno("read$fd"), 1) = 0;
X kill 'TERM', $pid[$fd];
X close ("feed$fd");
X last IP if --$Npar == 0;
X }
X }
X }
X }
X}
X
END-of-dns-fork
echo x - dns-queue
sed 's/^X//' >dns-queue << 'END-of-dns-queue'
X#!/usr/local/bin/filsperl -w
X
Xuse strict;
Xuse Thread qw/async/;
Xuse Thread::Queue;
X
Xuse constant BUFMAX => 20;
X
Xmy $LOGFILE = "/var/log/httpd/access_log";
X
Xmy $time_to_die = 0;
X
Xmy $DELAY = 0; # sleep time
X
X$| = 1;
X
Xmy $DEBUG = 0;
X
X$SIG{INT} = sub { kill "HUP" => -$$ }; # kill whole pgrp
X
Xrun_all();
X
Xexit;
X
X###########################
X
XBEGIN {
X
X use constant MAX_PRODUCERS => 3;
X use constant MAX_CONSUMERS => 10;
X
X my $Q = Thread::Queue->new();
X
X sub producer {
X my $item;
X my $tid = Thread->self->tid();
X
X my $handled = 0;
X
X debug("Beginning producer");
X
X while ($item = next_line()) {
X $handled++;
X $Q->enqueue($item);
X last if $time_to_die;
X }
X
X debug("PRODUCER DYING");
X
X return $handled;
X }
X
X sub consumer {
X my $item;
X my $tid = Thread->self->tid();
X
X my $handled = 0;
X
X debug("Beginning consumer");
X
X while ($item = $Q->dequeue() ) {
X $handled++;
X $item =~ s{ ( \b \d+\.\d+\.\d+\.\d+ \b ) }
X { num2name($1) }ex;
X debug("consuming $item");
X print "$item\n";
X dawdle();
X last if $time_to_die;
X }
X debug("CONSUMER DYING");
X return $handled;
X }
X
X
X sub run_all {
X
X my (@consumers, @producers);
X
X for (1 .. MAX_CONSUMERS) {
X push @consumers, Thread->new(\&consumer);
X }
X
X for (1 .. MAX_PRODUCERS) {
X push @producers, Thread->new(\&producer);
X }
X
X for my $task (@producers, @consumers) {
X my $tid = $task->tid();
X my $count = $task->join();
X print "Task $tid handled $count items\n";
X }
X
X }
X
X}
X
Xsub next_line {
X use attrs qw/locked/;
X unless (defined fileno(LOGFILE)) {
X my $flags = $DEBUG ? "" : "+0f";
X open(LOGFILE, "tail $flags $LOGFILE |")
X || die "can't tail $LOGFILE: $!";
X }
X my $line = <LOGFILE>;
X if (!defined $line) {
X $time_to_die++; # whole sub locked
X return;
X }
X chomp $line;
X return $line;
X}
X
Xsub debug {
X my $tid = Thread->self->tid();
X print "TID $tid: @_\n" if $DEBUG;
X}
X
Xsub dawdle {
X sleep int rand $DELAY if $DEBUG;
X}
X
Xuse Socket;
Xsub num2name {
X my $addr = shift;
X my $name;
X
X if ($name = lru_decache($addr)) {
X return $name;
X }
X
X my $binaddr = pack("C4", split (/\./, $addr));
X $name = gethostbyaddr($binaddr, AF_INET) || $addr;
X
X lru_encache($addr, $name);
X return $name;
X}
X
X{
X my %cache;
X use constant CACHE_MAX => 20;
X
X sub lru_decache {
X lock %cache;
X my $key = $_[0];
X my $pair;
X return unless $pair = $cache{$key};
X $pair->[1]++;
X return $pair->[0];
X }
X
X sub lru_encache {
X lock %cache;
X my ($key, $value) = @_;
X $cache{$key} = [ $value, 0 ];
X purge_cache() if CACHE_MAX < keys %cache;
X }
X
X sub purge_cache {
X lock %cache;
X debug("PURGING CACHE");
X # WARNING: sort() not thread safe!
X my @keys = sort { $cache{$a}[1] <=> $cache{$b}[1] } keys %cache;
X $#keys /= 2;
X delete @cache{@keys};
X }
X
X
X}
END-of-dns-queue
echo x - dns-sema
sed 's/^X//' >dns-sema << 'END-of-dns-sema'
X#!/usr/local/bin/filsperl -w
X
Xuse strict;
Xuse Thread qw/async/;
Xuse Thread::Semaphore;
X
Xuse constant BUFMAX => 20;
X
Xmy $LOGFILE = "/var/log/httpd/access_log";
X
Xmy $time_to_die = 0;
X
Xmy $DELAY = 0; # sleep time
X
X$| = 1;
X
Xmy $DEBUG = 0;
X
X$SIG{INT} = sub { kill "HUP" => -$$ }; # kill whole pgrp
X
Xrun_all();
X
Xexit;
X
X###########################
X
XBEGIN {
X
X use constant MAX_PRODUCERS => 3;
X use constant MAX_CONSUMERS => 10;
X
X my($mutex, $empty, $full); # three semaphores
X
X $mutex = Thread::Semaphore->new(1);
X $empty = Thread::Semaphore->new(BUFMAX);
X $full = Thread::Semaphore->new(0);
X
X my @buffer;
X my ($in, $out, $count);
X
X $in = 0;
X $count = 0;
X $out = 0;
X
X sub producer {
X my $item;
X my $tid = Thread->self->tid();
X
X my $handled = 0;
X
X debug("Beginning producer");
X
X do {
X
X # produce something
X if ($item = produce()) {
X $handled++;
X
X debug("producer waits for empty space");
X $empty->down();
X
X # store the item
X $mutex->down();
X $buffer[$in] = $item;
X $in = ($in + 1) % BUFMAX;
X $count++;
X $mutex->up();
X
X debug("producer reports new full slot");
X $full->up();
X }
X
X } until $time_to_die;
X
X debug("PRODUCER DYING");
X
X return $handled;
X }
X
X sub consumer {
X my $item;
X my $tid = Thread->self->tid();
X
X my $handled = 0;
X
X debug("Beginning consumer");
X
X do {
X
X debug("consumer waits for stored item");
X $full->down();
X
X # remove the item
X $mutex->down();
X $item = $buffer[$out];
X $out = ($out + 1) % BUFMAX;
X $count--;
X $mutex->up();
X
X debug("consumer reports new empty slot");
X $empty->up();
X
X # consume it
X if ($item) {
X consume($item);
X $handled++;
X }
X
X } until $time_to_die;
X
X debug("CONSUMER DYING");
X
X return $handled;
X }
X
X
X sub run_all {
X
X my (@consumers, @producers);
X
X for (1 .. MAX_CONSUMERS) {
X push @consumers, Thread->new(\&consumer);
X }
X
X for (1 .. MAX_PRODUCERS) {
X push @producers, Thread->new(\&producer);
X }
X
X for my $task (@producers, @consumers) {
X my $tid = $task->tid();
X my $count = $task->join();
X print "Task $tid handled $count items\n";
X }
X
X }
X
X}
X
Xsub consume {
X my $tid = Thread->self->tid();
X my $item = $_[0];
X $item =~ s{ ( \b \d+\.\d+\.\d+\.\d+ \b ) }
X { num2name($1) }ex;
X debug("consuming $item");
X print "$item\n";
X dawdle();
X}
X
Xsub produce {
X my $tid = Thread->self->tid();
X my $item = next_line() || return;
X debug("producing $item");
X dawdle();
X return $item;
X}
X
Xsub next_line {
X use attrs qw/locked/;
X unless (defined fileno(LOGFILE)) {
X my $flags = $DEBUG ? "" : "+0f";
X open(LOGFILE, "tail $flags $LOGFILE |")
X open(LOGFILE, "tail $LOGFILE |")
X || die "can't tail $LOGFILE: $!";
X }
X my $line = <LOGFILE>;
X if (!defined $line) {
X $time_to_die++; # whole sub locked
X return;
X }
X chomp $line;
X return $line;
X}
X
Xsub debug {
X my $tid = Thread->self->tid();
X print "TID $tid: @_\n" if $DEBUG;
X}
X
Xsub dawdle {
X sleep int rand $DELAY if $DEBUG;
X}
X
Xuse Socket;
Xsub num2name {
X my $addr = shift;
X my $name;
X
X if ($name = lru_decache($addr)) {
X return $name;
X }
X
X my $binaddr = pack("C4", split (/\./, $addr));
X $name = gethostbyaddr($binaddr, AF_INET) || $addr;
X
X lru_encache($addr, $name);
X return $name;
X}
X
X{
X my %cache;
X use constant CACHE_MAX => 20;
X
X sub lru_decache {
X lock %cache;
X my $key = $_[0];
X my $pair;
X return unless $pair = $cache{$key};
X $pair->[1]++;
X return $pair->[0];
X }
X
X sub lru_encache {
X lock %cache;
X my ($key, $value) = @_;
X $cache{$key} = [ $value, 0 ];
X purge_cache() if CACHE_MAX < keys %cache;
X }
X
X sub purge_cache {
X lock %cache;
X debug("PURGING CACHE");
X # WARNING: sort() not thread safe!
X my @keys = sort { $cache{$a}[1] <=> $cache{$b}[1] } keys %cache;
X $#keys /= 2;
X delete @cache{@keys};
X }
X
X
X}
END-of-dns-sema
echo x - procpool
sed 's/^X//' >procpool << 'END-of-procpool'
X#!/usr/bin/perl -w
X# process pool demo
Xuse strict;
X
X$| = 1; # fork can really make for stdio surprises
X
Xmy $TOTAL = 100;
Xmy $CONCUR_MAX = 10;
X
Xmy $FORK_RETRIES = 5;
Xmy $RETRY_SLEEP = 5;
X
Xmy $DAWDLE = 10; # kid spins jets for 1+rand this
X
Xmy %Launched = ();
X
Xrun_queue();
Xexit;
X
X##################
X
Xsub run_queue {
X
X my $started = 0;
X my $done = 0;
X my $running = 0;
X
XJOB:
X while ($TOTAL > ($done+$running) || $running > 0) {
X
X # sort by date in case pids wrap
X print "Run queue: ", join(" ",
X sort { $Launched{$a} <=> $Launched{$b} } keys %Launched),
X "\n";
X
X if ($running >= $CONCUR_MAX || $started >= $TOTAL) {
X print "$$: waiting R=$running, S=$started D=$done\n";
X my $child = wait;
X die "REAPED WRONG CHILD: $child ($?)" unless $Launched{$child};
X my $runtime = time() - $Launched{$child};
X delete $Launched{$child};
X print "Child $child has completed, after $runtime seconds\n";
X print "Child $child exited " . ($? << 8) . "\n" if $?;
X $done++;
X --$running;
X next JOB;
X }
X
X next if ($done+$running) >= $TOTAL;
X
X my $tries = 0;
X my $kid;
XRETRY: {
X $kid = fork();
X unless (defined $kid) {
X warn "$0 $$: cannot fork: $!";
X if ($tries++ < $FORK_RETRIES) {
X warn "$0 $$: sleep and retry\n";
X sleep 5;
X redo RETRY;
X }
X }
X }
X if ($kid) {
X $running++;
X $started++;
X $Launched{ $kid } = time();
X }
X else {
X run_job();
X exit;
X # NOT REACHED
X }
X
X }
X
X}
X
Xsub run_job {
X print "$$ is napping\n";
X sleep(1 + int(rand($DAWDLE)));
X print "$$ had a nice nap.\n";
X}
X
END-of-procpool
echo x - thrpool
sed 's/^X//' >thrpool << 'END-of-thrpool'
X
X use Thread;
X use Thread::Pool;
X
X my $pool = Thread::Pool->new(Max => $CONCUR_MAX);
X for (my $i = 0; $i < $TOTAL; $i++) {
X $pool->enqueue(\&run_job);
X }
END-of-thrpool
echo x - fwdport
sed 's/^X//' >fwdport << 'END-of-fwdport'
X#!/usr/bin/perl -w
X# fwdport -- act as proxy forwarder for dedicated services
X
Xuse strict; # require declarations
Xuse Getopt::Long; # for option processing
Xuse Net::hostent; # by-name interface for host info
Xuse IO::Socket; # for creating server and client sockets
Xuse POSIX ":sys_wait_h"; # for reaping our dead children
X
Xmy (
X %Children, # hash of outstanding child processes
X $REMOTE, # whom we connect to on the outside
X $LOCAL, # where we listen to on the inside
X $SERVICE, # our service name or port number
X $proxy_server, # the socket we accept() from
X $ME, # basename of this program
X);
X
X($ME = $0) =~ s,.*/,,; # retain just basename of script name
X
Xcheck_args(); # processing switches
Xstart_proxy(); # launch our own server
Xservice_clients(); # wait for incoming
Xdie "NOT REACHED"; # you can't get here from there
X
X# process command line switches using the extended
X# version of the getopts library.
Xsub check_args {
X GetOptions(
X "remote=s" => \$REMOTE,
X "local=s" => \$LOCAL,
X "service=s" => \$SERVICE,
X ) or die <<EOUSAGE;
X usage: $0 [ --remote host ] [ --local interface ] [ --service service ]
XEOUSAGE
X die "Need remote" unless $REMOTE;
X die "Need local or service" unless $LOCAL || $SERVICE;
X}
X
X# begin our server
Xsub start_proxy {
X my @proxy_server_config = (
X Proto => 'tcp',
X Reuse => 1,
X Listen => SOMAXCONN,
X );
X push @proxy_server_config, LocalPort => $SERVICE if $SERVICE;
X push @proxy_server_config, LocalAddr => $LOCAL if $LOCAL;
X $proxy_server = IO::Socket::INET->new(@proxy_server_config)
X or die "can't create proxy server: $@";
X print "[Proxy server on ", ($LOCAL || $SERVICE), " initialized.]\n";
X}
X
X
Xsub service_clients {
X my (
X $local_client, # someone internal wanting out
X $lc_info, # local client's name/port information
X $remote_server, # the socket for escaping out
X @rs_config, # temp array for remote socket options
X $rs_info, # remote server's name/port information
X $kidpid, # spawned child for each connection
X );
X
X $SIG{CHLD} = \&REAPER; # harvest the moribund
X
X accepting();
X
X # an accepted connection here means someone inside wants out
X while ($local_client = $proxy_server->accept()) {
X $lc_info = peerinfo($local_client);
X set_state("servicing local $lc_info");
X printf "[Connect from $lc_info]\n";
X
X @rs_config = (
X Proto => 'tcp',
X PeerAddr => $REMOTE,
X );
X push(@rs_config, PeerPort => $SERVICE) if $SERVICE;
X
X print "[Connecting to $REMOTE...";
X set_state("connecting to $REMOTE"); # see below
X $remote_server = IO::Socket::INET->new(@rs_config)
X or die "remote server: $@";
X print "done]\n";
X
X $rs_info = peerinfo($remote_server);
X set_state("connected to $rs_info");
X
X $kidpid = fork();
X die "Cannot fork" unless defined $kidpid;
X if ($kidpid) {
X $Children{$kidpid} = time(); # remember his start time
X close $remote_server; # no use to master
X close $local_client; # likewise
X next; # go get another client
X }
X
X # at this point, we are the forked child process dedicated
X # to the incoming client. but we want a twin to make i/o
X # easier.
X
X close $proxy_server; # no use to slave
X
X $kidpid = fork();
X die "Cannot fork" unless defined $kidpid;
X
X # now each twin sits around and ferries lines of data.
X # see how simple the algorithm is when you can have
X # multiple threads of control?
X
X # this is the fork's parent, the master's child
X if ($kidpid) {
X set_state("$rs_info --> $lc_info");
X select($local_client); $| = 1;
X print while <$remote_server>;
X kill('TERM', $kidpid); # kill my twin cause we're done
X }
X # this is the fork's child, the master's grandchild
X else {
X set_state("$rs_info <-- $lc_info");
X select($remote_server); $| = 1;
X print while <$local_client>;
X kill('TERM', getppid()); # kill my twin cause we're done
X }
X exit; # whoever's still alive bites it
X } continue {
X accepting();
X }
X}
X
X# helper function to produce a nice string in the form HOST:PORT
Xsub peerinfo {
X my $sock = shift;
X my $hostinfo = gethostbyaddr($sock->peeraddr);
X return sprintf("%s:%s",
X $hostinfo->name || $sock->peerhost,
X $sock->peerport);
X}
X
X# reset our $0, which on some systems make "ps" report
X# something interesting: the string we set $0 to!
Xsub set_state { $0 = "$ME [@_]" }
X
X# helper function to call set_state
Xsub accepting {
X set_state("accepting proxy for " . ($REMOTE || $SERVICE));
X}
X
X# somebody just died. keep harvesting the dead until
X# we run out of them. check how long they ran.
Xsub REAPER {
X my $child;
X my $start;
X while (($child = waitpid(-1,WNOHANG)) > 0) {
X if ($start = $Children{$child}) {
X my $runtime = time() - $start;
X printf "Child $child ran %dm%ss\n",
X $runtime / 60, $runtime % 60;
X delete $Children{$child};
X } else {
X print "Bizarre kid $child exited $?\n";
X }
X }
X # If I had to choose between System V and 4.2, I'd resign. --Peter Honeyman
X $SIG{CHLD} = \&REAPER;
X};
END-of-fwdport
exit
--
"After three days without programming, life becomes meaningless."
------------------------------
Date: 17 Sep 1999 22:59:11 -0000
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: Code examples of threads in Perl
Message-Id: <7ruh3v$uo$1@gellyfish.btinternet.com>
On Thu, 16 Sep 1999 23:18:29 GMT Brundle wrote:
> Does anyone have any good code examples in Perl of thread usage?
>
> I am open to alternative reccommendations or suggestions as well.
>
I quite like :
gellyfish@gellyfish:/home/gellyfish > thing.pl &
[1] 963
gellyfish@gellyfish:/home/gellyfish > thing.pl &
[2] 966
gellyfish@gellyfish:/home/gellyfish > thing.pl &
[3] 969
gellyfish@gellyfish:/home/gellyfish > thing.pl &
[4] 972
gellyfish@gellyfish:/home/gellyfish > thing.pl &
[5] 975
gellyfish@gellyfish:/home/gellyfish > thing.pl &
[6] 979
:-)
/J\
--
Jonathan Stowe <jns@gellyfish.com>
<http://www.gellyfish.com>
Hastings: <URL:http://dmoz.org/Regional/UK/England/East_Sussex/Hastings>
------------------------------
Date: 17 Sep 1999 22:48:25 -0000
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: help!
Message-Id: <7rugfp$tg$1@gellyfish.btinternet.com>
On Fri, 17 Sep 1999 01:21:34 -0400 bob wrote:
> i know this isn't a perl question...
>
> well, it sorta is.
> it's perl-driven....
>
> can someone email/IM me a description of what's on channel 80?
> i then need to make a change and ask them to tell me what changed.
>
gellyfish@gellyfish:/home/gellyfish/perl5.005_02 > telnet localhost 80
GET / HTTP/1.0
Accept: text/html
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
HTTP/1.1 200 OK
Date: Fri, 17 Sep 1999 22:44:19 GMT
Server: Apache/1.3.3 (Unix) mod_perl/1.17
Last-Modified: Sat, 10 Oct 1998 13:41:33 GMT
ETag: "57-1cb-361f640d"
Accept-Ranges: bytes
Content-Length: 459
Connection: close
Content-Type: text/html
X-Pad: avoid browser bug
...
HTH
/J\
--
Jonathan Stowe <jns@gellyfish.com>
<http://www.gellyfish.com>
Hastings: <URL:http://dmoz.org/Regional/UK/England/East_Sussex/Hastings>
------------------------------
Date: Fri, 17 Sep 1999 18:38:42 -0500
From: Mike Stone <mike@yawp.com>
To: Kragen Sitaker <kragen@dnaco.net>
Subject: Re: Lambda calculus stuff in Perl
Message-Id: <Pine.NEB.3.96.990917165735.21888C-100000@www.yawp.com>
> > each term in the sum will be .468 * (.532)**N, i.e.: the probability
> > of terminating on pass N times the chance of *getting* to pass N.
> > that's a simple geometric progression, so we're looking for the limit
> > as N goes to infinity of:
> >
> > .468 * ((1 -.532**N) / (1 - .532)) == .468 * (1/.468) == 1.
> >
> > and that's pretty much what intuition would suggest: the function is
> > only guaranteed to terminate after infinite recursions, but at least
> > now you can calculate the probability of termination on or before
> > recursion N:
>
> You're missing something. With this calculation, you have demonstrated
> that it will always probabilistically terminate, regardless of the
> actual probability parameters, as long as the probability of varref is
> nonzero.
uh, no.. that's not something i missed, per se.. more like a fundamental
consequence of the point i was making. (hey, what the heck.. at least
you spotted it, right? ;-)
look at is this way: there are only two things the routine can possibly
do: terminate or not terminate. by definition, the sum of the
probabilities for those two outcomes is 1.
the chance of reaching recursion N is a simple conditional probability,
i.e.: the product of the probabilities of all events in the condition.
the probability of getting to recursion N is the probability of getting
to recursion N-1, times the probability of recurring again. since the
probability of recurring again is the same every time, we're just
multiplying the same number by itself N times, so the probability of
reaching recursion N is Precur**N.
any fraction to an infinite power is zero if that fraction's absolute
value is less than 1, so the probability of reaching recursion N
asymptotically approaches (converges to) zero as N approaches infinity.
the value of Precur determines how quickly or slowly that probability
converges to zero, but is irrelevant to the basic fact of convergence, as
long as |Precur| < 1.
if the probability of infinite recursion asymptotically approaches zero,
the probability of termination.. which is just 1 minus the probability of
infinite recursion.. converges to 1. that holds true for any set of
parameters where Precur is less than 1, regardless of what those
parameters may be. therefore, if the probability of a varref has any
nonzero value.. no matter how small:
- |Precur| will be less than 1
- Precur**N will converge to zero as N goes to infinity
- Pterminate will converge to one as N goes to infinity
and the routine is guaranteed to terminate after (at most) an infinite
number of recursions.. which isn't exactly a glowing reccommendation if
you stop and think about it.
infinity's big.. it can wait out even the slimmest chance of termination:
Pvarref = .001 Pvarref = 1e-06 Pvarref = 1e-10
N Pterminate N Pterminate N Pterminate
-------------- -------------- --------------
1 .001 1 1e-6 1 1e-10
10 .00996 10 1e-5 10 1e-09
100 .0952 100 .0001 100 1e-08
1e03 .632 1e03 .001 1e03 1e-07
1e06 ~1 1e06 .632 1e06 .0001
1e09 ~1 1e09 ~1 1e09 .0952
1e12 ~1 1e12 ~1 1e12 ~1
so granted, doing a trillion recursions before termination isn't out of
the question if the odds of getting a varref are only one in ten billion,
but that's still chicken-feed compared to infinity. ;-) no matter what
probability you pick for the occurrence of a varref, however small,
i can calculate the number of recursions necessary to give a 99.995%
probability of termination. meanwhile, though, the number of recursions
necessary to guarantee an absolute 100% chance of termination will always
remain infinite.
so.. flipping the numbers back over again, as long as the probability of
getting a varref is less than 1.. no matter how close to 1 it gets.. there
will always be a vanishingly small chance of infinite recursion. there's
no set of parameters for the routine which both allow probabilistic
recursion *and* guarantee termination in at most N recursions, where N is
less than infinity.. that's just the way the beast works. if you want
probabilistic recursion *and* an absolute guarantee of termination after
at most N(finite) recursions, you need to handle those requirements
separately.
to figure the *average* (statistical mean) number of times the routine
will recur before terminating, you just calculate the number of recursions
necessary to give a 50% chance of termination. assuming your random
number generator produces a uniform distribution, half the runs will
terminate before that point, and half will terminate after it. the two
halves cancel each other out, making N50 the average number of recursions
per execution. it's a pretty simple function:
N50 = ln(.5)/ln(.532)
since the probability of termination cancels out.
for the parameters you've chosen, N50 ~= 1.099, meaning that on average,
the routine will only recur about once. the following table gives values
for other average levels of recursion:
N50 Pterminate
---------------
2 .292
3 .206
4 .159
5 .129
where the value of Pterminate is:
1 - .5**(1/N50)
so Precur is just the Nth root of 1/2.
to translate those into parameters for each of the three object types,
pick values which satisfy the equation:
Pterminate = Plambda(Pvarref**2) + Papp(Pvarref) + Pvarref
for the value of Pterminate that you want. note that you have three free
variables on the RHS of that equation, so you'll have to fix two of them
arbitrarily and solve for the third.
> ITYM a DPDA, not a DFA.
Deterministic Finite-state Automaton.. that's the term they use in the
Dragon book, and it sorta got burned into my skull on the N+(however
many)th reading. i'm not familiar with DPDA off the top of my head, but
assume they're synonymous.. Deterministic, Probabilistically Directed
Automaton, p'raps?
> So you're generating tables at runtime using something like LALR(1)?
> Youch.
well, the missing word there is "trying".. ;-) what i'm doing is
splitting the grammar into partial productions, then topologically sorting
them. in theory, that should result in a state machine that recognizes
the entire grammar. the problem is that there are more nuances than
there are basic principles. i'm sure that once i get everything sorted
out, it'll all look obvious, but at the moment, i'm still fighting my way
through the intermediate-level stupid mistakes.
--
mike
------------------------------
Date: Fri, 17 Sep 1999 16:35:19 -0700
From: Makarand Kulkarni <makkulka@cisco.com>
Subject: Re: List files in a dir
Message-Id: <37E2D036.573CA433@cisco.com>
[ Pierre-Luc Soucy wrote:
> Anybody could tell me how to list the files in a dir and print the
> result in an HTML format with PERL?
More than one way to do it .
(1)
$listdir = 'whatever ';
opendir(DIR, $listdir) || die " died " ;
@names = readdir(DIR);
closedir DIR;
print join " , " , @names ;
(2)
use File::Find;
(3)
open(DIR, " ls -ltr | " ) || die " died " ; # unix only
@names = <DIR> ;
closedir DIR;
print join " ", @names ;
I am sure you can format @names but inserting
some HTML here and there. Use HTML List
or table.
--
------------------------------
Date: Fri, 17 Sep 1999 16:37:24 -0700
From: Makarand Kulkarni <makkulka@cisco.com>
Subject: Re: PERL/HTML Interaction problems with <ACTION... command
Message-Id: <37E2D0B4.F3B442E@cisco.com>
["Nations, Marc [RICH6:A222:EXCH]" wrote:
> I am completely stumped. If someone could help me out I would very much
> appreciate it.
Please delete all your duplicate postings. There are around 4 of them.
--
------------------------------
Date: 17 Sep 1999 22:25:06 -0000
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: perl5.005_0 Install problem HELP !!
Message-Id: <7ruf42$qm$1@gellyfish.btinternet.com>
On Fri, 17 Sep 1999 10:39:59 -0700 Naren Dasu wrote:
> Hi ,
> I get this error when I do the "make depend"
>
> Has anyone else had this problem ?
>
> sh ./makedepend MAKE=make
> ./makedepend: /dev/null: cannot execute
> ./makedepend: -f: execute permission denied
> cp: Insufficient arguments (1)
> Usage: cp [-f] [-i] [-p] f1 f2
> cp [-f] [-i] [-p] f1 ... fn d1
> cp -r|R [-f] [-i] [-p] d1 ... dn-1 dn
> ./makedepend: test: argument expected
> make: *** [depend] Error 1
>
Have you run Configure first ? It appears that environment variables that
should have been set by config.sh have not been.
Start again.
make realclean
sh ./Configure -des
make depend
make
make test
make install
/J\
--
Jonathan Stowe <jns@gellyfish.com>
<http://www.gellyfish.com>
Hastings: <URL:http://dmoz.org/Regional/UK/England/East_Sussex/Hastings>
------------------------------
Date: Fri, 17 Sep 1999 18:04:30 -0500
From: "Randy Kobes" <randy@theory.uwinnipeg.ca>
Subject: Re: Problem with XS and MakeMaker (Win98)
Message-Id: <7ruhsn$15u$1@canopus.cc.umanitoba.ca>
Andreas Hagelberg <tlb@algonet.se> wrote in
message news:37E2B6F8.855FA93F@algonet.se...
> Randy Kobes wrote:
> >
> > In a directory ExtUtils in your perl tree, there is a
> > file MM_Unix.pm. In that file there's two subroutines - xs_o
> > and xs_c - each with a line of the form
> > command_1 > file && command_2
> > The DOS "shell" can get confused over the '&&'. Try changing these
> > two instances to
> > command_1 > file
> > command_2
> > and see if that helps.
>
> Anyway, I did this and MakeMaker now seems to work fine in the respect
> that it doesn't output any error-messages and the makefile is written,
> but the problem remains. When I try to run make I get the following
> error-message (same as before):
>
> [Borland C++ 5.02]:
> MAKE Version 5.0 Copyright (c) 1987, 1997 Borland International
> Error makefile 128: Colon expected
> Fatal makefile 742: No terminator specified for in-line file operator
>
[...]
Hi,
For ActiveState, if you're using a different make than Microsoft's
'nmake' and a different compiler that VC++, you probably have to
change the corresponding lines in perl's Config.pm file - they are
of the form 'make=...', etc. You should also check that the paths
to the library and include directories for your C compiler are
correct.
best regards,
Randy Kobes
------------------------------
Date: Fri, 17 Sep 1999 23:04:27 GMT
From: treetops@icon.co.za (Warren Brown)
Subject: Problems with Format
Message-Id: <37e2c8d2.108284613@hermes.is.co.za>
Hi
I would like to create a report with multiple formats in it.
The first part of my report works fine, with the header and columns
appearing correctly.
When I change the format however with:-
MAIL->format_top_header("New Format"); (off the top of my head)
etc
it only changes the format when it reaches a new page. I would like
it to
change when I tell it to change.
Does anybody have any ideas about this. Also I don't want page
breaks, but
it puts them in anyway.
thanks
------------------------------
Date: 17 Sep 1999 22:10:51 -0000
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: send mail perl->OLE->Lotus
Message-Id: <7rue9b$ps$1@gellyfish.btinternet.com>
On Thu, 16 Sep 1999 07:25:24 GMT feketeroland11@my-deja.com wrote:
> Can anybody help me???
> How can I send email from perl with lotus notes via ole?
> I haven't got any idea!!!
>
You will start with Win32::OLE but the rest of the question isnt about
Perl but about the Methods and Properties that Notes exposes via OLE.
/J\
--
Jonathan Stowe <jns@gellyfish.com>
<http://www.gellyfish.com>
Hastings: <URL:http://dmoz.org/Regional/UK/England/East_Sussex/Hastings>
------------------------------
Date: Fri, 17 Sep 1999 23:07:29 GMT
From: eric_poulsen@my-deja.com
Subject: Use of backticks (`` or qx) on NT with no console
Message-Id: <7ruhj9$194$1@nnrp1.deja.com>
I've written a daemon process in Perl for NT (Gurusamy Sarathy, 5.004)
which monitors and maintains a RAS connection using the RASDIAL command,
and backticks i.e. `rasdial blah blah blah`. I won't get into why I'm
doing it this way rather than using the DUN "redial" feature. It's long
and complicated.
In any case, the script works great.
Except ... for one thing. If I start the script without a console
window (AKA "Dos Window"), backticks do not work properly. They
do not execute the command, and do not return anything. The following
become equivalent.
$result = `rasdial blah blah blah`;
# is the same as ...
$result = '';
# the use of '' vice `` is intentional.
I'm sure there's some obscure Win32 reason for this ... anybody ever
seen this before? Gurusamy you out there? =)
Oh yeah ... I'm using the following code to suppress the console:
use Win32::API;
# ... some stuff here
$FreeConsole = new Win32::API('kernel32', 'FreeConsole', [], N);
# ... more stuff here.
$FreeConsole->Call();
Thanks much ...
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
------------------------------
Date: 17 Sep 1999 22:55:13 -0000
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: What happens with this slice?
Message-Id: <7rugsh$tj$1@gellyfish.btinternet.com>
On Fri, 17 Sep 1999 20:35:38 +0200 Alex Farber wrote:
>
> for some strange reason it works now.
Faith healing for computers ... Kewl !
/J\
--
Jonathan Stowe <jns@gellyfish.com>
<http://www.gellyfish.com>
Hastings: <URL:http://dmoz.org/Regional/UK/England/East_Sussex/Hastings>
------------------------------
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 V9 Issue 835
*************************************
