LPM: ATP (All Terrain Perl)

Wed Apr 19 20:16:40 CDT 2000

I put a new (for me) spin on a perl program today.  Nothing ground breaking here, but a nice little collection of tricks.

I've got a program that copies log files from several servers to a central location for log analysis.  But that's not the interesting part.

It can be run seamlessly as a CGI script, or from the command line.  After a few failed attempts,  I came up with the following approach:

To determine if I am running as CGI, I just look at $ENV{REMOTE_ADDR}.  (Any cgi-specific environment variable will do.)  If it is true, all I do in this script is blurt out a Content-type line and "<HTML><BODY><PRE>".  From there, my command-line intended print statements work just fine in the browser with no modification.  

I could do some pretty html stuff if $cgi, but this is a utility page.  Plain old courier is good enough.

Another nifty trick for a cgi script is setting $|=1;  This turns buffering off and makes your web page print to the browser in real time, instead of spitting out the entire web page after the job has completed.  This looks more like the paced output we're used to seeing at the command line.  Great for tasks that more than a second or two so you're not staring at the "Loading" animation wondering if your script is really doing anything.

One thing I wanted to do is modify its behavior depending on whether it is run interactively from the command line, or by an NT service (cron specifically).  

The Perl Cookbook suggests:
>15.2. Testing Whether a Program Is Running Interactively
>
>Problem
>
>You want to know whether your program is being called interactively or not. For instance, a user running your program from a
>shell is interactive, whereas the program being called from cron is not.
>
>Solution
>
>Use -t to test STDIN and STDOUT: 
>
>sub I_am_interactive {
>     return -t STDIN && -t STDOUT;
>}
><snip>
>
>
>Discussion
>
>The -t operator tells whether the filehandle or file is a tty device. Such devices are signs of interactive use.

Unfortunately, this doesn't work on NT.  The -t tests return true even when run by a service.  (Note that we're using a third party cron service implementation, not Microsoft's bothersome AT scheduler)

I hacked around this by looking for a command argument.  I provide just such an argument in the cron file, whereas I don't (though I could) from the command line.  Of course, there is no argument when called from a CGI script.

Anybody have any ideas on how to test for interactivity on NT?  I'd like to tidy that part up a bit.

You can see the results here, while simultaneously putting unnecessary strain on our servers.  (Oh Joy!)

         http://edit-www.ket.org/cgi-bin/getlogs.pl

For what it's worth, here's the whole script:

## Script to pull down log files from various servers.
## Deletes logs from remote servers after they are too old. (but not locally)

## This script may be run from the command line, cron, or as a cgi program.
## If any command line parameters are present, actions are logged to a logfile.

use strict;
use Time::localtime;
use File::Copy;

my ($cgi) = $ENV{REMOTE_ADDR};
         ## If it has any value, then we are running as CGI.

if ($cgi) {
         print "Content-type: text/html\n\n<html>
                 <title>$0 - Collect log files</title>
                 <body><pre>\n";
}

my (%sites, $site, @files, $file, $destdir, $destfile);

my $year = "" . (localtime->year + 1900);

my $stale_days = 31;            ## Older than this can be deleted from source server.

         ## loglogfile is a log of the file transfers.
my ($loglogfile) = '\\\\2edit\\logs\\getlog.log';

if (@ARGV > 0) {
                 ## If any paramters given, Then send output to logfile.
         print "Logging to $loglogfile\n";
         open (LOGLOG, ">>$loglogfile")  or warn "WARNING: Can't append to $loglogfile\n";
         select(LOGLOG);
}

$| = 1; ## Turn off buffering.

print scalar ctime;
print " $0 Starting.\n";

%sites = (
         ket     => '\\\\1webserver\\ket-logs' ,
         dl      => '\\\\2live\\logs\\dl-logs' ,
         mim     => '\\\\5SERC\\suitespot\\https-mim-live\\logs',
         serc    => '\\\\5SERC\\suitespot\\https-serc-live\\logs',
         "edit-www"      => '\\\\2edit\\suitespot\\https-edit-www\\logs',
);

foreach $site (keys %sites) {
         # print "$site \t$sites{$site}\n";

         my $count=0;

         my ($tested, $copied, $deleted) = (0,0,0);

         @files = (glob ($sites{$site} . "\\access*") , glob ( $sites{$site} . "\\errors*"));

         $destdir = "\\\\2edit\\logs\\$site\\";

         mkdir ($destdir, 0666) unless (-e $destdir);

         foreach $file (@files) {
                 $tested++;

                 $file =~ /\\([^\\]+)$/;
                 $destfile = "$destdir$1";

                 # print STDERR ".";             

                 #print "test $file,\t$destfile\t" . (-s $file) . "," . (int -M $file) . "\n";

                 #last if (++$count>=6); ## for impatient developing.

                 if ((-s $file != -s $destfile) || !-e $destfile ) {
                         # If the sizes are the same, assume the files are the same.
                         # More reliable than checking dates, I suspect.
                         print "copy $file -> $destfile\n";
                         copy($file, $destfile) or warn "ERROR: Can't copy($file, $destfile) \n";
                         $copied++;
                 }

                 if ( ((-M $file) > $stale_days) &&      (-s $file == -s $destfile) ) {
                                 # If it's really old and we have a good copy, delete the source.
                         # print "TODO: delete old (" . int(-M $file)  . " days) $file\n";
                         # unlink $file  or warn "ERROR: Can't delete $file\n";
                         $deleted++;
                 } 

         }

         printf "Site: %-10s tested:%4d copied:%2d deleted:%2d (not deleting yet) =============\n", 
                 $site, $tested, $copied, $deleted;

}

print scalar ctime;
print " $0 Ending.\n\n";

if ($cgi) {
         print "</pre><p>Go <a href=\"javascript:history.go(-1)\">back</a> to where you once belonged.\n</body></html>\n";
}

-- 
David Hempy 
Internet Database Administrator
Kentucky Educational Television
<hempy at ket.org> -- (606)258-7164 -- (800)333-9764