Capturing command-line output on win32 that hasn't been flushed yet - perl

(Context: I'm trying to monitor a long-running process from a Perl CGI script. It backs up an MSSQL database and then 7-zips it. So far, the backup part (using WITH STATS=1) outputs to a file, which I can have the browser look at, refreshing every few seconds, and it works.)
I'm trying to use 7zip's command-line utility but capture the progress bar to a file. Unfortunately, unlike SQL backups, where every time another percent is done it outputs another line, 7zip rewinds its output before outputting the new progress data, so that it looks nicer if you're just using it normally on the command-line. The reason this is unfortunate is that normal redirects using >, 1>, and 2> only create a blank file, and no output ever appears in it, except for >, which has no output until the job is done, which isn't very useful for a progress bar.
How can I capture this kind of output, either by having every change in % somehow be appended to a logfile (so I can use my existing method of logfile monitoring) just using command-line trickery (no Perl), or by using some Perl code to capture it directly after calling system()?

If you need to capture the output all at once then this is the code you want:
$var=`echo cmd`;
If you want to read the output line by line then you need this code:
#! perl -slw
use strict;
use threads qw[ yield async ];
use threads::shared;
my( $cmd, $file ) = #ARGV;
my $done : shared = 0;
my #lines : shared;
async {
my $pid = open my $CMD, "$cmd |" or die "$cmd : $!";
open my $fh, '>', $file or die "$file : $!";
while( <$CMD> ) {
chomp;
print $fh $_; ## output to the file
push #lines, $_; ## and push it to a shared array
}
$done = 1;
}->detach;
my $n = 0;
while( !$done ) {
if( #lines ) { ## lines to be processed
print pop #lines; ## process them
}
else {
## Else nothing to do but wait.
yield;
}
}
Another option is using Windows create process. I know Windows C/C++ create process will allow you to redirect all stdout. Perl has access to this same API call: See Win32::Process.

You can try opening a pipe to read 7zip's output.

This doesn't answer how to capture output that gets rewound, but it was a useful way of going about it that I ended up using.
For restores:
use 7za l to list the files in the zip file and their sizes
fork 7za e using open my $command
track each file as it comes out with -s $filename and compare to the listing
when all output files are their full size, you're done
For backups:
create a unique dir somewhere
fork 7za a -w
find the .tmp file in the dir
track its size
when the .tmp file no longer exists, you're done
For restores you get enough data to show a percentage done, but for backups you can only show the total file size so far, but you could compare with historical ratios if you're using similar data to get a guestimate. Still, it's more feedback than before (none).

Related

Code hangs when writing log message to text file by multiple source using Perl Script

I am using below code to write log message to text file, the program is getting hanged when different source calls this method in parallel. Is there a way to grant /control parallel writing without breaking the program.
sub sLog {
my $self = 'currentServerDirectory';
my $logMsg = "";
my $fileName = join '_', $self->{LogFilePrefix}, &sTimeStamp("Log");
my $absFileName = "$self->{LogFolder}/$fileName.txt";
open APPHDLER, ">>$absFileName" or &exitErr("Cannot append message to file, $absFileName");
print APPHDLER scalar(localtime(time))." - $logMsg\n";
close APPHDLER;
}
Try using flock -- here is a simple example you can try to understand its behavior:
use strict;
use warnings;
use Fcntl qw/:flock/;
chomp(my $id = `date`);
my $cnt = 0;
while (1) {
open LOG, ">>shared" or die "Couldn't open shared";
flock (LOG, LOCK_EX) or die "Couldn't flock";
print LOG "$id: $cnt\n";
$cnt++;
sleep 1;
close LOG;
}
Say this is saved in flock.pl, then you can run flock.pl& to run one or more instances in the background. Then do tail -f shared to see what happens. Since you are sleeping 1 second between obtaining the lock and releasing it via close LOG , you'll see an update once a second if you have one process. However, if you have N processes, you'll see each one taking N seconds.
In your existing example, you can try adding the use Fcntl and flock lines.
When you open a file for writing, a lock on that file is granted to the process that opened it. This is done to prevent corruption of data, by processes overwriting each other. Possible solutions would be to feed the output data to a single process that handles writing to the log file, making sure that processes close the file and release their locks when they are finished writing, or using a library or file format that is designed for parallel access of files. The first two of those methods would be the easiest and preferred for writing log files like this. There are also probably perl modules (check CPAN) that handle log files.

perl system call not executing randomly

Within a loop construct of a perl script, I have written the following lines to parse text files using system tools, generating temporary text files in the process, and subsequently read the temporary output into an array for processing within the perl script:
system("awk '(NR+2)%4==0' $infile[$i+$j] | tre-agrep -ns -E $dist[$a][$b] -k $query[$a][$b] | awk 'BEGIN{FS=\":\";OFS=\":\"}{print \$1,\$2}' > $outfile");
open(my $FH, "<", $outfile) || die "Can't open $outfile: $!";
while(<$FH>) {
...
}
close($FH);
These commands are repeated twice nearly verbatim (with modification of some of the parameters, but recycling of the file handle) within a loop construct that itself is iterated numerous times. Unexpectedly and seemingly arbitrarily, the program sometimes fails to complete the system call, causing the subsequent lines, which depend on the output generated by the system call, to fail in turn, triggering abortion of the script and display of the rather unhelpful error message "No such file or directory" (with reference to the open statement). Executing the same system call directly from a console rather than within the context of the perl script shows that the command produces the expected output. I refer to this behavior as arbitrary because sometimes my script will variously complete 1 to 3 iterations before failing at the open line, and the basis for the varying success is not clear. When the script is working properly, the system call takes quite some time (around 2 minutes), whereas when it fails, the program moves to the following open line in less than a second. I would thus like to figure out why the system call is sometimes skipped.
The script is run in a bash shell session and the following are included in the script header:
#! /usr/bin/perl
use warnings;
use strict;
I fundamentally agree with #ThisSuitIsBlackNot. However, not knowing what tre-agrep is, it's difficult to translate that part into straight Perl.
That said, at the very least, why not skip the generation of the output file and just read the Unix output directly from Perl?
open my $FH, '-|', "awk '(NR+2)%4==0' $infile[$i+$j] | " .
"tre-agrep -ns -E $dist[$a][$b] -k $query[$a][$b]" or die "$!";
while (<$FH>) {
chomp;
my ($field1, $field2) = split /:/, $_, 2;
}
close $FH;
At worst, the standard output from your system call would be blank, but this wouldn't impact Perl's ability to read nothing (and therefore do nothing).
Of course, it wouldn't hurt to first execute an -e (exists) call to be sure that infile[$i + $j] isn't a ghost.

How do I influence the width of Perl IPC::Open3 output?

I have the following Perl code and would like it to display exactly as invoking /bin/ls in the terminal would display. For example on a terminal sized to 100 columns, it would print up to 100 characters worth of output before inserting a newline. Instead this code prints 1 file per line of output. I feel like it involves assigning some terminal settings to the IO::Pty instance, but I've tried variations of that without luck.
UPDATE: I replaced the <$READER> with a call to sysread hoping the original code might just have a buffering issue, but the output received from sysread is still one file per line.
UPDATE: I added code showing my attempt at changing the IO::Pty's size via the clone_winsize_from method. This didn't result in the output being any different.
UPDATE: As best I can tell (from reading IPC::open3 code for version 1.12) it seems you cannot pass a variable of type IO::Handle without open3 creating a pipe rather than dup'ing the filehandle. This means isatty doesn't return a true value when ls invokes it and ls then forces itself into "one file per line" mode.
I think I just need to do a fork/exec and handle the I/O redirection myself.
#!/usr/bin/env perl
use IPC::Open3;
use IO::Pty;
use strict;
my $READER = IO::Pty->new();
$READER->slave->clone_winsize_from(\*STDIN);
my $pid = open3(undef, $READER, undef, "/bin/ls");
while(my $line = <$READER>)
{
print $line;
}
waitpid($pid, 0) or die "Error waiting for pid: $!\n";
$READER->close();
I think $READER is getting overwritten with a pipe created by open3, which can be avoided by changing
my $READER = ...;
my $pid = open3(undef, $READER, undef, "/bin/ls");
to
local *READER = ...;
my $pid = open3(undef, '>&READER', undef, "/bin/ls");
See the docs.
You can pass the -C option to ls to force it to use columnar output (without getting IO::Pty involved).
The IO::Pty docs describe a clone_winsize_from(\*FH) method. You might try cloning your actual pty's dimensions.
I see that you're setting up the pty only as stdout of the child process. You might need to set it up also as its stdin — when the child process sends the "query terminal size" escape sequence to its stdout, it would need to receive the response on its stdin.

Capturing standard out of a program to a file-like object?

I'm trying to capture standard output of a command to a file-like object in Perl.
I essentially need to do the following:
Execute an OS command, capturing standard output.
Run a regular expression on each line of the file and pull output into an array.
Call another OS command for each item in the array of lines of output from the first command.
How can I do step one? I'd like to execute a command and get its standard out in a filelike object so as to be able to read it line by line.
The first part is easy:
use autodie qw(:all);
open my $input, '-|', 'os-command', #args;
Clearly, the remainder is not much harder:
while (<$input>)
{
next unless m/your regex/;
system 'other-command', $_;
}
Automatic error checking for the open and system calls is provided through autodie.
You might do:
my #input = qx( some_command );
for my $line (#input) {
$line =~ m{some_pattern} and system("some_command", "$line");
}

How can I send multiple images in a server push Perl CGI program?

I am a beginner in Perl CGI etc. I was experimenting with server-push concept with a piece of Perl code. It is supposed to send a jpeg image to the client every three seconds.
Unfortunately nothing seems to work. Can somebody help identify the problem?
Here is the code:
use strict;
# turn off io buffering
$|=1;
print "Content-type: multipart/x-mixed-replace;";
print "boundary=magicalboundarystring\n\n";
print "--magicalboundarystring\n";
#list the jpg images
my(#file_list) = glob "*.jpg";
my($file) = "";
foreach $file(#file_list )
{
open FILE,">", $file or die "Cannot open file $file: $!";
print "Content-type: image/jpeg\n\n";
while ( <FILE> )
{
print "$_";
}
close FILE;
print "\n--magicalboundarystring\n";
sleep 3;
next;
}
EDIT: added turn off i/o buffering, added "use strict" and "#file_list", "$file" are made local
Flush the output.
Most probably, the server is keeping the response in the buffer. You may want to do fflush(STDOUT) after every print or autoflush STDOUT once.
Have a look at http://www.abiglime.com/webmaster/articles/cgi/032498.htm
[quote]
To use the script below, you'll need
to implement a called "non-parsed"
CGIs on your site. Normally, the web
server will buffer all output from
your CGI program until it the program
finishes. We don't want that to happen
here. With Apache, it's quite easy. If
the name of your CGI program starts
with "nph-" it won't be parsed. Also,
change the glob "/some/path/*" to the
path where you want to look for files.
[/quote]