Do we have an autochomp in Perl? - perl

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` );

Related

Strange output in printing a grep -c return

Below is a shell program, it's just me testing how to tell if the same Perl script is already running using the same parameters.
It works, but what strikes me as odd is the trailing zero after the count of lines. I don't see where in my code that zero would be printed. If I run that grep command from the command line it just returns the count, no trailing '0', but it doesn't work that way in the code.
Any clues anyone?
Thanks
The App
#!/usr/bin/perl
use CGI;
$|=1;
my $q = CGI->new();
my $userid = $q->param("u");
my $check = "'perly.pl u=" . $userid . "'";
my $return= system("ps aux | grep $check | grep -v 'grep' -c");
print $return;
print "\n";
while(1)
{
print "$userid...";
sleep(3);
}
exit 0;
The output
2 0
PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..PlasticProgrammer..
You can easily capture the output and exit value of a command using Capture::Tiny. Also, when using the built-in system, always make sure to check that the execution succeeded, if it failed this is indicated by a return value of -1.
use strict;
use warnings;
use Capture::Tiny 'capture_stdout';
my $check = "perly.pl u=foo";
my ($stdout, $exit) = capture_stdout { system 'pgrep', '-fc', $check };
die "pgrep failed: $!" if $exit == -1;
Remember that your output will most likely end in a newline, even just a count, so you probably want to chomp it.
You can also use the backticks/qx operator to return just the STDOUT, but this will always pass the command through the shell, requiring you to use String::ShellQuote on your argument containing user input as noted by #ikegami.
use strict;
use warnings;
use String::ShellQuote;
my $check = shell_quote "perly.pl u=foo";
my $stdout = `pgrep -fc $check`;
die "pgrep failed: $!" if $? == -1;
An alternative is IPC::System::Simple, which provides capturex, a form of the backticks operator that takes a list of arguments like system and never passes them through the shell. By default it will throw an exception if the command fails or if there's a nonzero exit code, but you can specify to allow certain exit codes. Since pgrep returns a nonzero exit code if there's no matches, you want to allow nonzero exit codes.
use strict;
use warnings;
use IPC::System::Simple qw(capturex EXIT_ANY $EXITVAL);
my $check = "perly.pl u=foo";
my $stdout = capturex EXIT_ANY, 'pgrep', '-fc', $check;
my $exit = $EXITVAL;
In case anyone is looking for a solution to this, good ideas up top but in the end I chose to create a unique temp file and pipe the output to that file.
Many ways, I found this the one that felt right for me.
#!/usr/bin/perl
use CGI;
use File::Temp;
$|=1;
my $q = CGI->new();
my $userid = $q->param("u");
my $check = "'perly.pl u=" . $userid . "'";
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
$mon++;
my $uFile = $userid . $year . $mon . $mday . $hour . $min . $sec . ".dat";
my $command = "ps aux | grep $check | grep -v 'grep' -c > $uFile";
system($command);
if (open(my $fh, "$uFile"))
{
while (my $line = <$fh>)
{
if($line>1)
{
print"\nApp is already running";
}
}
close($fh);
unlink($uFile);
}
exit 0;

perl : making a script as efficient as a perl one-liner

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;

Running a non-perl script into my perl script? [duplicate]

This question already has answers here:
How do I get the output of an external command in Perl?
(7 answers)
Closed 8 years ago.
I am writing a Perl script to automate some software installation.
In my script I run another bash script and take its output and print it again.
print `/home/me/build.sh`;
but build.sh script take 8 minutes, so my script wait till the 8 minutes and script finishes the starting in printing the output.
How can I print each line from the build.sh program as it is running in bash shell?
As the comment below I use system ("/home/me/build.sh");
but the output goes to shell however I make out redirection in my script to my log file,
open $fh, "> filename";
*STDOUT = $fh;
*STDERR = $fh;
Then should when I use system function its output will be redirected to filename, but it isn't.
Should I use print system ("/home/me/build.sh"); instead of system ("/home/me/build.sh");?
#
The full code:
#!/usr/bin/perl
use strict;
use warnings;
use IO::File;
my %DELIVERIES = ();
my $APP_PATH = $ENV{HOME};
my $LOG_DIR = "$APP_PATH/logs";
my ($PRG_NAME) = $0 =~ /^[\/.].*\/([a-zA-Z]*.*)/;
main(#argv);
sub main
{
my #comps = components_name();
my $comp;
my $pid;
while ( scalar #comps ) {
$comp = pop #comps;
if ( ! ($pid = fork) ) {
my $filename = lc "$LOG_DIR/$comp.log";
print "$comp delpoyment started, see $filename\n";
open (my $logFile, ">", "$filename") or (die "$PRG_NAME: $!" && exit);
*STDOUT = $logFile;
*STDERR = $logFile;
deploy_component ( $comp );
exit 0;
}
}
my $res = waitpid (-1, 0);
}
sub components_name
{
my $FILENAME="$ENV{HOME}/components";
my #comps = ();
my $fh = IO::File->new($FILENAME, "r");
while (<$fh>)
{
push (#comps, $1) if /._(.*?)_.*/;
chomp ($DELIVERIES{$1} = $_);
}
return #comps;
}
sub deploy_component
{
my $comp_name = shift;
print "\t[umask]: Changing umask to 007\n";
`umask 007`;
print "\t[Deploing]: Start the build.sh command\n\n";
open (PIPE, "-|", "/build.sh");
print while(<PIPE>);
}
A more flexible way is to use pipe.
open PIPE, "/home/me/build.sh |";
open FILE, ">filename";
while (<PIPE>) {
print $_; # print to standard output
print FILE $_; # print to filename
}
close PIPE;
close FILE;
BTW, print system ("/home/me/build.sh"); will print the return value of system(), which is the exit status of your shell script, not the output wanted.
How can I print each line from the build.sh program as it is running in bash shell?
Possible Solution:
You can try the following
system ("sh /home/me/build.sh | tee fileName");
The above statement will show the output of build.sh on the console and at the same time write that output in the filename provided as the argument for tee

Loop Find Command's Output

I'm wanting to issue the find command in Perl and loop through the resulting file paths. I'm trying it like so (but not having any luck):
my $cmd;
open($cmd, '-|', 'find $input_dir -name "*.fastq.gz" -print') or die $!;
while ($line = <$cmd>) {
print $line;
}
close $cmd;
Any ideas?
Thanks
You're not applying enough escaping to the * character.
Prepending a \ should fix it.
It's better not to invoke the shell in the first place,
by separating the arguments:
use warnings;
use strict;
open(my $cmd, '-|', 'find', $input_dir, '-name' ,'*.fastq.gz', '-print') or die $!;
while (my $line = <$cmd>) {
print $line;
}
close $cmd;
Your problem seems to be using single quotes. Your variable will not be interpolated, but the variable name will be fed to find as-is.
But why not use File::Find?
> perl -MFile::Find -lwe '
$foo = "perl";
find ( sub { /\.pl$/i or return; print $File::Find::name }, $foo);'
perl/foo.pl
perl/parsewords.pl
perl/yada.pl
Here, the wanted subroutine is simply a pattern match against the file name. We exit (return from) the subroutine unless the extension is .pl, else we print the file name with the relative path.
If you were to do
print 'find $input_dir -name "*.fastq.gz" -print';
The problem should become obvious: Single-quotes don't interpolate. You probably meant to do
open(my $cmd_fh, '-|', qq{find $input_dir -name "*.fastq.gz" -print}) or die $!;
but that's buggy too. You don't convert $input_dir into a shell literal. Two solutions present themselves.
use String::ShellQuote qw( shell_quote );
my $cmd = shell_quote("find", $input_dir, "-name", "*.fastq.gz", "-print");
open(my $cmd_fh, '-|', $cmd) or die $!;
Or
my #cmd = ("find", $input_dir, "-name", "*.fastq.gz", "-print");
open(my $cmd_fh, '-|', #cmd) or die $!;
To read the output of a command, use the backtick operator.
my $command = "find $inputdir ..."; # interpolate the input directory
my $output = `$command`; # be careful here
my #lines = split /\n/ => $output; # split in single lines
for my $line (#lines) { # iterate
# do something with $line
}
I think it's much better readable than piping. The downside is that it blocks, so if you want to process huge output strings with lots of lines, the pipe approach may be better.
But you may want to use an appropriate module. File::Find (core module) should fit your needs.

How do I get the output of an external command in Perl?

I want to have output of Windows command-line program (say, powercfg -l) written into a file which is created using Perl and then read the file line by line in a for loop and assign it to a string.
You have some good answers already. In addition, if you just want to process a command's output and don't need to send that output directly to a file, you can establish a pipe between the command and your Perl script.
use strict;
use warnings;
open(my $fh, '-|', 'powercfg -l') or die $!;
while (my $line = <$fh>) {
# Do stuff with each $line.
}
system 'powercfg', '-l';
is the recommended way. If you don't mind spawning a subshell,
system "powercfg -l";
will work, too. And if you want the results in a string:
my $str = `powercfg -l`;
my $output = qx(powercfg -l);
## You've got your output loaded into the $output variable.
## Still want to write it to a file?
open my $OUTPUT, '>', 'output.txt' or die "Couldn't open output.txt: $!\n";
print $OUTPUT $output;
close $OUTPUT
## Now you can loop through each line and
## parse the $line variable to extract the info you are looking for.
foreach my $line (split /[\r\n]+/, $output) {
## Regular expression magic to grab what you want
}
There is no need to first save the output of the command in a file:
my $output = `powercfg -l`;
See qx// in Quote-Like Operators.
However, if you do want to first save the output in a file, then you can use:
my $output_file = 'output.txt';
system "powercfg -l > $output_file";
open my $fh, '<', $output_file
or die "Cannot open '$output_file' for reading: $!";
while ( my $line = <$fh> ) {
# process lines
}
close $fh;
See perldoc -f system.
Since the OP is running powercfg, s/he are probably capturing the ouput of the external script, so s/he probably won't find this answer terribly useful. This post is primarily is written for other people who find the answers here by searching.
This answer describes several ways to start command that will run in the background without blocking further execution of your script.
Take a look at the perlport entry for system. You can use system( 1, 'command line to run'); to spawn a child process and continue your script.
This is really very handy, but there is one serious caveat that is not documented. If you start more 64 processes in one execution of the script, your attempts to run additional programs will fail.
I have verified this to be the case with Windows XP and ActivePerl 5.6 and 5.8. I have not tested this with Vista or with Stawberry Perl, or any version of 5.10.
Here's a one liner you can use to test your perl for this problem:
C:\>perl -e "for (1..100) { print qq'\n $_\n-------\n'; system( 1, 'echo worked' ), sleep 1 }
If the problem exists on your system, and you will be starting many programs, you can use the Win32::Process module to manage your application startup.
Here's an example of using Win32::Process:
use strict;
use warnings;
use Win32::Process;
if( my $pid = start_foo_bar_baz() ) {
print "Started with $pid";
}
:w
sub start_foo_bar_baz {
my $process_object; # Call to Create will populate this value.
my $command = 'C:/foo/bar/baz.exe'; # FULL PATH to executable.
my $command_line = join ' ',
'baz', # Name of executable as would appear on command line
'arg1', # other args
'arg2';
# iflags - controls whether process will inherit parent handles, console, etc.
my $inherit_flags = DETACHED_PROCESS;
# cflags - Process creation flags.
my $creation_flags = NORMAL_PRIORITY_CLASS;
# Path of process working directory
my $working_directory = 'C:/Foo/Bar';
my $ok = Win32::Process::Create(
$process_object,
$command,
$command_line,
$inherit_flags,
$creation_flags,
$working_directory,
);
my $pid;
if ( $ok ) {
$pid = $wpc->GetProcessID;
}
else {
warn "Unable to create process: "
. Win32::FormatMessage( Win32::GetLastError() )
;
return;
}
return $pid;
}
To expand on Sinan's excellent answer and to more explicitly answer your question:
NOTE: backticks `` tell Perl to execute a command and retrieve its output:
#!/usr/bin/perl -w
use strict;
my #output = `powercfg -l`;
chomp(#output); # removes newlines
my $linecounter = 0;
my $combined_line;
foreach my $line(#output){
print $linecounter++.")";
print $line."\n"; #prints line by line
$combined_line .= $line; # build a single string with all lines
# The line above is the same as writing:
# $combined_line = $combined_line.$line;
}
print "\n";
print "This is all on one line:\n";
print ">".$combined_line."<";
Your output (on my system) would be:
0)
1)Existing Power Schemes (* Active)
2)-----------------------------------
3)Power Scheme GUID: 381b4222-f694-41f0-9685-ff5bb260df2e (Balanced) *
4)Power Scheme GUID: 8c5e7fda-e8bf-4a96-9a85-a6e23a8c635c (High performance)
5)Power Scheme GUID: a1841308-3541-4fab-bc81-f71556f20b4a (Power saver)
This is all on one line:
>Existing Power Schemes (* Active)-----------------------------------Power Scheme GUID: 381b4222-f694-41f0-9685-ff5bb260df2e (Balanced) *Power Scheme GUID: 8c5e7fda-e8bf-4a96-9a85-a6e23a8c635c (High performance)Power Scheme GUID: a1841308-3541-4fab-bc81-f71556f20b4a (Power saver)<
Perl makes it easy!
Try using > operator to forward the output to a file, like:
powercfg -l > output.txt
And then open output.txt and process it.