Hello guys i need to capture the output of an external command, herefore I use backquotes.
However when the command reaches a newline the output is ommitted. Where $_ = AD
#lines = `"C:/Program Files/Veritas/NetBackup/bin/admincmd/bppllist" $_ -U"`
Test: test1
Test: test2
Test: test3
Test: test4
The actual output:
#lines
Test: test1
Test: test2
Thank you for your time.
print HTML "<h2 id='pol'>Policy Configuration\n</h2>" ;
#bpllist =`"$admincmd/bppllist.exe"` or die print "$admincmd/bppllist.exe not found or could not be executed";
foreach (#bpllist)
{
print HTML "<div><table class='table'>\n";
#lines = `"$admincmd/bppllist" $_ -U` or die print "$admincmd/bpplinfo $_ -U not found or could not be executed";
print HTML "\t<tr>\n\t<td><b>Policy name: <b></td><td>$_</td>\n\t</tr>\n" ;
foreach (#lines) {
chop;
($var, $value) = split(/:/,$_,2);
$var = "" if !defined($var);
$value = "" if !defined($value);
print HTML "\t<tr>\n\t<td>$var</td><td>$value</td>\n\t</tr>\n" ;
}
print HTML "</table></div>";
}
The output of #bpllist:
AD
Sharepoint
Echchange
Vmware
Here's how to capture the STDOUT & STDERR of a spawned process using backticks:
my $output = join('', `command arg1 arg2 arg3 2>&1`);
How it works has no dependence whatsoever on newlines in the output of command.
If you also need to send text to command's STDIN, then use IPC::Open3.
Cleaned your code up a bit. It works for me.
use strict;
use warnings;
use 5.10.0;
# something missing here to set up HTML file handle
# something missing here to set up $admincmd
print HTML q{<h2 id='pol'>Policy Configuration\n</h2>};
my #bpllist = `"$admincmd/bppllist.exe"`
or die "$admincmd/bppllist.exe not found or could not be executed\n";
for my $policy (#bpllist) {
print HTML q{<div><table class='table'>\n};
my #lines = `$admincmd/bpplinfo.exe $policy -U 2>&1`;
print HTML qq{\t<tr>\n\t<td><b>Policy name: <b></td><td>$policy</td>\n\t</tr>\n} ;
for my $pair (#lines) {
chomp($pair); # only remove newlines, not other characters
my ($var, $value) = split /:/, $pair, 2;
$var //= '';
$value //= '';
print HTML qq{\t<tr>\n\t<td>$var</td><td>$value</td>\n\t</tr>\n} ;
}
print HTML q{</table></div>};
}
Update 2
You appear to be doing this on windows?
I don't think the 2>&1 trick will work there.
Instead of using qx or backticks and then shell commands to redirect output, give the core module, IPC::Cmd, a try. In particular, its exportable function &run will conveniently capture both STDOUT and STDERR for you. From the synopsis:
### in list context ###
my( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
run( command => $cmd, verbose => 0 );
Maybe the command send its output to stderr.
Try this:
my $output = `'command' -ARG -L 2>&1`;
regards,
Related
Here is a part of my script:
foreach $i ( #contact_list ) {
print "$i\n";
$e = "zcat $file_list2| grep $i";
print "$e\n";
$f = qx($e);
print "$f";
}
$e prints properly but $f gives a blank line even when $file_list2 has a match for $i.
Can anyone tell me why?
Always is better to use Perl's grep instead of using pipe :
#lines = `zcat $file_list2`; # move output of zcat to array
die('zcat error') if ($?); # will exit script with error if zcat is problem
# chomp(#lines) # this will remove "\n" from each line
foreach $i ( #contact_list ) {
print "$i\n";
#ar = grep (/$i/, #lines);
print #ar;
# print join("\n",#ar)."\n"; # in case of using chomp
}
Best solution is not calling zcat, but using zlib library :
http://perldoc.perl.org/IO/Zlib.html
use IO::Zlib;
# ....
# place your defiiniton of $file_list2 and #contact list here.
# ...
$fh = new IO::Zlib; $fh->open($file_list2, "rb")
or die("Cannot open $file_list2");
#lines = <$fh>;
$fh->close;
#chomp(#lines); #remove "\n" symbols from lines
foreach $i ( #contact_list ) {
print "$i\n";
#ar = grep (/$i/, #lines);
print (#ar);
# print join("\n",#ar)."\n"; #in case of using chomp
}
Your question leaves us guessing about many things, but a better overall approach would seem to be opening the file just once, and processing each line in Perl itself.
open(F, "zcat $file_list |") or die "$0: could not zcat: $!\n";
LINE:
while (<F>) {
######## FIXME: this could be optimized a great deal still
foreach my $i (#contact_list) {
if (m/$i/) {
print $_;
next LINE;
}
}
}
close (F);
If you want to squeeze out more from the inner loop, compile the regexes from #contact_list into a separate array before the loop, or perhaps combine them into a single regex if all you care about is whether one of them matched. If, on the other hand, you want to print all matches for one pattern only at the end when you know what they are, collect matches into one array per search expression, then loop them and print when you have grepped the whole set of input files.
Your problem is not reproducible without information about what's in $i, but I can guess that it contains some shell metacharacter which causes it to be processed by the shell before the grep runs.
I am using Perl with WWW::Mechanize to retrieve the stock exchanges from Yahoo Finance, given a list of stock symbols.
The following code writes to a file
#!/usr/bin/perl
# program name: FindStockExchange.pl
use strict;
use warnings;
use WWW::Mechanize;
use Storable;
use Getopt::Long;
#cmd: clear; ./FindStockExchange.pl A AA AA.V AAA.TO -f ~/symbol_out.txt
# Find Stock Exchange for a given Stock Symbole
# Command line options:
# -s Symbol
# -f Output filename
# Initialize variables:
my $urlBase = 'http://finance.yahoo.com/q?s = '; # Before symbol
my $urlSuffix = '&ql = 0'; # After symbol
my $url = '';
my $oFile = '';
my $symbol = '';
my $c = '';
# Read command line options.
GetOptions(
'f=s' => \$oFile #Output filename
) or die "Incorrect usage!\n";
# Ouptput file(s)
open(OUTSYM, ">$oFile") || die "Couldn't open file $oFile, $!";
my $m = WWW::Mechanize->new(autocheck => 0);
foreach $symbol (#ARGV) {
$url = $urlBase . $symbol . $urlSuffix;
$m->get($url);
$c = $m->content; # Places html page source text into variable
# Text pattern: <div class="title"><h2>Electrolux AB (ELUXY)</h2> <span class="rtq_exch"><span class="rtq_dash">-</span>OTC Markets </span></div>
$c =~ m{rtq_dash\">-</span>(.*?)</span>}s or next;
print OUTSYM "$symbol\t$1\n"; # Write output file
print "$symbol\t$1\t" . "\n"; # Write to STDOUT
}
close OUTFIL;
The following code reads from an input file and creates an empty data file. The input file contained the following stock symbols:
A
AA
AA.V
AAA.TO
#!/usr/bin/perl
# program name: FindStockExchange2.pl
use strict;
use warnings;
use WWW::Mechanize;
use Storable;
use Getopt::Long;
#cmd: clear; ./FindStockExchange2.pl -i ~/symbol_in.txt -o ~/symbol_out2.txt
# Find Stock Exchange for a given Stock Symbole
# Command line options:
# -i Input filename
# -o Output filename
# Initialize variables:
my $urlBase = 'http://finance.yahoo.com/q?s='; # Before symbol
my $urlSuffix = '&ql=0'; # After symbol
my $url = '';
my $oFile = '';
my $iFile = '';
my $symbol = '';
my $c = '';
# Read command line options.
GetOptions(
'o=s' => \$oFile, #Output filename
'i=s' => \$iFile #Input filename
) or die "Incorrect usage!\n";
# File(s)
open(OUTSYM, ">$oFile") || die "Couldn't open file $oFile, $!";
open(INSYM, "<$iFile") || die "Couldn't open file $iFile, $!";
my $m = WWW::Mechanize->new(autocheck => 0);
while (<INSYM>) {
$symbol = chomp($_);
$url = $urlBase . $symbol . $urlSuffix;
$m->get($url);
$c = $m->content; # Places html page source text into variable
# Text pattern: <div class="title"><h2>Electrolux AB (ELUXY)</h2> <span class="rtq_exch"><span class="rtq_dash">-</span>OTC Markets </span></div>
$c =~ m{rtq_dash\">-</span>(.*?)</span>}s or next;
print OUTSYM "$symbol\t$1\n"; # Write output file
print "$symbol\t$1\t" . "\n"; # Write to STDOUT
}
close INSYM;
close OUTSYM;
Why would changing from a foreach loop to reading an input file using a while loop produce different results?
foreach code creates a file containing the following:
A NYSE
AA NYSE
AA.V TSXV
AAA.TO Toronto
To-Air-Is:~ vlis
But a while loop creates an empty file.
Two problems here:
1) chomp returns the number of characters removed. But you are setting $symbol to the result of chomp. It should be something like this:
chomp;
$symbol = $_;
Clarification in response to comment by #Vin
You could even do this:
$symbol = $_;
chomp($symbol);
But, you should NOT do this:
$symbol = chomp($_);
Because chomp($_) will remove the newline from $_ but it will return the number of characters removed.
2) If you are putting symbols on one line within the input file, then $symbol could end up being a string of more than one symbol. So you probably need to split those up or require every symbol to be on its own line
I'm having a very difficult time inspecting the $return variable. The print "return = ". $return ."\n"; always comes back blank even though the process is still running. I do receive a warning about uninitialized variable. Can someone please explain?
my $process="MInstaller";
my $return=` ps -eaf |grep $process | grep -v grep`;
sub chk_proc{
print "in chk_proc\n";
print "\n";
print "return = ". $return ."\n";
while ( my $return ne "" ) {
sleep(5);
};
};
You're close. Your code doesn't works, because the variable $return in the
while ( my $return ne "" ) {
is another variable (declared in the scope of while) as your first $return.
You can try the next:
use 5.014;
use warnings;
chk_proc('[M]Installer'); #use the [] trick to avoid the 'grep -v grep :)
sub chk_proc{ while( qx(ps -eaf |grep $_[0]) ) {sleep 5} };
Are you using use warnings; and use strict;?
What about using pgrep instead of ps?
What happens if $return returns more than one line?
Your program would flow better if your subroutine merely checked to see if the process is running and you used that in another loop.
Here, my check process subroutine returns a list of all the processes it find. I can use this in my loop to see if the process itself has stopped. I could have used qx() to get a process list, then use split to create a list of processes.
use warnings;
use strict;
use feature qw(say);
use constant {
PROCESS => "MInstaller",
SLEEP => 5,
};
while ( process_check( PROCESS ) ) {
say qq(Process ) . PROCESS . qq( is running...);
sleep SLEEP;;
}
say qq(Process ) . PROCESS . qq( has ended.);
sub process_check {
my $process = shift;
open ( my $process_fh, "-|", "pgrep $process" );
my #process_list;
while ( my $line = <$process_fh> ) {
chomp $line;
push #process_list, $line;
}
close $process_fh;
return #process_list;
}
This script works on localhost with the -w switch but not without. It also works when use strict and use warning are active.
apache2/error.log:
without switch (aborted script):
(2)No such file or directory: exec of ... failed
with the switch I get:
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
On the live web server neither one works. Perl is new to me, but I know some BASH and PHP.
I run Debian Lenny, Apache2, Perl 5.10.
#!/usr/bin/perl -w
$| = 1;
my $mailprog = '/usr/sbin/sendmail'; # where the mail program lives
my $to = "not\#for.you"; # where the mail is sent
my ($command,$email,#pairs,$buffer,$pair,$email_flag) ;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#pairs = split(/&/, $buffer);
foreach $pair (#pairs) {
# Split the pair up into individual variables. #
my($name, $value) = split(/=/, $pair);
# Decode the form encoding on the name and value variables. #
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# aren't a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
## print "Name of form element is $name with value of $value \n";
if ($name eq 'email') {
$email = $value;
}
if ($name eq 'command') {
$command = $value;
}
}
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/ ) {
$email_flag = "ERROR";
}
my $urlcommand = $command;
if ($command eq 'Subscribe') {
$command = "SUBSCRIBE rpc-news";
}
if ($command eq 'Unsubscribe') {
$command = "UNSUBSCRIBE rpc-news";
}
if ($command eq 'Suspend') {
$command = "SET rpc-news NOMAIL";
}
if ($command eq 'Resume') {
$command = "SET rpc-news MAIL";
}
my $getInfo = '';
print "Content-Type: text/html\n";
if ($email_flag ne "ERROR") {
open(MAIL,"|$mailprog -t");
print MAIL "To: $to\n";
print MAIL "From: $email\n";
print MAIL "Subject: [rpc-news] $command \n";
print MAIL "Reply-to: $email \n";
print MAIL "$command \n";
print MAIL "EXIT \n";
close (MAIL);
$getInfo = "?result=good";
}
if ($email_flag eq "ERROR") {
$getInfo = "?result=bad";
}
my $rootURL= $ENV{'SERVER_NAME'};
my $url = "http://${rootURL}/thank_you.html${getInfo}&action=${urlcommand}";
print "Location: $url\n\n";
Did you create your script on a Windows machine and upload it to a Linux server without fixing the line endings? Without the -w switch, the shebang line may look like "#!/usr/bin/perl\r", so the system goes looking for a program named "perl\r" (or however the line ending looks). With the -w switch, "#!/usr/bin/perl" doesn't have an indecipherable line ending stuck to it. Instead, that gets stuck to -w where it doesn't cause failure.
I thought there was a perlfaq about this, but I can't seem to find it in the docs at the moment.
Update: I found it over on PerlMonks, in a really old Q&A topic that seems unrelated until you read the body of the message: Answer: How to get rid of premature end of script headers. Yeah, I know, if you were just browsing threads you wouldn't even stop on that one. But here's the text of the post:
If you developed this script on
Windows, it's possible that the script
file has non-UNIX line endings. (The
perl interpreter can handle them, but
the shebang line is interpreted by the
shell, and is not tolerant of
incorrect line endings.) If this is
the problem, the script may terminate
with an error right at the shebang
line.
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/
) {
$email_flag = "ERROR";
}
$email_flag only gets initialized here if the pattern matches - otherwise it's left undefined. You could add an else clause to ensure it gets initialized no matter what.
I would not use that code, it doesn't use CGI.pm (or CGI::Simple ...)
Get "TFMail -- Improved Form Mail" from "nms - web programs written by experts"
Its simple to install, and its written well ( it uses CGI ...)
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` );