[29646] in Perl-Users-Digest
Perl-Users Digest, Issue: 890 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Sep 29 03:09:39 2007
Date: Sat, 29 Sep 2007 00:09:05 -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 Sat, 29 Sep 2007 Volume: 11 Number: 890
Today's topics:
[NEWBIE] Trivial? <el_bandolero@libero.it>
Re: [NEWBIE] Trivial? <dummy@example.com>
Re: creating something M$ Excel can read? <stoupa@practisoft.cz>
Get unlimited visitors to your website ashishmundhara108@gmail.com
How to filter out lines from a variable that has multi- <needpassion@gmail.com>
Re: How to filter out lines from a variable that has mu <Narthring@gmail.com>
Re: How to filter out lines from a variable that has mu <tadmc@seesig.invalid>
new CPAN modules on Sat Sep 29 2007 (Randal Schwartz)
Re: string concatentation vs. interpolation: which one <rihad@mail.ru>
Re: The Modernization of Emacs: terminology buffer and <dkixk@earthlink.net>
Re: Trying to start a perl script as Windows Service <ben@morrow.me.uk>
Using fcntl and |= - "Argument .... isn't numeric in bi <allergic-to-spam@no-spam-allowed.org>
Re: Using fcntl and |= - "Argument .... isn't numeric i <ben@morrow.me.uk>
Re: using IPC::Open3 to write to *and* read from a proc <ben@morrow.me.uk>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 29 Sep 2007 07:39:57 +0200
From: El Bandolero <el_bandolero@libero.it>
Subject: [NEWBIE] Trivial?
Message-Id: <85r5hevcxjso.11ta1nxg6fgl7.dlg@40tude.net>
I'm solving an exercise studying on a tutorial
The task is to print the (empty or not) lines of a file numbering only the
non empty ones.
How the h### is possible that the following code gives the same result if I
change line 9 with the opposite condition?
if (!$lines[$i]=="")
1 #!/usr/bin/perl
2 #
3 $file = 'C:\Perl\html\Artistic.txt';
4 open(PIP, $file);
5 @lines = <PIP>;
6 close(PIP);
7 for ($i=0;$i <= @lines;++$i)
8 {
9 if ($lines[$i]=="")
10 {print $i." ".$lines[$i]};
11 }
--
ciao
Bando
------------------------------
Date: Sat, 29 Sep 2007 06:53:30 GMT
From: "John W. Krahn" <dummy@example.com>
Subject: Re: [NEWBIE] Trivial?
Message-Id: <KDmLi.115794$bO6.81392@edtnps89>
El Bandolero wrote:
> I'm solving an exercise studying on a tutorial
>
> The task is to print the (empty or not) lines of a file numbering only the
> non empty ones.
>
> How the h### is possible that the following code gives the same result if I
> change line 9 with the opposite condition?
> if (!$lines[$i]=="")
>
> 1 #!/usr/bin/perl
> 2 #
> 3 $file = 'C:\Perl\html\Artistic.txt';
> 4 open(PIP, $file);
> 5 @lines = <PIP>;
> 6 close(PIP);
> 7 for ($i=0;$i <= @lines;++$i)
> 8 {
> 9 if ($lines[$i]=="")
> 10 {print $i." ".$lines[$i]};
> 11 }
How is it possible? The expressions $lines[$i] and !$lines[$i] are both
*numerically* equal to the string "", unless the contents of $lines[$i] start
with numerical digits. In Perl, any non-numeric string has the numeric value
of zero so 0 == 0 is always true.
You should enable warnings and perl would have informed you that you are using
numerical comparison on strings instead of numbers.
#!/usr/bin/perl
use warnings;
use strict;
my $file = 'C:/Perl/html/Artistic.txt';
open my $PIP, '<', $file or die "Cannot open '$file' $!";
while ( <$PIP> ) {
print $. - 1, " $_" if /^$/;
}
close $PIP;
__END__
John
--
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order. -- Larry Wall
------------------------------
Date: Sat, 29 Sep 2007 05:08:09 +0200
From: "Petr Vileta" <stoupa@practisoft.cz>
Subject: Re: creating something M$ Excel can read?
Message-Id: <fdkfqd$1osr$1@ns.felk.cvut.cz>
Mark Hobley wrote:
> Mike <mikee@mikee.ath.cx> wrote:
>> Is there some way to generate a file on linux that contains
>> formulas, formatting, etc, that can be read by Excel?
>
> Microsoft Excel can read comma separated lists (.csv files). I would
> create a test file, and try importing it into Excel.
>
And you can use a little trick. Because Excel is stupid (or inteiligent?)
you can create standard CSV file but name it as *.XLS :-) Really! Try it ;-)
--
Petr Vileta, Czech republic
(My server rejects all messages from Yahoo and Hotmail. Send me your mail
from another non-spammer site please.)
------------------------------
Date: Fri, 28 Sep 2007 20:24:13 -0700
From: ashishmundhara108@gmail.com
Subject: Get unlimited visitors to your website
Message-Id: <1191036253.090503.269180@k79g2000hse.googlegroups.com>
Is your website getting very less no. of visitors .If so, then post
your website to http://goodtolove.com to get unlimited visitors for
lifetime...No need to pay a penny.
------------------------------
Date: Fri, 28 Sep 2007 18:09:43 -0700
From: mike <needpassion@gmail.com>
Subject: How to filter out lines from a variable that has multi-lines?
Message-Id: <1191028183.459008.233480@y42g2000hsy.googlegroups.com>
suppose a variable $a has multi-lines, e.g.
happy
new
new password
year
get password of micky
LOL
What is best way to filter out lines that have "password" involved?
Thanks in advance
------------------------------
Date: Sat, 29 Sep 2007 01:25:10 -0000
From: Narthring <Narthring@gmail.com>
Subject: Re: How to filter out lines from a variable that has multi-lines?
Message-Id: <1191029110.184523.279810@o80g2000hse.googlegroups.com>
On Sep 28, 8:09 pm, mike <needpass...@gmail.com> wrote:
> suppose a variable $a has multi-lines, e.g.
>
> happy
> new
> new password
> year
> get password of micky
> LOL
>
> What is best way to filter out lines that have "password" involved?
> Thanks in advance
One way would be to split on newlines and use a regular expression to
filter out 'password':
use strict;
use warnings;
my $text = '
happy
new
new password
year
get password of micky
LOL';
my (@array) = split(/\n/, $text);
my ($result);
foreach my $line (@array){
$result .= "$line\n" unless ($line =~ m/password/);
}
print "$result";
------------------------------
Date: Fri, 28 Sep 2007 20:47:08 -0500
From: Tad McClellan <tadmc@seesig.invalid>
Subject: Re: How to filter out lines from a variable that has multi-lines?
Message-Id: <slrnffrbks.gnq.tadmc@tadmc30.sbcglobal.net>
mike <needpassion@gmail.com> wrote:
> suppose a variable $a has multi-lines, e.g.
>
> happy
> new
> new password
> year
> get password of micky
> LOL
>
> What is best way to filter out lines that have "password" involved?
$a =~ s/.*password.*\n//g;
--
Tad McClellan
email: perl -le "print scalar reverse qq/moc.noitatibaher\100cmdat/"
------------------------------
Date: Sat, 29 Sep 2007 04:42:17 GMT
From: merlyn@stonehenge.com (Randal Schwartz)
Subject: new CPAN modules on Sat Sep 29 2007
Message-Id: <Jp452H.xEz@zorch.sf-bay.org>
The following modules have recently been added to or updated in the
Comprehensive Perl Archive Network (CPAN). You can install them using the
instructions in the 'perlmodinstall' page included with your Perl
distribution.
Apache2-Filter-Minifier-CSS-1.03
http://search.cpan.org/~gtermars/Apache2-Filter-Minifier-CSS-1.03/
CSS minifying output filter
----
Apache2-Filter-Minifier-JavaScript-1.03
http://search.cpan.org/~gtermars/Apache2-Filter-Minifier-JavaScript-1.03/
JS minifying output filter
----
Atompub-0.1.8
http://search.cpan.org/~takeru/Atompub-0.1.8/
Atom Publishing Protocol implementation
----
C-Scan-Constants-1.016
http://search.cpan.org/~icerider/C-Scan-Constants-1.016/
Slurp constants from specified C header (.h) files
----
CGI-Application-Plugin-DBIProfile-0.03
http://search.cpan.org/~unrtst/CGI-Application-Plugin-DBIProfile-0.03/
DBI profiling plugin
----
CGI-Application-Plugin-Mason-1.01
http://search.cpan.org/~holly/CGI-Application-Plugin-Mason-1.01/
HTML::Mason plugin for CGI::Application
----
CPAN-1.9202
http://search.cpan.org/~andk/CPAN-1.9202/
query, download and build perl modules from CPAN sites
----
CPAN-1.9203
http://search.cpan.org/~andk/CPAN-1.9203/
query, download and build perl modules from CPAN sites
----
Class-Root-0.01
http://search.cpan.org/~nif/Class-Root-0.01/
framework for writing perl OO modules
----
Class-Singleton-1.4
http://search.cpan.org/~abw/Class-Singleton-1.4/
Implementation of a "Singleton" class
----
Coat-0.1_0.5
http://search.cpan.org/~sukria/Coat-0.1_0.5/
A light and self-dependent meta-class for Perl5
----
Crypt-CBC-2.24
http://search.cpan.org/~lds/Crypt-CBC-2.24/
Encrypt Data with Cipher Block Chaining Mode
----
Crypt-Skip32-0.05
http://search.cpan.org/~esh/Crypt-Skip32-0.05/
32-bit block cipher based on Skipjack
----
DBI-Printf-0.02
http://search.cpan.org/~kazuho/DBI-Printf-0.02/
A printf-style prepared statement
----
DBI-Printf-0.03
http://search.cpan.org/~kazuho/DBI-Printf-0.03/
A printf-style prepared statement
----
DBIx-Printf-0.04
http://search.cpan.org/~kazuho/DBIx-Printf-0.04/
A printf-style prepared statement
----
DBM-Deep-1.0004
http://search.cpan.org/~rkinyon/DBM-Deep-1.0004/
A pure perl multi-level hash/array DBM that supports transactions
----
DateTime-Format-Natural-0.51
http://search.cpan.org/~schubiger/DateTime-Format-Natural-0.51/
Create machine readable date/time with natural parsing logic
----
FormValidator-Simple-Plugin-Trim-1.00
http://search.cpan.org/~ash/FormValidator-Simple-Plugin-Trim-1.00/
Trim fields for FormValidator::Simple
----
GD-Icons-0.03
http://search.cpan.org/~pcanaran/GD-Icons-0.03/
Utility for generating series of icons of varying color and shapes
----
Goo-Canvas-0.01
http://search.cpan.org/~yewenbin/Goo-Canvas-0.01/
Perl extension for blah blah blah
----
Goo-Canvas-0.02
http://search.cpan.org/~yewenbin/Goo-Canvas-0.02/
Perl interface to the GooCanvas
----
Google-Checkout-1.1.1
http://search.cpan.org/~dzhuo/Google-Checkout-1.1.1/
----
Gungho-0.08007
http://search.cpan.org/~dmaki/Gungho-0.08007/
Yet Another High Performance Web Crawler Framework
----
HTML-DOM-0.006
http://search.cpan.org/~sprout/HTML-DOM-0.006/
A Perl implementation of the HTML Document Object Model
----
HTML-GMap-0.05
http://search.cpan.org/~pcanaran/HTML-GMap-0.05/
Generic framework for building Google Maps displays
----
HTML-SearchPage-0.04
http://search.cpan.org/~pcanaran/HTML-SearchPage-0.04/
Generic framework for building web-based search pages
----
Hook-Modular-0.05
http://search.cpan.org/~marcel/Hook-Modular-0.05/
making pluggable applications easy
----
Language-Befunge-3.00
http://search.cpan.org/~jquelin/Language-Befunge-3.00/
a Befunge-98 interpreter
----
LockFile-Simple-0.206
http://search.cpan.org/~jv/LockFile-Simple-0.206/
simple file locking scheme
----
MogileFS-Plugin-MultiHook-0.02
http://search.cpan.org/~zigorou/MogileFS-Plugin-MultiHook-0.02/
MogileFS plugins for using multiple hooks
----
MogileFS-Plugin-MultiHook-0.03
http://search.cpan.org/~zigorou/MogileFS-Plugin-MultiHook-0.03/
MogileFS plugins for using multiple hooks
----
Net-UCP-0.27
http://search.cpan.org/~nemux/Net-UCP-0.27/
Perl extension for EMI - UCP Protocol.
----
Perl-Configure-0.05
http://search.cpan.org/~mschilli/Perl-Configure-0.05/
Answer perl's ./Configure questions reproducibly
----
PowerTools-Data-0.04
http://search.cpan.org/~gbshouse/PowerTools-Data-0.04/
Additional Perl tool for Apache::ASP - MySQL database connection
----
PowerTools-Upload-Blob-0.03
http://search.cpan.org/~gbshouse/PowerTools-Upload-Blob-0.03/
Additional Perl tool for Apache::ASP data uploading
----
PowerTools-Upload-File-0.03
http://search.cpan.org/~gbshouse/PowerTools-Upload-File-0.03/
Additional Perl tool for Apache::ASP data uploading
----
SMS-Send-US-Verizon-v0.0.1
http://search.cpan.org/~klohner/SMS-Send-US-Verizon-v0.0.1/
SMS::Send driver for the text.vzw.com website
----
SWF-0.4.0-beta6_1
http://search.cpan.org/~liscovius/SWF-0.4.0-beta6_1/
an autoloadable interface module for Ming - a library for generating SWF ("Flash") format movies.
----
Text-Scan-0.30
http://search.cpan.org/~tbusch/Text-Scan-0.30/
Fast search for very large numbers of keys in a body of text.
----
TinyAuth-0.95
http://search.cpan.org/~adamk/TinyAuth-0.95/
Extremely light-weight web-based authentication manager
----
Tk-Date-0.42_51
http://search.cpan.org/~srezic/Tk-Date-0.42_51/
a date/time widget for perl/Tk
----
Unix-PID-v0.0.12
http://search.cpan.org/~dmuey/Unix-PID-v0.0.12/
Perl extension for getting PID info.
----
Unix-PID-v0.0.13
http://search.cpan.org/~dmuey/Unix-PID-v0.0.13/
Perl extension for getting PID info.
----
XML-LibXML-Iterator-1.04
http://search.cpan.org/~phish/XML-LibXML-Iterator-1.04/
XML::LibXML's Tree Iteration Class
If you're an author of one of these modules, please submit a detailed
announcement to comp.lang.perl.announce, and we'll pass it along.
This message was generated by a Perl program described in my Linux
Magazine column, which can be found on-line (along with more than
200 other freely available past column articles) at
http://www.stonehenge.com/merlyn/LinuxMag/col82.html
print "Just another Perl hacker," # the original
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Fri, 28 Sep 2007 23:58:19 -0700
From: rihad <rihad@mail.ru>
Subject: Re: string concatentation vs. interpolation: which one is more optimal?
Message-Id: <1191049099.530113.280240@d55g2000hsg.googlegroups.com>
On Sep 28, 8:28 pm, Ben Morrow <b...@morrow.me.uk> wrote:
> When you start looking at the speed of things like this and actaully
> caring about the answer, you'll probably find that Perl is not the
> right tool for the job. Perl is really fast, but if this sort of
> operation is too slow for you, then the bigger tasks in Perl, uch as
> using a module, will just kill your performance (relatively).
I'm not saying I want Perl to be faster than assembly. I just want to
write fastest Perl code I can, all constrained within Perl's own
performance overhead. Imagine tomorrow there will be (if not already)
some Perl hardware executing opcode natively, and then what, all of a
sudden micro-tunings begin to make sense? In this respect, I don't
believe there's any obvious reason to take the sub-optimal path in any
language (if you have the time).
> > Still... why shouldn't Perl (or language Foo) programmers care about
> > efficiency if OS programmers _do_ care?
>
> The point is, you should care when, and only when, it matters. Worrying
> about micro-optimization without having profiled first is always a waste
> of time, and only leads to writing illegible code.
>
I couldn't agree more. I'm only micro-optimizing obvious usage
patterns such as string interpolation/concatenation vs. list (such as
print "$foo $bar"; vs. print $foo, ' ', $bar;) which is *always*
faster by its nature. In assembly, one would surely be using "inc
[mem]" instead of "add [mem], 1" because the former is more optimal
[sic].
------------------------------
Date: Fri, 28 Sep 2007 18:27:04 -0500
From: Damien Kick <dkixk@earthlink.net>
Subject: Re: The Modernization of Emacs: terminology buffer and keybinding
Message-Id: <13frd6vtarbee75@corp.supernews.com>
Giorgos Keramidas wrote:
> On Fri, 22 Jun 2007 23:08:02 -0000, nebulous99@gmail.com wrote:
>> So much for the "free" in "free software". If you can't actually use
>> it without paying money, whether for the software or for some book, it
>> isn't really free, is it?
>
> Please do not confuse the term 'free' in 'free software' with 'gratis'.
>
> 'Gratis', i.e. 'lacking a monetary price tag' is something *very*
> different from the meaning of 'free' in 'free software'.
If you were referring to the "free" in "free Mumia Abu Jamal", I would
agree with you. I don't think anyone would imagine that this phrase
meant that someone was going to get Mumia Abu Jamal gratis. Like it or
not, "free software" referring to "free as in beer" is probably the most
common interpretation of the phrase for a native English speaker.
Admittedly, I do not have a "scientific" survey handy. However, I just
asked my wife--who has absolutely no interest in anything related to
programming, has never heard of the FSF, Eric Raymond, nor the
disagreement between those two camps, nor probably will she ever have an
interest--what she thinks I mean when I say "free software". After
getting over the "why are you asking such a stupid question" phase, the
first thing that jumped to her mind was "free as in beer". You can
stamp, growl, swagger, spit, curse, and bluster all you want on this
point, but millions of English speakers are going to ignore you anyway.
Lucky for most of them, they do not have to suffer the lectures of
sociopolitically motivated language mavens trying to "correct" them from
the error of mistaking the meaning of a phrase to be the normal meaning
of that phrase.
------------------------------
Date: Sat, 29 Sep 2007 01:30:22 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Trying to start a perl script as Windows Service
Message-Id: <uti0t4-rbg1.ln1@osiris.mauzo.dyndns.org>
Quoth "dn.perl@gmail.com" <dn.perl@gmail.com>:
> On Sep 28, 11:46 am, Bill H <b...@ts1000.us> wrote:
> > On Sep 28, 12:45 pm, "dn.p...@gmail.com" <dn.p...@gmail.com> wrote:
> >
> > > I want to run a perl script which will continue running on Windows XP
> > > even after I log off, the way nohup works in Unix. A recommended way
> > > of doing it is to run the application as Windows Service. Accordingly
> > > I wrote a test script (myscript.pl), which prints a line every 10
> > > seconds in an infinite loop :
> > > Time is 2007-09-27 16:22:25
> > > Time is 2007-09-27 16:22:35
> > > Time is 2007-09-27 16:22:45
> >
> > > I created a service for the perl script. When I start the service, it
> > > stops immediately.
> > > The message is : The print_tstamp service on local computer started
> > > and then stopped. Some services stop automatically if they have no
> > > work to do, for example, the Performance Logs and Alerts service.
> >
> > Just a guess - but did it stop because you closed the window, which
> > means it had no place to print (maybe gets an error?)
>
> Well, I am printing (concatenating) the string to a file.
> I tried to run the service with perl, and also with wperl.
> But so far nothing has worked. When I log off, the process
> terminates.
To run an arbitrary program as a windows service you need to use srvany
from the Resource Kit. I don't really know why, but it's to do with how
Windows expects a service to behave. See
http://support.microsoft.com/kb/137890 .
Ben
------------------------------
Date: Sat, 29 Sep 2007 03:15:25 +0200 (CEST)
From: Jim Cochrane <allergic-to-spam@no-spam-allowed.org>
Subject: Using fcntl and |= - "Argument .... isn't numeric in bitwise or ..."
Message-Id: <slrnffr9p7.9i3.allergic-to-spam@no-spam-allowed.org>
Keywords: fcntl, Fcntl, |=, perl warnings
I'm stumped - trying to get rid of a warning message with code based on
this example snippet from the "Perl Cookbook" book:
use Fcntl;
$lags = "";
fcntl(HANDLE, F_GETFL, $flags) or die "Couldn't get flags: $!\n";
$flags |= O_NONBLOCK;
fcntl(HANDLE, F_SETFL, $flags) or die "Couldn't set flags: $!\n";
(I've typed the above by hand and shortened the error messages - sorry
for any typos.)
I did some searching, including messages about similar problems in this
NG, but failed to find anything relevant.
My code, a short example (included below), produces the warning:
Argument "\0\0\0\0/test1\0\0^P\0\0\0XM-3j^ITLKW \0\0\0^P\0\0\0hM-3..." isn't numeric in bitwise or (|) at ./odd-flags.pl line 13.
This refers to the line:
$flags |= O_NONBLOCK;
I suspect this has something to do with this paragraph from the fcntl
man page:
You don’t have to check for "defined" on the return from
"fcntl". Like "ioctl", it maps a 0 return from the system call
into "0 but true" in Perl. This string is true in boolean con-
text and 0 in numeric context. It is also exempt from the nor-
mal -w warnings on improper numeric conversions.
But the last sentence appears to imply the above warning should not
occur.
FYI:
perl -v
This is perl, v5.8.6 built for i386-linux-thread-multi
Is the perl version I'm using mistakenly producing this warning or have
I missed something? If the former - any recommendations on how to
cleanly suppress the warning. (Turn warnings off just for the
"offending" line?)
Here's my example code:
------------------------------------------------------------------
#!/usr/bin/perl
use strict;
use warnings;
use Fcntl;
my $file;
open $file, '>/tmp/test1';
my $flags = '';
fcntl($file, F_GETFL, $flags) or die "Could not get flags: $!";
print "flags: $flags\n";
$flags |= O_NONBLOCK;
print "flags: $flags\n";
fcntl($file, F_SETFL, $flags) or die "Could not set flags: $!";
fcntl($file, F_GETFL, $flags) or die "Could not get flags: $!";
print "flags: $flags\n";
# Below lines added only to get more info about the problem:
fcntl($file, F_GETFL, $flags) or die "Could not get flags: $!";
print "flags: $flags\n";
$flags |= 8;
print "flags: $flags\n";
fcntl($file, F_SETFL, $flags) or die "Could not set flags: $!";
fcntl($file, F_GETFL, $flags) or die "Could not get flags: $!";
print "flags: $flags\n";
------------------------------------------------------------------
Oddly, it complains about the first |=, but not the 2nd. It produces
this output (sorry about the odd characters):
Argument "\0\0\0\0/test1\0\0^P\0\0\0XM-cp^ITLKW \0\0\0^P\0\0\0hM-c..." isn't numeric in bitwise or (|) at ./odd-flags.pl line 13.
flags: flags: 2048
flags: 2048flags: 2048flags: 2056
flags: 2056
Thanks for any help or pointers on this!
--
------------------------------
Date: Sat, 29 Sep 2007 06:33:56 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Using fcntl and |= - "Argument .... isn't numeric in bitwise or ..."
Message-Id: <4n41t4-msj1.ln1@osiris.mauzo.dyndns.org>
Keywords: fcntl, Fcntl, |=, perl warnings
Quoth Jim Cochrane <allergic-to-spam@no-spam-allowed.org>:
>
> I'm stumped - trying to get rid of a warning message with code based on
> this example snippet from the "Perl Cookbook" book:
>
> use Fcntl;
>
> $lags = "";
> fcntl(HANDLE, F_GETFL, $flags) or die "Couldn't get flags: $!\n";
You need to read you systems fcntl(2) as well as the perldocs; at least
on mine, it says
F_GETFL Get descriptor status flags, as described below (arg is
ignored).
So, contrary to the example in perldoc -f fcntl, you need
my $flags = fcntl(HANDLE, F_GETFL);
Ben
------------------------------
Date: Sat, 29 Sep 2007 02:24:53 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: using IPC::Open3 to write to *and* read from a process...
Message-Id: <54m0t4-l4h1.ln1@osiris.mauzo.dyndns.org>
Quoth RU <ru@vakuum.de>:
>
> I'm currently working on some cluster scripts which, among other things,
> need to start and stop oracle. The typical (/bin/sh) nasty cluster
> script does something like:
>
> #!/bin/sh
> su -m oracle -c "sqlplus / as sysdba"<<_EOF_
> startup
> _EOF_
Firstly, I know very little about Oracle, but my impression is that
sqlplus just ends up sending SQL to the server? In which case, you can
likely do the whole thing from Perl with DBI, and not bother trying to
script an external binary at all.
> I'm trying to provide the same (or better) functionality using more-or-
> less pure perl. I have come up with a subroutine ("run_process()") which
> I will include at the bottom. I'm using select to determine if there is
> output on STDOUT or STDERR, and if I can write to the process on STDIN
> (if I have input I'd like to send to the process). The problem is, I'm
> catching SIGCHLD, and when a SIGCHLD is caught, I stop looking for output
> from STDOUT and STDERR.
Why? Why not just wait() when you get a SIGCHLD, and read stdout and
stderr until they're empty? In principle there could be a full
pipe's-worth of data left to read when the writing process dies.
> I've tested the subroutine and it seems to work,
> but I'm slightly worried that it might be possible to lose output because
> of the interruption caused by SIGCHLD. You might wonder why I'm not just
> using Expect. I'm trying to put something minimal together that solves
> this problem for many cases, and Expect has too much administrative
> overhead for me. Anyhow, is there a better/more reliable way of ensuring
> I get all the output from the child process?
A canned solution to many problems like this is IPC::Run. It may well be
worth your while looking at it.
> Also, you may notice that I keep a count of open output filedescriptors
> STDOUT and STDERR, and leave the while-loop when the count reaches zero.
> Unfortunately this does not work, as STDERR doesn't get closed
> (apparently) when the child process terminates, or at least the method I
> used doesn't notice it.
You probably just haven't emptied the pipe yet. If you'd kept reading,
it would have closed when you'd got all the data.
> Any comments?
(General comments follow, as well as those you asked for ;). Not all of
the advice below can be followed at once.)
> ----------------------------snip-----------------------------------------
> package ScriptLib;
It's probably worth avoiding top-level package names. The potential for
conflict is just too great. I tend to keep things under
BMORROW::Project::*.
> use FileHandle;
> use IPC::Open3;
>
> sub run_command
> {
> my ($cmdref, $su_user, $input_ref);
>
> # parse args
> while($_ = shift) {
> if (/^-cmd/) {
> $cmdref = shift;
> } elsif (/^-su/) {
> $su_user = shift;
> } elsif (/^-input/) {
> $input_ref = shift;
> }
> }
This can be more clearly written
my %args = @_;
and then you use $args{-su} instead of $su_user throughout; or, if you
really want to unpack them into variables,
my ($cmdref, $su_user, $input_ref) = @args{ qw/-cmd -su -input/ };
> my $debug = 1;
>
> my @cmd = @{$cmdref};
>
> if ($su_user) {
> unshift(@cmd, 'su', '-m', $su_user, '-c');
> }
>
> my @input = defined($input_ref) ? @{$input_ref} : ();
> my ($read_fh, $write_fh, $err_fh);
>
> $debug && print "run_command()\n";
You should use warn (or carp) for diagnostics. It tells you where you
are, and it goes to STDERR.
> $debug && print "CMD: [", join(' ', @cmd), "]\n";
>
> $SIG{PIPE} = 'IGNORE';
> $SIG{CHLD} = \&handle_sigchild;
>
> my $child_exited = 0;
> sub handle_sigchild
Defining a named sub inside another named sub is a bad idea. It doesn't
quite do what you expect if you refer to a variable in the outer scope
(or, at any rate, it doesn't do what *I* expect :) ). I would just use
an anon sub here: after all, you don't use the name anywhere else.
$SIG{CHLD} = sub {
...;
};
(note the trailing semicolon)
> {
> $debug && print "got SIGCHLD!!!\n";
> $child_exited = 1;
> }
>
> $err_fh = FileHandle->new; # only reader and writer are auto-gen'd
> my $pid = open3($write_fh, $read_fh, $err_fh, @cmd);
You need to check if open3 succeeded.
You need to set the filehandles to non-blocking mode. Otherwise your
reads below will block until they have a bufferful, and in the meanwhile
the process might be waiting for input from you.
> # read output until EOF
> my ($rout, $rin, $wout, $win, $eout, $ein);
> $rin = $ein = '';
> my $nclosed = 0;
> my ($buf, $ret, $out, $err);
> my ($out_open, $err_open) = (1, 1);
What are these variables for? Apart from the fact that you don't seem to
use the values, in any case a filehandle knows if it's open or not. Ask
it with Scalar::Util::openhandle, or fileno in a case like this where
you know it's not going to be tied.
> my ($fileno_write, $fileno_err, $fileno_read);
>
> my $have_input = 0;
>
> if (@input) {
> $win = '';
> $fileno_write = fileno($write_fh);
> vec($win, $fileno_write, 1) = 1;
I would strongly advise against using select() directly. The IO::Select
module provides a much saner interface.
> $have_input = 1;
This variable is useless. It is exactly equivalent to $win.
> } else {
> close($write_fh);
> }
>
> my $want_closed = 0;
> if (defined($read_fh)) {
defined is the wrong test here. If you want a test at all, you want
openhandle from Scalar::Util, or simply fileno, which is equivalent in
this case.
> $fileno_read = fileno($read_fh);
> vec($rin, $fileno_read, 1) = 1;
> $want_closed++;
> }
>
> if (defined($err_fh)) {
> $fileno_err = fileno($err_fh);
> vec($ein, $fileno_err, 1) = 1;
> $want_closed++;
> }
>
> my $input_line;
>
> $debug && print " going into read loop...\n";
> while (!$child_exited && ($nclosed < $want_closed)) {
As I said above, you don't care about the child exitting. Just wait for
it (with 5.8's safe signals you might as well wait in the signal
handler) and carry on reading. The events you care about are the
filehandles closing.
This arrangement with $want_closed/$nclosed and all the separate
filehandle variables is nasty. Your basic problem is you have a family
of variables that belong in a structure, in this case probably a hash.
If you start with
my %fh;
...
my $pid = open3($fh{write}, $fh{read}, $fh{err}, @cmd);
and make sure you always delete a filehandle from the hash when you
close it then this loop becomes simply
while (keys %fh) {
which is much more pleasant. Of course, an IO::Select object will quite
happily take the place of that hash, as well as removing the need for
the related $*in and $*out variables.
> $debug && print "\n**top of while**,nclosed=[$nclosed]\n";
> if ($have_input && !@input) {
Here is the only place you use $have_input, and you can instead write
if ($win and !@input) {
> $debug && print "input exhausted. setting
> win=undef\n";
> $win = undef;
> }
>
> $debug && print "going into select...\n";
> my $nfound = select($rout=$rin, $wout=$win, $eout=$ein,
> undef);
> $debug && print "after select, nfound=[$nfound]\n";
>
> if ($nfound) {
> #---------------------------------------------
> # STDOUT
> #---------------------------------------------
> if (vec($rout, $fileno_read, 1)) {
> $debug && print "stdout has something...
> \n";
> $ret = sysread($read_fh, $buf, 512);
You don't check if sysread failed. Admittedly the most likely failure is
EAGAIN, which you must ignore, but checking for other errors is good
practice.
> $debug && print "read [$ret] bytes\n";
> if ($ret == 0) {
> $nclosed++;
> $debug && print "incrementing
> nclosed\n";
> $out_open = 0;
> $rin = undef;
> }
> $debug && print " STDOUT: [$buf]\n";
> $out .= $buf;
> }
>
> #---------------------------------------------
> # STDERR
> #---------------------------------------------
> if (vec($eout, $fileno_err, 1)) {
> $debug && print "stderr has something...
> \n";
> $ret = sysread($err_fh, $buf, 512);
> $debug && print "read [$ret] bytes\n";
> if ($ret == 0) {
> $nclosed++;
> $debug && print "incrementing
> nclosed\n";
> $err_open = 0;
> }
> $debug && print " STDERR: [$buf]\n";
> $err .= $buf;
> }
>
> #---------------------------------------------
> # STDIN
> #---------------------------------------------
> if (vec($wout, $fileno_write, 1)) {
> $debug && print "stdin is ready for
> input...\n";
> $input_line = shift(@input)."\n";
> $debug && print "INPUT: [$input_line]\n";
> $ret = syswrite($write_fh, $input_line);
> defined($ret) || die "write failed: $!\n";
Here you check too zealously: EAGAIN is not an 'error', it simply tells
you the pipe is full.
> $debug && print "wrote [$ret] bytes\n";
> }
> }
> }
>
> defined($input_ref) && close($write_fh);
This line is wrong. You may have closed it already if you'd run out of
input.
> defined($read_fh) && close($read_fh);
> defined($err_fh) && close($err_fh);
If you'd kept them in a hash:
close $_ for values %fh;
or if you'd used IO::Select
close $_ for $select->handles;
A set of variables with similar names that you keep doing similar things
to is a sure sign that you need to use a data structure.
Ben
------------------------------
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 890
**************************************
