Nested while loop not executing - perl

I have the following code, the only problem is that when the code gets to the nested while loop it skips it, I'm assuming the condition is not being met, but can anyone see something I amy have done wrong? I have verified that all the flags that I give to the script are correct and that the job_name is what I think it should be.
open $alOut,
"/home/usr/bin/test.pl -j EW-% -j RA-% -l 0 | grep `date \"+%m/%d/%Y\"` | sort -k 3,3|";
while (<$alOut>) {
chomp;
my ($job_name, $date, $start_time, $end_time, $duration,
$state, $return, $expected_end_time) = split(/\s+/, $_);
# Go to next iteration if jobname is EW-INTERNAL-AUTOSYS,
# EW-INTERNAL-DB-LONGQUERY-ALERT, EW-INTERNAL-DB-LONGQUERY-ALERT,
# EW-CIIM-ADJ-TRIGGER, or EW-S140-ADJ-TRIGGER
if (($job_name eq "EW-INTERNAL-AUTOSYS") ||
($job_name eq "EW-INTERNAL-DB-LONGQUERY-ALERT") ||
($job_name eq "EW-INTERNAL-SYSUP") ||
($job_name eq "EW-CIIM-ADJ-TRIGGER") ||
($job_name eq "EW-S140-ADJ-TRIGGER"))
{
next;
}
#Expected Start Time
open $alOut2,
"/home/usr/bin/test.pl -j $job_name -q -l 0 | grep -E `condition:|start_times:`";
while (<$alOut2>) { .... }
}

