[29966] in Perl-Users-Digest
Perl-Users Digest, Issue: 1209 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Jan 17 21:09:40 2008
Date: Thu, 17 Jan 2008 18:09:09 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Thu, 17 Jan 2008 Volume: 11 Number: 1209
Today's topics:
Re: Chat client/server print failed <deadpickle@gmail.com>
Re: In perl 5.10, is $needle ~~ @haystack binary search <allergic-to-spam@no-spam-allowed.org>
Re: incorrect errno/perror with IO::socket->new <nospam-abuse@ilyaz.org>
Re: Shrink large file according to REG_EXP <ced@blv-sam-01.ca.boeing.com>
Re: Shrink large file according to REG_EXP <nospam-abuse@ilyaz.org>
Re: Shrink large file according to REG_EXP <john@castleamber.com>
To update one file with the another file's data.. clearguy02@yahoo.com
Re: To update one file with the another file's data.. davidfilmer@gmail.com
Re: To update one file with the another file's data.. <noreply@gunnar.cc>
Re: To update one file with the another file's data.. <usenet@davidfilmer.com>
Re: To update one file with the another file's data.. <noreply@gunnar.cc>
Re: To update one file with the another file's data.. <usenet@davidfilmer.com>
Re: Wait for background processes to complete <hjp-usenet2@hjp.at>
Re: Wait for background processes to complete <hjp-usenet2@hjp.at>
Re: Wait for background processes to complete xhoster@gmail.com
Re: Wait for background processes to complete <ced@blv-sam-01.ca.boeing.com>
Re: Wait for background processes to complete <cdalten@gmail.com>
Re: Working with a 1-GB XML file... <john@castleamber.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 17 Jan 2008 11:19:40 -0800 (PST)
From: deadpickle <deadpickle@gmail.com>
Subject: Re: Chat client/server print failed
Message-Id: <cc0046b7-d58b-45de-a155-be22f3efcb20@i3g2000hsf.googlegroups.com>
Thanks for your help. Commenting that code out gets the client to stay
connected, also I can send a message to the server and it is received.
Now I'm trying to get the message to be received and then displayed in
the Textview. It seems that nothing is being received by the client.
In the original program that this is based on, the author use a Tk
repeat loop in order the call the subroutine wait_for_msg. In this
Gtk2 version, a Glib::Timeout is used instead. The question is is if
this loop is receiving data from the server or not. I'm going to look
into the code but if someone sees something please let me know.
The Client:
#!/usr/bin/perl
# Flow of the Program:
# *Send message to the server - send_msg_all
# *Connect to the server - sub connect_server
# -unblock the server - nonblock
# -Login to the server - send_login
# -Timer started to wait for messages - wait_for_msg
# >Handler - handle
# $Process the incoming meswsages - process_incoming
# @Recieve messages and display in textview - rcv_msg_all
use warnings;
use strict;
use Gtk2 -init;
use Glib qw/TRUE FALSE/;
use IO::Socket::INET;
use Tie::RefHash;
use IO::Select;
#global variables
my $buffer;
my $host = "Deadpickle-hobo";
my $port = 6666;
my $conn_stat = 'idle';
my %inbuffer = ();
my %outbuffer = ();
my %ready = ();
my $select;
my $conn;
my $user;
#the main chat widget
my $main_window = Gtk2::Window->new("toplevel");
$main_window->signal_connect(delete_event => sub {Gtk2->main_quit;});
$main_window->set_default_size(250, 200);
my $table = Gtk2::Table->new(4, 2, FALSE);
$buffer = Gtk2::TextBuffer->new;
my $button = Gtk2::Button->new("Send");
my $entry = Gtk2::Entry->new();
my $label = Gtk2::Label->new("Chat Client Test");
my $textview = Gtk2::TextView->new_with_buffer($buffer);
$textview->set_cursor_visible (FALSE);
my $swindow = Gtk2::ScrolledWindow->new( undef, undef);
$swindow->set_policy( 'automatic', 'automatic');
$swindow->set_shadow_type( 'etched-out');
$swindow->add( $textview);
$table->attach_defaults($label, 0, 1, 0, 1);
$table->attach_defaults($swindow, 0, 2, 1, 3);
$table->attach_defaults($entry, 0, 1, 3, 4);
$table->attach_defaults($button, 1, 2, 3, 4);
$main_window->add($table);
$main_window->show_all();
$button->signal_connect("clicked" => sub { send_msg_all($entry-
>get_text); $entry->set_text('');} );
#run the login dialog
dialog($buffer);
Gtk2->main;
#-------------------Login Dialog-------------------
sub dialog{
my $buffer = shift;
my $dialog_window = Gtk2::Window->new('toplevel');
$dialog_window->signal_connect(delete_event => sub {Gtk2-
>main_quit});
my $dialog_table = Gtk2::Table->new(2, 2, FALSE);
my $dialog_label1 = Gtk2::Label->new('Chat Login:');
my $dialog_label2 = Gtk2::Label->new('User:');
my $dialog_label3 = Gtk2::Label->new('Host:');
my $chat_user = Gtk2::Entry->new();
$chat_user->set_text('');
my $dialog_button1 = Gtk2::Button->new('Connect');
$dialog_table->attach_defaults($dialog_label1, 0, 1, 0, 1);
$dialog_table->attach_defaults($chat_user, 1, 2, 0, 1);
$dialog_table->attach_defaults($dialog_button1, 1, 2, 1, 2);
$dialog_button1->signal_connect("clicked" => sub {$user = $chat_user-
>get_text; $dialog_window->destroy; $buffer->insert(($buffer-
>get_end_iter), "Username: $user...\n"); connect_server()});
$dialog_window->add($dialog_table);
$dialog_window->show_all;
return 1;
}
#------------------Connect to server---------------------
#establishes connection to the server
sub connect_server{
if ($conn_stat ne 'connected') {
$buffer->insert(($buffer->get_end_iter), "Connecting to Server
$host:$port...\n");
$conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort =>
$port, Proto => 'tcp') or popup_err(1);
if ($conn) {
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
nonblock($conn);
$select = IO::Select->new($conn);
$conn_stat = 'connected';
$buffer->insert(($buffer->get_end_iter), "Connected!\n");
#send login to server
send_login();
#start the timer that monitors incoming messages
my $timer_waiting = Glib::Timeout->add(100, \&wait_for_msg);
}
}
}
#-------------------Error popup-------------------
# pops up an error message
sub popup_err{
my ($error_code) = @_;
my $error;
if ($error_code == 1) {$error = "Cannot create Socket!"}
elsif ($error_code == 2) {$error = "Username to Short!"}
elsif ($error_code == 3) {$error = "No connection Established!"}
elsif ($error_code == 4) {$error = "Already Logged on with This User
Name!"}
elsif ($error_code == 5) {$error = "Not Connected!"}
elsif ($error_code == 6) {$error = "User Successfully Added!"}
elsif ($error_code == 7) {$error = "Error Registering User!"}
elsif ($error_code == 8) {$error = "Already Logged Out!"}
else {$error = "Unkown Error!"}
$buffer->insert(($buffer->get_end_iter), "$error\n");
my $error_dialog = Gtk2::MessageDialog->new($main_window, 'destroy-
with-parent', 'error', 'ok', "$error");
$error_dialog->run;
$error_dialog->destroy;
}
#-------------------blocking-------------------
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;
$socket->blocking(0);
}
#-------------------Message Waiting-------------------
# Wait for incoming messages from the server relayed from clients
sub wait_for_msg {
if ($conn_stat eq 'connected') {
my ($list_size, $msg);
my $server;
my $rv;
my $data;
# check for new information on the connections we have
# anything to read or accept?
foreach $server ($select->can_read(1)) {
# read data
$data = '';
$rv = $server->recv($data, 'POSIX::BUFSIZ', 0);
$inbuffer{$server} .= $data;
# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
while ($inbuffer{$server} =~ s/(.*\n)//) {
push( @{$ready{$server}}, $1 );
}
}
# Any complete requests to process?
foreach $server (keys %ready) {
handle($server);
}
}
}
#-------------------Handler-------------------
# handle($socket) deals with all pending requests for $client
sub handle {
# requests are in $ready{$server}
# send output to $outbuffer{$server}
my $server = shift;
my $request;
foreach $request (@{$ready{$server}}) {
# $request is the text of the request
# put text of reply into $outbuffer{$client}
chomp $request;
process_incoming($server, $request);
}
delete $ready{$server};
}
#-------------------Process Incoming-------------------
sub process_incoming {
my ($server, $msg) = @_;
my @logged_users;
my @rcvd_msg = split(/::/, $msg);
if ($rcvd_msg[1] eq "1") {
# Login responses
# 12 = already logged on
# 03 = logged in
if($rcvd_msg[2] eq "03") {
print "Successfully Logged in!\n";
} elsif ($rcvd_msg[2] eq "12") {
popup_err(4);
} else {
# Create pop-up for error!
print "Error Logging in ", $msg, "\n";
popup_err(5);
}
}
elsif ($rcvd_msg[1] eq "7") {
# receive global message
print "$msg\n";
rcv_msg_all($rcvd_msg[3], $rcvd_msg[4]);
} else {
print "Unrecognized response: $msg\n";
exit(0);
}
}
#-------------------Send message to all-------------------
sub send_msg_all {
my ($msg) = @_;
print "$conn\n";
if(defined $conn) {
# Send a the Message to server
print "Sending\n";
print $conn "7\:\:$user\:\:$msg\n";
} else {
popup_err(3);
}
}
#-------------------Send login-------------------
#logs the user name on the server
sub send_login {
if(defined $conn) {
if(length($user) > 0) {
#send login to server
print $conn "1\:\:$user\n";
} else {
popup_err(2);
}
} else {
popup_err(3);
}
}
#-------------------Display All Message-------------------
sub rcv_msg_all {
my ($from, $msg) = @_;
print "Received Global message:\n";
if(defined $conn) {
print "Already Connected: Proceeding with message!\n";
# $status->insert('end',"$from: $msg\n");
} else {
print "No connection established!\n";
popup_err(3);
}
}
------------------------------
Date: Thu, 17 Jan 2008 20:43:05 +0100 (CET)
From: Jim Cochrane <allergic-to-spam@no-spam-allowed.org>
Subject: Re: In perl 5.10, is $needle ~~ @haystack binary search?
Message-Id: <slrnfovbu9.lkm.allergic-to-spam@no-spam-allowed.org>
On 2008-01-16, Keith Keller <kkeller-usenet@wombat.san-francisco.ca.us> wrote:
> On 2008-01-16, nolo contendere <simon.chao@fmr.com> wrote:
>> On Jan 16, 1:19 pm, Jim Cochrane <allergic-to-s...@no-spam-
>> allowed.org> wrote:
>>>
>>> Sorry for interrupting and pardon my ignorance, but what is the ~~
>>> operator? I don't see it in 'perldoc perlop' (for perl 5.8.6). And I
>>> cannot figure out how to search for "~~" in google.
>>
>> This is for Perl 5.10.
>>
>> Check out Equality Operators:
>> "smart match"
>> http://perldoc.perl.org/perlop.html
>
> Or try
>
> http://perldoc.perl.org/perlsyn.html#Smart-matching-in-detail
>
> which has the full chart which Joost referenced.
>
> --keith
>
Thanks, all, for the answers and links.
By the way, does anyone know how to search for something like
perl ~~
on google? I've not been able to figure out a way. (Perhaps it's not
possible.)
--
------------------------------
Date: Fri, 18 Jan 2008 02:01:36 +0000 (UTC)
From: Ilya Zakharevich <nospam-abuse@ilyaz.org>
Subject: Re: incorrect errno/perror with IO::socket->new
Message-Id: <fmp1a0$b8n$1@agate.berkeley.edu>
[A complimentary Cc of this posting was sent to
brandon
<brandon.mayfield@att.net>], who wrote in article <d3b7320c-30dc-4ac4-a552-7d7049a10d9d@1g2000hsl.googlegroups.com>:
> I have been having fits getting meaningful errno/perror values out of
> Perl from Socket->new() and I am hoping someone here might know what
> is going on.
I wonder why nobody told this yet: proof of a pudding is in a truss.
Hope this helps,
Ilya
------------------------------
Date: Thu, 17 Jan 2008 12:59:12 -0800 (PST)
From: "comp.llang.perl.moderated" <ced@blv-sam-01.ca.boeing.com>
Subject: Re: Shrink large file according to REG_EXP
Message-Id: <c627ebae-e0bf-421c-bf7c-d57c2a3bb8b4@m34g2000hsb.googlegroups.com>
On Jan 16, 9:28 am, thellper <thell...@gmail.com> wrote:
> Hello,
> I've a problem to solve, and I need some help, please.
> I've as input a large text file (up to 5GB) which I need to filter
> according some REG_EXP and then I need to write the filtered
> (hopefully smaller) output to another file.
> The filtering applies row-by-row: a row is splitted according to some
> rules in various pieces, then some of the pieces are checked according
> to some REG_EXP, and if a match is found, the whole line is written to
> the output.
>...
Just a guess but splitting into pieces and then applying the regex
to each piece may well be a signifcant slowdown. Have you considered
trying to tweak the regex to avoid the split and resultant copies...
--
Charles DeRykus
------------------------------
Date: Thu, 17 Jan 2008 22:52:41 +0000 (UTC)
From: Ilya Zakharevich <nospam-abuse@ilyaz.org>
Subject: Re: Shrink large file according to REG_EXP
Message-Id: <fmom7p$840$1@agate.berkeley.edu>
[A complimentary Cc of this posting was sent to
Uri Guttman
<uri@stemsystems.com>], who wrote in article <x7abn4u70f.fsf@mail.sysarch.com>:
> In versions 5.6 and later, Perl won't recompile the regular expression
> if the variable hasn't changed, so you probably don't need the /o
> option. It doesn't hurt, but it doesn't help either.
Yet another case of broken documentation. Still, //o helps (though
nowhere as dramatically as before). It avoids CHECKING that the
pattern did not change.
Hope this helps,
Ilya
------------------------------
Date: 18 Jan 2008 01:36:38 GMT
From: John Bokma <john@castleamber.com>
Subject: Re: Shrink large file according to REG_EXP
Message-Id: <Xns9A28C77D7D716castleamber@130.133.1.4>
Ilya Zakharevich <nospam-abuse@ilyaz.org> wrote:
> Yet another case of broken documentation.
Important question: how can this be fixed?
Preferable both:
- the documentation itself,
- and a way to make the fixing process easier (wiki?)
--
John
http://johnbokma.com/mexit/
------------------------------
Date: Thu, 17 Jan 2008 12:35:53 -0800 (PST)
From: clearguy02@yahoo.com
Subject: To update one file with the another file's data..
Message-Id: <c6717049-bffe-4bdf-bcee-8308d0a7668b@m34g2000hsf.googlegroups.com>
Hi,
I have two text files: each one has has four fields (delimited by a
space) on each line: id, group, email and manager_id. First file is a
small file with 50 entries and the second one is a huge file with
5,000 entries. The "id" field is same in both files, but the
manager_id's may be different. By comparing all the entries in the
second file (that has the correct manager id), I need to update the
manager_id field in the first file.
Here is the code, I am thinking of:
-----------------------------------------
open (INPUT1,"smallFile.txt") or die "Cannot open the file: $!";
open (INPUT2,"bigFile.txt") or die "Cannot open the file: $!";
while $line1 (<INPUT1>)
{
@small_arr = split /\s+/, $line1;
}
while $line2 (<INOUT2>)
{
@big_arr = split /\s+/, $line2;
}
foreach (@small_arr)
{
if ($small_arr[0] == $big_arr[0] ) # first ID is same in both
files
{
$small_arr[3] = $big_arr[3];
print "$_\n";
}
}
-------------------------------------------------
I know some thing is certainly wrong here. can some one tell me pl.?
Thanks,
J
------------------------------
Date: Thu, 17 Jan 2008 13:29:34 -0800 (PST)
From: davidfilmer@gmail.com
Subject: Re: To update one file with the another file's data..
Message-Id: <997f0335-73ba-4268-99c1-7a4fe9f8625d@d21g2000prf.googlegroups.com>
On Jan 17, 12:35 pm, cleargu...@yahoo.com wrote:
> while $line1 (<INPUT1>)
> {
> @small_arr = split /\s+/, $line1;
> }
You are reading the entire file and assigning the fields of each line
to an array. But the array only holds the fields of a single line.
By the time the while loop is done, the array holds only the fields
for the last line of the file. You have thrown away all the rest of
the file. Same thing for your second loop. That's the main reason
why your program doesn't work.
I would approach it by building a hash of the id/manager values from
the big file and then running through the second file to make the
corrections. Here's an example suitable for a newsgroup posting which
uses a DATA block for the big file and a hardcoded array for the small
file. In reality these would both be files, and you would read the
second file one-line-at-a-time with a while loop.
#!/usr/bin/perl
use strict; use warnings;
my @small = (
"id2 group1 email1 WRONG1",
"id3 group3 email3 mgr3",
"id5 group5 email5 WRONG2",
);
my %big_file_mgr;
while (<DATA>) {
my ($id, $mgr) = (split(/\s+/, $_))[0,3];
$big_file_mgr{$id} = $mgr;
}
foreach (@small) { #this would be: while (<SMALL>) {
my ($id, $group, $email, $mgr) = (split(/\s+/, $_));
$mgr = $big_file_mgr{$id} if $big_file_mgr{$id};
print "$id $group $email $mgr\n";
}
__DATA__
id1 group1 email1 mgr1
id2 group2 email2 mgr2
id3 group3 email3 mgr3
id4 group4 email4 mgr4
id5 group5 email5 mgr5
--
The best way to get a good answer is to ask a good question.
David Filmer (http://DavidFilmer.com)
------------------------------
Date: Thu, 17 Jan 2008 23:48:33 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: To update one file with the another file's data..
Message-Id: <5va4a5F1l3bjgU1@mid.individual.net>
clearguy02@yahoo.com wrote:
> I have two text files: each one has has four fields (delimited by a
> space) on each line: id, group, email and manager_id. First file is a
> small file with 50 entries and the second one is a huge file with
> 5,000 entries. The "id" field is same in both files, but the
> manager_id's may be different. By comparing all the entries in the
> second file (that has the correct manager id), I need to update the
> manager_id field in the first file.
This approach is similar to the one posted by David, both making use of
a hash for 'bigFile.txt'. I chose to use 'Tie::File' for updating
'smallFile.txt'.
use Tie::File;
my %bighash;
# Put the data of 'bigFile.txt' into %bighash;
open my $BIG, '<', 'bigFile.txt' or die $!;
while ( <$BIG> ) {
chomp;
my ( $key, $value ) = split ' ', $_, 2;
$bighash{ $key } = $value;
}
# Update manager_id of 'smallFile.txt' if needed
tie my @small, 'Tie::File', 'smallFile.txt' or die $!;
foreach my $line ( @small ) {
my @fields = split ' ', $line;
my $man_id_big = ( split ' ', $bighash{ $fields[0] } )[2];
if ( $fields[3] ne $man_id_big ) {
$line = join ' ', @fields[ 0..2 ], $man_id_big;
}
}
untie @small or die $!;
__END__
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Thu, 17 Jan 2008 16:37:38 -0800
From: David Filmer <usenet@davidfilmer.com>
Subject: Re: To update one file with the another file's data..
Message-Id: <cfednUSxAdIGaRLaRVn_vwA@giganews.com>
Gunnar Hjalmarsson wrote:
> my ( $key, $value ) = split ' ', $_, 2;
FWIW, if the order of the fields in the input file is the same order
that the OP stipulated then this will not grab the correct fields (the
hash needs the first and fourth fields, not the first two fields).
------------------------------
Date: Fri, 18 Jan 2008 01:53:22 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: To update one file with the another file's data..
Message-Id: <5vabk6F1ljn8pU1@mid.individual.net>
David Filmer wrote:
> Gunnar Hjalmarsson wrote:
>> my ( $key, $value ) = split ' ', $_, 2;
--------------------------------------------^
Please note the LIMIT argument.
> FWIW, if the order of the fields in the input file is the same order
> that the OP stipulated then this will not grab the correct fields (the
> hash needs the first and fourth fields, not the first two fields).
The above does not grab only the first two fields; it assigns the first
field to $key and all the other fields to $value.
In the foreach loop I have:
my $man_id_big = ( split ' ', $bighash{ $fields[0] } )[2];
Please feel free to claim that it's a clumsy solution, but it does
address the OP's problem. :) Furthermore, my solution makes it easier
to adapt the code for the case the OP would be interested in altering
also the 'group' and/or 'email' fields.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Thu, 17 Jan 2008 17:53:32 -0800
From: David Filmer <usenet@davidfilmer.com>
Subject: Re: To update one file with the another file's data..
Message-Id: <vp6dnXy185z-mw3a4p2dnAA@giganews.com>
Gunnar Hjalmarsson wrote:
>>> my ( $key, $value ) = split ' ', $_, 2;
> --------------------------------------------^
> Please note the LIMIT argument.
Ah. I had noted it, but had forgotten exactly how it behaved. I was
thinking it split everything and then returned only the first two
splits. Thanks for refreshing my memory on how this limit (which I
seldom use) actually behaves.
------------------------------
Date: Fri, 18 Jan 2008 00:05:10 +0100
From: "Peter J. Holzer" <hjp-usenet2@hjp.at>
Subject: Re: Wait for background processes to complete
Message-Id: <slrnfovnp7.euv.hjp-usenet2@hrunkner.hjp.at>
On 2008-01-17 18:44, pgodfrin <pgodfrin@gmail.com> wrote:
> On Jan 17, 11:14 am, xhos...@gmail.com wrote:
>> pgodfrin <pgodf...@gmail.com> wrote:
>> > Gentle persons,
>>
>> > Xho was right from the start. Apparently all the samples from the
>> > camel book, documentation for fork(), wait() and waitpid() are at the
>> > least misleading - at the worse poorly written.
You may have been mislead, but please tell us what aspect of the
documentation mislead you.
>> > To begin with, if following the camel book's sample:
>>
>> > if ($pid=fork) { # parent here
>> > } elsif { #child here
>> > } # ...
>>
>> > One can indeed fork - but - the wait loop simply doesn't wait because
>> > it returns -1 upon the first iteration.
Compare this with your script:
> @fl= (</fausb/sample/*.txt>);
> foreach (@fl)
> {
> if($pid=fork)
> {
> print "Copying $_ to $_.old\n";
> exec("cp $_ $_.old") ;
> } elsif (defined $pid) { exit; }
> } # end loop
> wait;
>
> print "\n<<<<< End of exercise >>>>>\n";
> exit;
>
> However, this works AND waits.
No, it doesn't. It doesn't work and it doesn't wait.
> But - this is very interesting - the
> last file in the sample list is 3 or 4 times larger than the first few
> files, which permits me to show that the wait does indeed wait for
> child processes, but since the first fork replaces the parent process,
> the wait command no longer has children to wait on and then continues
> to the next statement, while the last cp command is still running.
> @fl= (</fausb/sample/*.txt>);
> foreach (@fl)
> {
> if($pid=fork)
> {
Here we are in the parent process ($pid != 0).
> print "Copying $_ to $_.old\n";
> exec("cp $_ $_.old") ;
You exec the cp command. This means that the parent process will now
execute "cp" instead of your script - after doing this it will exit.
> } elsif (defined $pid) {
Here we are in the child process.
> exit;
You exit immediately, so the child process does absolutely nothing. Why
fork at all if you don't want your child process to do anything?
> }
In any case, neither process will reach the end of the loop. So it will
copy exactly one file and
> } # end loop
since it never gets here it won't wait.
> wait;
You need to exec your program in the *child* process:
@fl= (</fausb/sample/*.txt>);
foreach (@fl)
{
if($pid=fork)
{
# parent - do nothing
} elsif (defined $pid) {
# child
print "Copying $_ to $_.old\n";
exec("cp", $_, "$_.old") ;
# we won't get here if exec worked:
die "exec cp failed: $!";
}
} # end loop
# now wait for all the children:
do {$x=wait; print "$x\n"} until $x==-1 ;
------------------------------
Date: Fri, 18 Jan 2008 00:12:04 +0100
From: "Peter J. Holzer" <hjp-usenet2@hjp.at>
Subject: Re: Wait for background processes to complete
Message-Id: <slrnfovo6b.euv.hjp-usenet2@hrunkner.hjp.at>
On 2008-01-17 00:52, comp.llang.perl.moderated <ced@blv-sam-01.ca.boeing.com> wrote:
> On Jan 16, 2:29 pm, pgodfrin <pgodf...@gmail.com> wrote:
>> On Jan 16, 4:17 pm, xhos...@gmail.com wrote:
>> > ## On Linux, wait returns -1 when there are no living children to wait for.
>> > 1 until -1==wait();
>>
>> > > exit;
>>
>
>> Thanks Xho - I've removed the signal handler, but it seems wait always
>> returns -1 so - the loop is a nop? Where in the code should it go?
>>
>
> I'll pipe in here since the 'quick 'n dirty' solution
> was mangled and diss'ed.
>
> The safest action is an asynchronous wait with a
Before 5.8.0 that was actually unsafe. But while it is now safe in perl
5.8.x (and 5.10.x), it still has the tiny flaw of absolutely *not* doing
what the OP wants. Xho's solution is safe (and was so in all perl
versions and does what the OP wants. Well, almost - wait can return -1
if it is interrupted so one should check $! in addition to the return
value.
hp
------------------------------
Date: 18 Jan 2008 01:12:07 GMT
From: xhoster@gmail.com
Subject: Re: Wait for background processes to complete
Message-Id: <20080117201210.879$PF@newsreader.com>
pgodfrin <pgodfrin@gmail.com> wrote:
>
> Hi Xho,
> OK - I didn't include the wait loop in the snippet simply for brevity.
A little too much brevity often leads to many cycles of posting, which is
anything but brief!
> I tried using the if logic and it just doesn't wait or fork properly.
> Since I'm looping though filenames, this is inadequate. Unless proven
> otherwise - I'll say the Camel book code is unclear and incorrect for
> my purposes:
Peter has already described what went wrong here--you reversed the
parent and child roles in your code (which I snipped). If there is a
specific part of the perldoc that mislead you into doing that, let's figure
it out what that was and have it fixed. (The Camel book, I don't know how
to get that fixed so am slightly less interested in it.)
...
> However, this works AND waits. But - this is very interesting - the
> last file in the sample list is 3 or 4 times larger than the first few
> files, which permits me to show that the wait does indeed wait for
> child processes, but since the first fork replaces the parent process,
> the wait command no longer has children to wait on and then continues
> to the next statement, while the last cp command is still running.
I don't know what you meant by "the first fork replaces the parent process"
but whatever you meant I suspect it is heading the wrong way. What the
code below does is wait for one child, presumably whichever child
finishes first. Then it prints and exits, while N-1 other children are
still running. Some shells' "wait" can wait for all children. Perl's
"wait", like C's "wait", does not. It waits for one child.
>
> @fl= (</fausb/sample/*.txt>);
> foreach (@fl)
> {
> print "Copying $_ to $_.old\n";
> fork or exec("cp $_ $_.old") ;
> } # end loop
> wait;
> print "\n<<<<< End of exercise >>>>>\n";
> exit;
>
> But - that's no good - which necessitates the loop you had suggested
> from the start.
The reason the loop works is that instead of just calling wait once, it
calls "wait" over and over until the OS says "Hey bozo, there is nothing
left to wait for". Well, it actually doesn't say that, it just returns -1,
but "Hey bozo..." is what it means.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
The costs of publication of this article were defrayed in part by the
payment of page charges. This article must therefore be hereby marked
advertisement in accordance with 18 U.S.C. Section 1734 solely to indicate
this fact.
------------------------------
Date: Thu, 17 Jan 2008 17:34:31 -0800 (PST)
From: "comp.llang.perl.moderated" <ced@blv-sam-01.ca.boeing.com>
Subject: Re: Wait for background processes to complete
Message-Id: <e38bf1f8-8b68-4ef5-9ff1-ecb88dfa5655@y5g2000hsf.googlegroups.com>
On Jan 17, 3:12 pm, "Peter J. Holzer" <hjp-usen...@hjp.at> wrote:
> On 2008-01-17 00:52, comp.llang.perl.moderated <c...@blv-sam-01.ca.boeing.com> wrote:
>
>
>
> > On Jan 16, 2:29 pm, pgodfrin <pgodf...@gmail.com> wrote:
> >> On Jan 16, 4:17 pm, xhos...@gmail.com wrote:
> >> > ## On Linux, wait returns -1 when there are no living children to wait for.
> >> > 1 until -1==wait();
>
> >> > > exit;
>
> >> Thanks Xho - I've removed the signal handler, but it seems wait always
> >> returns -1 so - the loop is a nop? Where in the code should it go?
>
> > I'll pipe in here since the 'quick 'n dirty' solution
> > was mangled and diss'ed.
>
> > The safest action is an asynchronous wait with a
>
> Before 5.8.0 that was actually unsafe. But while it is now safe in perl
Huh.. just for clarity, here's what I wrote:
use POSIX ":sys_wait_h";
$SIG{CHLD} = \&REAPER;
# now do something that forks...
...
sub REAPER { 1 while waitpid(-1, WNOHANG)) > 0; }
In fact, historically, there's a clear recommendation to tight-loop
exactly as shown because you may lose signals occurring in
near concurrency if you don't. Or are you
suggesting that an explicit wait on each of
the child processes would somehow be safer...
> 5.8.x (and 5.10.x), it still has the tiny flaw of absolutely *not* doing
> what the OP wants. Xho's solution is safe (and was so in all perl
> versions and does what the OP wants. Well, almost - wait can return -1
> if it is interrupted so one should check $! in addition to the return
> value.
>
You're right, a asynchronous wait would need to
save child pids and loop until they're reaped.
I believe a such a solution was already shown.
--
Charles DeRykus
------------------------------
Date: Thu, 17 Jan 2008 18:02:16 -0800 (PST)
From: grocery_stocker <cdalten@gmail.com>
Subject: Re: Wait for background processes to complete
Message-Id: <96c6b297-470d-47fc-abfa-6948cde802cf@v29g2000hsf.googlegroups.com>
On Jan 16, 9:37 pm, Ben Morrow <b...@morrow.me.uk> wrote:
> Quoth grocery_stocker <cdal...@gmail.com>:
>
>
>
> > On Jan 13, 10:09 pm, Ben Morrow <b...@morrow.me.uk> wrote:
>
> <snip>
> > > $SIG{CHLD} = sub {
> > > my ($pid, @died);
> > > push @died, $pid while $pid = waitpid -1, WNOHANG;
> > > delete @kids{@died};
> > > };
> <snip>
> > > if ($pid) {
> > > $kids{$pid} = 1;
> > > return;
> > > }
> <snip>
> > > sub finish {
> > > waitpid $_, 0 for keys %kids;
> > > %kids = ();
> > > }
>
> > I really don't grasp the significance of having $kids{$pid} equal 1.
> > Can some enlighten me o this?
>
> It's one of the standard idioms for using a hash as a set. Every time we
> create a child, we add an entry to the hash; every time one dies on its
> own, we delete its entry. Then at the end we can use keys %pids to
> retrieve the list of pids we still need to wait for. The only thing that
> matters about %kids are its keys: we never use the values, so they can
> be set to anything. I prefer using 1 since then the values are all true;
> you can get slightly better memory use with
>
> $kids{$pid} = ();
>
> which inserts the key but doesn't create a value for it at all, but then
> you have to test with exists, which I find annoying. Since in this case
> I don't test for existance of keys at all, this doesn't matter: using 1 is
> just a habit.
>
> Ben
Okay, why would you have to test for exists if
$kids{$pid} = ();
just creates something like undef.
------------------------------
Date: 17 Jan 2008 19:28:47 GMT
From: John Bokma <john@castleamber.com>
Subject: Re: Working with a 1-GB XML file...
Message-Id: <Xns9A28891FAC035castleamber@130.133.1.4>
kj <socyl@987jk.com.invalid> wrote:
>
>
>
> Hi. I have a large XML file (aboug 1G) that I would like to be
> able to interrogate in my code. Given its size, it's out of the
> question to read it all into memory. I'd like to avoid having to
> convert this thing to an RDB.
>
> Does anyone know of a module that can treat such a file as
> disk-resident data?
It all depends a lot on /what/ is in the XML file. If it are records you
have to process one by one, XML::Twig might be the right answer. If you
have to process the file in a stream based way SAX or similar module might
be the answer.
--
John
http://johnbokma.com/
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 V11 Issue 1209
***************************************
