$ perl5.8 -w -e 'if (my $pid=open(my $P, "|-")) {
kill("SIGKILL",$pid); sleep(2); print $P "test1:$pid\n";}; '
Broken pipe
Now I'm trying to catch that broken pipe
$ perl5.8 -w -e '$SIG{PIPE} = sub {print "SIGPIPE\n";return 1};
if (my $pid=open(my $P, "|-")) {
kill("SIGKILL",$pid); sleep(2); print $P "test1:$pid\n"};
$
Nothing at all is printed when I would have expected SIGPIPE. It seems as if it treats my anonymous sub handler as if it was IGNORE instead.
Pretty much any content of the sub does not produce any effect (print, die, change package variable value)
The code doesn't die; if you print something to STDOUT in the end it will print.
What am I missing?
UPDATE : #jm666's answer led me to the issue: the pipe's writes were not flushed; and as such it was too early to get the SIGPIPE. Adding autoflush helped:
$ perl5.8 -w -e 'use IO::Handle ;$SIG{PIPE} = sub {print "SIGPIPE\n"};
if (my $pid=open(my $P, "|-")) {
$P->autoflush(1);
kill(SIGTERM,$pid); sleep(2);;print $P "test1:$pid\n"}; '
SIGPIPE
$
Physical writes to pipes are delayed, so you can catch them on the close. the next prints the message. (added the close $P)
perl -w -e '$SIG{PIPE} = sub {print "SIGPIPE\n";return 1}; if (my $pid=open(my $P, "|-")) { kill("SIGKILL",$pid); sleep(2); print $P "test1:$pid\n";close $P};'
more: http://perldoc.perl.org/perlipc.html
Related
I'm able to do this on the command line and it works :
~/Tools/perl/edif_extr_cell.pl design.edif nmos1p8v | perl -p -e 's/^/\n/ if /portImplementation|figure\s+device/;' | perl -n -000 -e 'print if /portImplementation/;'
(basically, extracting a section of the EDIF file).
Now, I want to make a utility of this. And my script is below. Question : can this code be more efficient? If feel like it's very inelegant. I could pipe streams easily on the command line but, in a script, I feel lost.
#!/usr/bin/perl -w -p
BEGIN{ $file = '';}
s/^/\n/ if /portImplementation|figure\s+device/;
$file .= $_;
END{
$cmd = q{\rm -f /tmp/dump}.$$.'.txt';
system( $cmd );
open( OUT, ">/tmp/dump$$.txt");
print OUT $file;
close OUT;
$out = `perl -n -000 -e 'print if /portImplementation/;' /tmp/dump$$.txt`;
system( $cmd );
print $out;
}
If I understand correct, you want to be able to do
~/Tools/perl/edif_extr_cell.pl design.edif nmos1p8v | myfilter
Ideally, you'd merge the two Perl scripts into one rather than having one script launch two instances of Perl, but this turns out to be rather hard because of the change to $/ (via -00) and because you insert newlines in the first filter.
The simplest answer:
#!/bin/sh
perl -pe's/^/\n/ if /portImplementation|figure\s+device/' |
perl -00ne'print if /portImplementation/'
It appears that you were trying to write the equivalent of that sh script in Perl. It would look like the following:
#!/usr/bin/perl
use strict;
use warnings;
use IPC::Open qw( open3 );
# open3 has issues with lexical file handles.
pipe(local *PIPE_READER, local *PIPE_WRITER)
or die($!);
my $pid1 = open3('<&STDIN', '>&PIPE_WRITER', '>&STDERR',
'perl', '-pes/^/\n/ if /portImplementation|figure\s+device/');
my $pid2 = open3('<&PIPE_READER', '>&STDOUT', '>&STDERR',
'perl', '-00neprint if /portImplementation/');
waitpid($pid1);
waitpid($pid2);
I'd normally recommend IPC::Run3 or IPC::Run for launching and interfacing with child processes, but low-level open3 does the trick nicely in this particular situation.
I downloaded a random EDIF file from GitHub, running the following script on it gives the same output as your code:
#! /usr/bin/perl
use warnings;
use strict;
my #buffer;
my $found;
my $prepend = q();
while (<>) {
if (/portImplementation|figure\s+device/) {
if ($found && #buffer) {
print $prepend, #buffer;
$prepend = "\n";
}
undef $found;
#buffer = ();
}
$found ||= /portImplementation/;
push #buffer, $_;
}
# Don't forget to output the last paragraph!
print $prepend, #buffer if $found && #buffer;
I would like to know what is the equivalent code that Perl runs when executed with the options perl -pi -e?
On some SO question I can read this:
while (<>) {
... # your script goes here
} continue {
print;
}
But this example does not show the part where the file is saved.
How does Perl determine the EOL? Does it touch the file when no changes occured? For example if I have a old MAC file (\r only). How does it deal with s/^foo/bar/gm?
I tried to use the Perl debugger but it doesn't really help. So I am just trying to guess:
#!/usr/bin/env perl
my $pattern = shift;
map &process, #ARGV;
# perl -pi -e PATTERN <files>...
sub process {
next unless -f;
open my $fh, '<', $_;
my $extract;
read $fh, $extract, 1024;
seek &fh, 0, 0;
if ($extract =~ /\r\n/) {
$/ = "\r\n";
} elsif ($extract =~ /\r[^\n]/) {
$/ = "\r";
} else {
$/ = "\n";
}
my $out = '';
while(<&fh>) {
my $__ = $_;
eval $pattern;
my $changes = 1 if $_ ne $__;
$out .= $_;
}
if($changes)
{
open my $fh, '>', $_;
print $fh $out;
}
close &fh;
}
You can inspect the code actually used by Perl with the core module B::Deparse. This compiler backend module is activated with the option -MO=Deparse.
$ perl -MO=Deparse -p -i -e 's/X/U/' ./*.txt
BEGIN { $^I = ""; }
LINE: while (defined($_ = <ARGV>)) {
s/X/U/;
}
continue {
die "-p destination: $!\n" unless print $_;
}
-e syntax OK
Thus perl is looping over the lines in the given files, executes the code with $_ set to the line and prints the resulting $_.
The magic variabe $^I is set to an empty string. This turns on in place editing. In place editing is explained in perldoc perlrun. There is no check whether the file is unchanged. Thus the modified time of the edited file is always updated. Apparently the modified time of the backup file is the same as the modified time of the original file.
Using the -0 flag you can set the input record separator for using "\r" for your Mac files.
$ perl -e "print qq{aa\raa\raa}" > t.txt
$perl -015 -p -i.ori -e 's/a/b/' t.txt
$cat t.txt
ba
$ perl -MO=Deparse -015 -p -i.ori -e 's/a/b/'.txt
BEGIN { $^I = ".ori"; }
BEGIN { $/ = "\r"; $\ = undef; }
LINE: while (defined($_ = <ARGV>)) {
s/a/b/;
}
continue {
die "-p destination: $!\n" unless print $_;
}
-e syntax OK
From the perlrun documentation:
-p assumes an input loop around your script. Lines are printed.
-i files processed by the < > construct are to be edited in place.
-e may be used to enter a single line of script. Multiple -e commands may be given to build up a multiline script.
Continue my previous question (but other queastion),
According to the following perl script (rename.pl)
how to build perl one-liners line from the rename.pl script
in order to replace the: /var/tmp/rename.pl (from find command ...)
with the one-liners perl syntax?
(I dont want to use the rename.pl script ,)
find / -name "$OLD_HOST" -print0 | xargs -0 /var/tmp/rename.pl 'print "changing $_\n"; s/$OLD_HOST/host_10/g'
rename.pl script:
#!/usr/bin/perl
$op = shift;
for (#ARGV) {
$was = $_;
eval $op;
die $# if $#;
rename($was,$_) unless $was eq $_;
}
Why not use the bullet-proofed, debugged rename.pl script?
find ... |
xargs -0 perl -e 'my $op - shift; foreach (#ARGV)
{ my $was = $_; eval $op; die $# if $#;
rename($was, $_) unless $was eq $_; }' \
s/x/y/g
This one-liner will find zip files with numbers inside the filename, and print some "mv" shell commands rather than executing them immediately. You can paste this into the command line for more control later.
Maybe this will get you started.
find . -name "*.zip" | perl -nE
'chomp; my $f = qq($_); $f =~ /(\d+)/;
say "mv $f " . sprintf("%03d", $1) . ".zip";'
This is what my Perl code looks like for monitoring a Unix folder :
#!/usr/bin/perl
use strict;
use warnings;
use File::Spec::Functions;
my $date = `date`; chomp $date;
my $datef = `date +%Y%m%d%H%M.%S`; chomp $datef;
my $pwd = `pwd`; chomp $pwd;
my $cache = catfile($pwd, "cache");
my $monitor = catfile($pwd, "monme");
my $subject = '...';
my $msg = "...";
my $sendto = '...';
my $owner = '...';
sub touchandmail {
`touch $cache -t "$datef"`;
`echo "$msg" | mail -s "$subject" $owner -c $sendto`;
}
while(1) {
$date = `date`; chomp $date;
$datef = `date +%Y%m%d%H%M.%S`; chomp $datef;
if (! -e "$cache") {
touchandmail();
} elsif ("`find $monitor -newer $cache`" ne "") {
touchandmail();
}
sleep 300;
}
To do a chomp after every assignment does not look good. Is there some way to do an "autochomp"?
I am new to Perl and might not have written this code in the best way. Any suggestions for improving the code are welcome.
Don't use the shell, then.
#! /usr/bin/perl
use warnings;
use strict;
use Cwd;
use POSIX qw/ strftime /;
my $date = localtime;
my $datef = strftime "%Y%m%d%H%M.%S", localtime;
my $pwd = getcwd;
The result is slightly different: the output of the date command contains a timezone, but the value of $date above will not. If this is a problem, follow the excellent suggestion by Chas. Owens below and use strftime to get the format you want.
Your sub
sub touchandmail {
`touch $cache -t "$datef"`;
`echo "$msg" | mail -s "$subject" $owner -c $sendto`;
}
will fail silently if something goes wrong. Silent failures are nasty. Better would be code along the lines of
sub touchandmail {
system("touch", "-t", $datef, $cache) == 0
or die "$0: touch exited " . ($? >> 8);
open my $fh, "|-", "mail", "-s", $subject, $owner, "-c", $sendto
or die "$0: could not start mail: $!";
print $fh $msg
or warn "$0: print: $!";
unless (close $fh) {
if ($! == 0) {
die "$0: mail exited " . ($? >> 8);
}
else {
die "$0: close: $!";
}
}
}
Using system rather than backticks is more expressive of your intent because backticks are for capturing output. The system(LIST) form bypasses the shell and having to worry about quoting arguments.
Getting the effect of the shell pipeline echo ... | mail ... without the shell means we have to do a bit of the plumbing work ourselves, but the benefit—as with system(LIST)—is not having to worry about shell quoting. The code above uses many-argument open:
For three or more arguments if MODE is '|-', the filename is interpreted as a command to which output is to be piped, and if MODE is '-|', the filename is interpreted as a command that pipes output to us. In the two-argument (and one-argument) form, one should replace dash ('-') with the command. See Using open for IPC in perlipc for more examples of this.
The open above forks a mail process, and $fh is connected to its standard input. The parent process (the code still running touchandmail) performs the role of echo with print $fh $msg. Calling close flushes the handle's I/O buffers plus a little extra because of how we opened it:
If the filehandle came from a piped open, close returns false if one of the other syscalls involved fails or if its program exits with non-zero status. If the only problem was that the program exited non-zero, $! will be set to 0. Closing a pipe also waits for the process executing on the pipe to exit—in case you wish to look at the output of the pipe afterwards—and implicitly puts the exit status value of that command into $? and ${^CHILD_ERROR_NATIVE}.
More generally, the IO::All module does indeed provide the equivalent of an autochomp:
use IO::All;
# for getting command output:
my #date = io("date|")->chomp->slurp;
#$date[0] contains the chomped first line of the output
or more generally:
my $fh = io("file")->chomp->tie;
while (<$fh>) {
# no need to chomp here ! $_ is pre-chomped
}
Granted, for this particular case of date I would agree with the other answerers that you are probably better off using one of the DateTime modules, but if you are simply reading in a file and want all your lines to be chomped, then IO::All with the chomp and tie options applied is very convenient.
Note also that the chomp trick doesn't work when slurping the entire contents of the handle into a scalar directly (that's just the way it is implemented).
Try putting it into a function:
sub autochomp {
my $command = shift;
my $retval = `$command`;
chomp $retval;
return $retval;
}
And then call that for each command you want to execute and then chomp.
Use DateTime or other of the date modules on CPAN instead of the date utility.
For example:
use DateTime;
my $dt = DateTime->now;
print $dt->strftime('%Y%m%d%H%M.%S');
It is possible to assign and chomp in a single line using the following syntax:
chomp ( my $date = `date` );
As for speaking more Perlishly, if you find yourself repeating the same thing over and over again, roll it into a sub:
sub assign_and_chomp {
my #result;
foreach my $cmd (#_) {
chomp ( my $chomped = $cmd );
push #result, $chomped;
}
return #result;
}
my ( $date , $datef , $pwd )
= assign_and_chomp ( `date` , `date +%Y%m%d%H%M.%S` , `pwd` );
For example:
open (PS , " tail -n 1 $file | grep win " );
I want to find whether the file handle is empty or not.
You can also use eof to check whether a file handle is exhausted. Here is an illustration based loosely on your code. Also note the use of a lexical file handle with the 3-arg form of open.
use strict;
use warnings;
my ($file_name, $find, $n) = #ARGV;
open my $fh, '-|', "tail -n $n $file_name | grep $find" or die $!;
if (eof $fh){
print "No lines\n";
}
else {
print <$fh>;
}
Although calling eof before you attempt to read from it produces the result you expect in this particular case, give heed to the advice at the end of the perlfunc documentation on eof:
Practical hint: you almost never need to use eof in Perl, because the input operators typically return undef when they run out of data, or if there was an error.
Your command will produce at most one line, so stick it in a scalar, e.g.,
chomp(my $gotwin = `tail -n 1 $file | grep win`);
Note that the exit status of grep tells you whether your pattern matched:
2.3 Exit Status
Normally, the exit status is 0 if selected lines are found and 1 otherwise …
Also, tail exits 0 on success or non-zero on failure. Use that information to your advantage:
#! /usr/bin/perl
use strict;
use warnings;
my $file = "input.dat";
chomp(my $gotwin = `tail -n 1 $file | grep win`);
my $status = $? >> 8;
if ($status == 1) {
print "$0: no match [$gotwin]\n";
}
elsif ($status == 0) {
print "$0: hit! [$gotwin]\n";
}
else {
die "$0: command pipeline exited $status";
}
For example:
$ > input.dat
$ ./prog.pl
./prog.pl: no match []
$ echo win >input.dat
$ ./prog.pl
./prog.pl: hit! [win]
$ rm input.dat
$ ./prog.pl
tail: cannot open `input.dat' for reading: No such file or directory
./prog.pl: no match []
open (PS,"tail -n 1 $file|");
if($l=<PS>)
{print"$l"}
else
{print"$file is empty\n"}
well ... scratch this ... I didn't make the connection about the filehandle actually being the output of a pipe.
You should use stat to determine the size of a file but you're going to need to
ensure the file is flushed first:
#!/usr/bin/perl
my $fh;
open $fh, ">", "foo.txt" or die "cannot open foo.txt - $!\n";
my $size = (stat $fh)[7];
print "size of file is $size\n";
print $fh "Foo";
$size = (stat $fh)[7];
print "size of file is $size\n";
$fh->flush;
$size = (stat $fh)[7];
print "size of file is $size\n";
close $fh;