You should check for errors from open:
open $fh, ... or die "Can't open: $!";
And in this grep:
grep `condition:|start_times:`
you probably want regular single quotes ('), not backticks, the shell is going to try to run a command called condition:. And I think you are missing a final | in that command.

You should always check the value returned by open:
open "...whatever..." or die "Can't open: $!";
That will probably tell you all you need to know, but offhand, I can see two problems:
The second open isn't terminated by a | character.
The backticks after the grep should be apostrophes.

Related

How can I read from both STDIN and files passed as command line arguments without using `while(<>)`?

This post demonstrates how one can read from STDIN or from a file, without using the null filehandle (i.e., while(<>)). However, I'd like to know how can one address situations where input may come from files, STDIN, or both simultaneously.
For instance, the <> syntax can handle such a situation, as demonstrated by the following minimal example:
$ echo -e 'a\nb\nc' | \
while read x; do echo $x > ${x}".txt"; done; echo "d" | \
perl -e "while(<>) {print;}" {a,b,c}.txt -
a
b
c
d
How can I do this without using while(<>)?
I want to avoid using <> because I want to handle each file independently, rather than aggregating all input as a single stream of text. Moreover, I want to do this without testing for eof on every line of input.
If you want to handle each file independently of the others, you should loop over the arguments that have been given and open each file in turn:
for (#ARGV) {
open(my $fh, '<', $_) || die "cannot open $_";
while (<$fh>) {
... process the file here ...
}
}
# handle standard input
while (<STDIN>) {
...
}
Here is an idea based on Tim's that checks if STDIN has something to read (NON BLOCKING STDIN). This is useful if you don't really care about a user entering input manually from STDIN yet still want to be able to pipe and redirect data to the script.
File: script.pl
#!/usr/bin/env perl
use IO::Select;
$s = IO::Select->new();
$s->add(\*STDIN);
if ($s->can_read(0)) { push #ARGV, "/dev/stdin"; }
for (#ARGV) {
open(IN, "<$_") || die "** Error opening \"$_\": $!\n";
while (<IN>) {
print $_
}
}
$> echo "hello world" | script.pl
hello world
$> script.pl < <(echo "hello world")
hello world
$> script.pl <(echo "hello world")
hello world
$> script.pl <<< "hello world"
hello world
$> script.pl
$>
This was already answered by the Answer to which the question links.
#ARGS = '-' if !#ARGV;
for my $qfn (#ARGV) {
open($fh, $qfn);
while (<$fh>) {
...
}
}

How to make perl to keep perform action until the match is found

I am new to Perl and trying to write a code to keep executing an action until the match is found and else give an error.
I am trying to execute a command ps -ef and check if it has got any process running in the name of "box", if there is no process named "box" found, I want to repeat ps -ef command execution until it gets the "box" process and then proceed to next action.
#!/usr/bin/perl -w
open (FH, "ps -ef |") or die "Cannot run the command:$!\n";
$line = "box";
while (<FH>) {
if (/$line/i) { next; }
else {
print ("ps -ef |") or die "Cannot run the command:$!\n");
}
}
close (FH);
You need to use an infinite loop and an exit-condition. Your condition is that the ps -ef command contains the word box. There is no need to open a pipe to that command explicitly, you can just run it as a system call with the qx operator (same as backticks).
use strict;
use warnings;
my $ps;
PS: while (1) {
$ps = qx/ps -ef/;
last PS if $ps =~ m/box/i;
print '.'; # do something in every run
}
print $ps;
As this has come up in the comments as well as in in AdrianHHH's answer: it might make sense to sleep after every run to make sure you don't hog the CPU. Depending on the nature of the process you are looking for, either the sleep builtin or usleep from Time::HiRes might be appropriate. The latter let's your program rest for milliseconds, while the builtin only works with full seconds. These might be too long if the target box process is very quick.
Explanation of your code:
Note that you have some issues in your implementation. I'll explain what your code does. This is taken from the question, comments are mine.
#!/usr/bin/perl -w
# open a filehandle to the ps command
open (FH, "ps -ef |") or die "Cannot run the command:$!\n";
$line = "box";
# read the output of one run line by line, for each line execute
# the block
while (<FH>) {
# if there is 'box' case-insensitive, skip the line
if (/$line/i) { next; }
else {
# else output (not run!) the command
print ("ps -ef |") or die "Cannot run the command:$!\n");
}
}
close (FH);
After it went through all the lines of the output of your command once it will stop.
I would recommend using pgrep(1) instead of ps because it lets you do a more granular search. With ps -ef, you potentially have to deal with cases like:
boxford 6254 6211 0 08:23 pts/1 00:00:00 /home/boxford/box --bounding-box=123
It's hard to tell if you're matching a process being run by a user with box in their username, a process that has box somewhere in its path, a process named box, or a process with box somewhere in its argument list.
pgrep, on the other hand, lets you match against just the process name or the full path, a specific user or users, and more. The following prints a message when a process named box appears (this looks for an exact match, so it will not match processes named dropbox, for example):
use strict;
use warnings;
use 5.010;
use String::ShellQuote qw(shell_quote);
sub is_running {
my ($proc) = #_;
my $cmd = 'pgrep -x ' . shell_quote($proc) . ' >/dev/null 2>&1';
system($cmd);
if ($? == -1) {
die "failed to execute pgrep: $!";
}
elsif ($? & 127) {
die "pgrep died with signal ", $? & 127;
}
else {
my $status = $? >> 8;
die "pgrep exited with error: exit status $status" if $status > 1;
return $status == 0;
}
}
my $proc = 'box';
until ( is_running($proc) ) {
sleep 1;
}
say "Process '$proc' is running";
Note that pgrep doesn't have a case-insensitive flag, probably because process names in *nix are almost always lowercase. If you really need to do a case-insensitive match, you can pass [Bb][Oo][Xx] to the is_running function.
The ps command outputs the current list of processes, then it completes. The code in the question reads that output. Suppose that the first ps command that is executed does not contain the wanted line, then there is nothing in the code in the question to run the ps command again.
The next statement in the question makes the script move on to the next line in the output from ps, not to rerun the command. The else print ... after the next will probably be executed for the first line of the output from ps. The outcome is that the print is run for each line in the ps output that does not have the wanted text and that the next command has no significant effect. In the code print ... or die "..." the or die "..." part is not very useful, the print is unlikely to fail and even if it did the die message would be wrong.
Perhaps you should write some code in the following style. Here the ps is run repeatedly until the wanted text is found. Note the sleep call, without that the script will keep running without pause, possibly preventing real work or at least slowing it down.
# This code is not tested.
use strict;
use warnings;
my $found_wanted_line = 0; # Boolean, set to false
my $line = "box";
while ( ! $found_wanted_line ) {
open (my $FH, "ps -ef |") or die "Cannot run the command:$!\n";
while (<$FH>) {
if (/$line/i) {
$found_wanted_line = 1; # Boolean, set to true
last;
}
}
close ($FH);
if ( ! $found_wanted_line )
sleep 2; # Pause for 2 seconds, to prevent this script hogging the CPU.
}
}

a perl script faster than rsync for images and partitions, that produces two-way diffs

sysadmin1138 and Martin have reported a replacement for rsync that works on block devices (partitions). It is based on perl, but I want to store two-way diffs.
It applies changes in a block device to a preexisting outdated backup image. This is the second best to do that, after lvmsync that I did not use because my block device is not in lvm.
But I wanted also to collect separately the changes, in order to be able to regenerate the previous backup image (e.g., to recover a deleted file).
The following code does collect these changes, when the rsync remplacement runs:
patch=diff.`date +'%Y%m%d.%H%M%S.%N'`.gz
ssh $username#$backupnas "perl -'MDigest::MD5 md5' -ne "\
" 'BEGIN{\$/=\1024};print md5(\$_)' $remotepartition "\
" | gzip -c "\
|gunzip -c|LANG= tee >(wc -c|LANG= sed '1s%^%number of 64 bytes blocs: %' >&2) \
|LANG= perl -'MDigest::MD5 md5' -e 'open DISK,"'"<$partition"'" or die $!; '\
' while( read DISK,$read,1024) '\
' { '\
' read STDIN,$md,16; '\
' if($md eq md5($read)) {print "s"} else {print "c" . $read } '\
' } '\
| gzip -c \
|ssh $username#$backupnas "touch $remotepartition;LANG= tee -a $patch|gunzip -c"\
" |perl -e 'open REVP,\"| gzip -c > rev.$patch\"; "\
" open PREVIOUS,\"<$remotepartition\"; "\
' $rev = "PREVIOUS met EOF if length<1024."; $rev=$rev.$rev; '\
' $rev=$rev.$rev.$rev.$rev; $rev=$rev.$rev.$rev.$rev; '\
' while(read STDIN,$read,1) '\
' { '\
' if ($read eq "s") '\
' { '\
' if (length($rev) eq 1024) { print REVP "s" } ; '\
' $s++ '\
' } else { '\
' if ($s) { seek STDOUT,$s*1024,1; seek PREVIOUS,$s*1024,1; $s=0}; '\
' if (read PREVIOUS,$rev,1024) { print REVP "c".$rev }; '\
' read STDIN,$buf,1024; '\
' print $buf '\
' } '\
" }' 1<> $remotepartition "
$rev is initialized to a scalar string of length 1024 (I don't know how to make it better).
Without the formatting and with more or die, this is:
patch=essai_delta.`date +'%Y%m%d.%H%M%S.%N'`.gz
ssh username#backupnas "perl -'MDigest::MD5 md5' -ne 'BEGIN{\$/=\1024};print md5(\$_)' essai_backup | gzip -c" | \
gunzip -c | LANG= tee >(wc -c|LANG= sed '1s%^%bin/backup_essai: number of 64 bytes blocs treated : %' >&2) | \
LANG= perl -'MDigest::MD5 md5' -e 'open DISK,"</data/data/com.spartacusrex.spartacuside/files/essai" or die $!; while( read DISK,$read,1024) { read STDIN,$md,16; if($md eq md5($read)) {print "s"} else {print "c" . $read } }' /data/data/com.spartacusrex.spartacuside/files/essai | \
gzip -c | \
ssh username#backupnas "LANG= tee -a $patch | gunzip -c | perl -e 'open REVP,\"| gzip -c > rev.$patch\" or die \$!; open READ,\"<essai_backup\" or die \$!; \$rev = \"if length<1024, EOF met in READ.\"; \$rev=\$rev.\$rev.\$rev.\$rev; \$rev=\$rev.\$rev.\$rev.\$rev; \$rev=\$rev.\$rev; while(read STDIN,\$read,1) { if (\$read eq \"s\") {if (length(\$rev) eq 1024) { print REVP \"s\" or die \$! } ; \$s++} else { if (\$s) { seek STDOUT,\$s*1024,1 or die \$!; seek READ,\$s*1024,1 or die \$!; \$s=0}; if (read READ,\$rev,1024) { print REVP \"c\".\$rev or die \$! } else { print STDERR \$!}; read STDIN,\$buf,1024 or die \$!; print \$buf or die \$!} }' 1<> essai_backup"
To apply the forward or backward diff, I can use:
ssh username#backup_nas "LANG= cat diff_delta.20141202.110302.0935 | gunzip -c | perl -ne 'BEGIN{\$/=\1} if (\$_ eq\"s\") {\$s++} else {if (\$s) { seek STDOUT,\$s*1024,1; \$s=0}; read STDIN,\$buf,1024; print \$buf}' 1<> image.file"
So I succeeded to answer first version of this post. This was tested on an example of 200k with some modifications.
I have specific questions about this code.
Why did the original example used read ARGV, is it bad practice ?
I have put many or die $!, is it wise or does it just destroy readability ?
PREVIOUS and STDOUT are the same file opened twice (to avoid seek STDOUT,-1024,1), is it considered good practice ?
[question migrated manually from programmers.so]
Why did the original example used read ARGV, is it bad practice ?
This is a religious question. For one-line SSH hacks like this, it's more-or-less fine if you and the people likely to be maintaining them are very good at perl idioms. Common wisdom though is that new perl code should use strict; and employ conventions that read more intuitively. The fact that you had to ask about bare ARGV and be referred to an obscure perlmonk article is exactly why. I'd look for an opportunity to distribute well-written, readable scripts to a standard place on the target machine and then run them remotely with simple ssh commands. On the other hand, the way above is great for job security.
I have put many or die $!, is it wise or does it just destroy readability ?
It is always handy to know why a script died rather than get the obscure default error trace. The readability issue is only that you're using this broken technique of putting a fairly large script in an ssh command. As suggested above, if you set yourself up with a saner environment, adding or die $! will not hurt readability at all. It will enhance it by showing where you expect errors may occur.
PREVIOUS and STDOUT are the same file opened twice (to avoid seek STDOUT,-1024,1), is it considered good practice ?
Opening two descriptors on the same file in the same thread is not bad practice if the OS allows it, which most will. It's a little obscure, so it needs a comment. This is another thing you can do if you avoid in-line script.
What is really strange practice is the way the buffer for $rev is built up as a string by repeated concatenation to get 1024 characters. This is unnecessary. You can just say $rev = ''; and the string's length will be expanded automatically to the input size by read. If you really want to pre-allocate, just say $rev = '-' x 1024;.
Addition
I just learned about a nice feature of bash. Its printf with the %q format specifier will add bash escapes to any string. With this, you could write escape-free bash and/or perl code and then say
ssh $username#$backupnas "$(printf "%q" $(cat script.bash))"

How do apply the flip-flop operator to cat output?

I'm parsing a crash log using perl and I want to extract the backtrace component. I obtain the log file using the following command:
$log = `adb shell 'ls -d ./tombstones/*' |grep tombstone_ | tr '\r' ' ' | tail -n1 | xargs adb shell cat`;
(I'm not familiar with perl, as you can see)
I would like to scan the resulting variable (log) for backtrace sections. These sections exist between the text: "backtrace", and the following empty line.
My question is, how do I apply the flip flop operator to the local variable as if it were a file input?
Do you need to use the flip-flop operator? How about a regular expression?
#backtrace_sections = $log =~ /(^backtrace.*?)\n\n/gm;
I assume what you want is an equivalent of the construct
while (<>) {
if (m/backtrace/ .. m/^$/) {
# processing
}
}
I see two ways to do this off the top of my head:
Use the backtick operator in array context:
my #lines = qx{$your_command};
for (#lines) {
if (m/backtrace/ .. m/^$/) {
# process
}
}
Use open to open the file:
open my $fh, '-|', qq{$your_command} or die "Can't open command: $!";
while (<$fh>) {
if (m/backtrace/ .. m/^$/) {
# process
}
}
close $fh or die "close failed: $! $?";
Doing it this way has the nice effect that you don't have to read the entire output into memory.

In Perl, how can I watch a directory for changes?

use Text::Diff;
for($count = 0; $count <= 1000; $count++){
my $data_dir="archive/oswiostat/oracleapps.*dat";
my $data_file= `ls -t $data_dir | head -1`;
while($data_file){
print $data_file;
open (DAT,$data_file) || die("Could not open file! $!");
$stats1 = (stat $data_file)[9];
print "Stats: \n";
#raw_data=<DAT>;
close(DAT);
print "Stats1 is :$stats1\n";
sleep(5);
if($stats1 != $stats2){
#diff = diff \#raw_data, $data_file, { STYLE => "Context" };
$stats2 = $stats1;
}
print #diff || die ("Didn't see any updates $!");
}
}
Output:
$ perl client_socket.pl
archive/oswiostat/oracleapps.localdomain_iostat_12.06.28.1500.dat
Stats:
Stats1 is :
Didn't see any updates at client_socket.pl line 18.
Can you tell me why the stats are missing and how to fix it?
The real fix is File::ChangeNotify or File::Monitor or something similar (e.g., on Windows, Win32::ChangeNotify).
use File::ChangeNotify;
my $watcher = File::ChangeNotify->instantiate_watcher(
directories => [ 'archive/oswiostat' ],
filter => qr/\Aoracleapps[.].*dat\z/,
);
while (my #events = $watcher->wait_for_events) {
# ...
}
Note that I'm answering your original question, why the stat() seemed to fail, rather than the newly edited question title, which asks something different.
This is the fix:
my $data_file= `ls -t $data_dir | head -1`;
chomp($data_file);
The reason this is the fix is a little murky. Without that chomp(), $data_file contains a trailing newline: "some_filename\n". The two argument form of open() ignores trailing newlines in filenames and I don't know why because two-arg open mimics shell behavior. Your call to stat(), however, does not ignore the newline in the filename, so it is stat()ing a non-existent file and thus $stats1 is undef.