I have tried to script around the problem using the stat command to check modified times, this seems to work OK but my main issue at the moment is one of the script hanging.

I'm assuming (!) that this is because it's opening file handles to things that aren't actually there, hence this is my area of attack. Here's a full copy of the code.. 



# Main loop:
# 

package PerlSvc;


# these variables cannot be 'my'
$Name = 'Filepoll';
$DisplayName = 'File Poll Service';


sub Startup {

    # Read in inifile values
    ::GetConfig();

    # Get list of servers for this DSM
    @allservers = ::GetServerList();

    # remove excluded servers
    for $item (@::ExcludeList){
        chomp $item;
        $seen{$item} = 1;
    }
    for $server (@allservers){
        if (!$seen{$server}){
            push (@servers, $server);
        }
    }

    $total = scalar(@servers);
    $serverstring = join (",",@servers);
    ::Log("FilePoll service started checking $total servers: $serverst
+ring ignoring: $::Exclude");


    # Set all stored status's to a 1 (O.K)
    %status = %pingstatus = ();
    for $server (@servers) {
        chomp $server;
        $status{$server} = 1;
        $pingstatus{$server} = 1;
    }

    my $ticker=0;
    my $now;
    
    ($::Delay lt 0) and ($::Delay = 120);

    while(ContinueRun()) {
        $now = time ();
        if ($now > $ticker) {
            $ticker=$now + $::Delay;

            # Find todays and yesterdays date, for file management

            $today = ::Datestr(time);
            $tooold = time - (24*60*60);
            $thisminute = time - 60;
            $yesterday = ::Datestr($tooold);
            ($todaysdate, undef) = split (" ",$today);
            ($yesterdaysdate, undef) = split (" ",$yesterday);

            # Main loop
            for $servername (@servers){
                last if (!(ContinueRun()));
                chomp $servername;
                $oldfile[0] = "\\\\$servername\\$::PollDir\\$yesterday
+sdate.filepoll";
                $currentfile = "\\\\$servername\\$::PollDir\\$todaysda
+te.filepoll";

                if (::PingCheck($servername) == -1){
                    if ($pingstatus{$servername} eq 0){ 
                        ::Error ("$servername - FilePoll: Failed to wr
+ite to file system on $servername, server not responding to a ping");
                        next;
                    }
                    $pingstatus{$servername} = 0;
                    next;
                }
                else {
                    $pingstatus{$servername} = 1;
                }

                # If a file exists from yesterday, delete it AND all *
+.filepoll files created more than 24 hours ago
                if (-e $oldfile[0]){
                    unlink @oldfile;
                    # Check for any other filepoll files
                    @allfilepolls = <//$servername/$::PollDir/*.filepo
+ll>;
                    @delete = ();
                    for (@allfilepolls){
                        $mtime = (stat("$_"))[10];
                        if ($mtime < $tooold){
                            push @delete, "$_";
                        }
                    }
                    unlink @delete if (@delete);
                }

                # Write to todays file
                
                if (open (FILEPOLL,">>$currentfile")){
                    print FILEPOLL "$today\n";
                    close (FILEPOLL);
                }

                # Check file modification time
                
                $changetime = (stat("$currentfile"))[9];
                if ($changetime < $thisminute){
                    # File hasn't been updated in the last minute
                    $status{$servername} = 0;
                }
                else {
                    $status{$servername} = 1;
                }

                if ($status{$servername} eq 0){ 
                    ::Error ("$servername - FilePoll: Failed to write 
+to file system ($currentfile) on $servername, please check");
                }

            }

        }

        open (LOG,">$::logfile");
        print LOG "Poller Status\n";
        for (keys %status){
            print LOG "$_\t$status{$_}\n";
        }
        print LOG "\nPing Status\n";
        for (keys %status){
            print LOG "$_\t$pingstatus{$_}\n";
        }
        close (LOG);

        sleep (4);
    }
}





sub Install {
    # add your additional install messages or functions here
}

sub Remove {
    # add your additional remove messages or functions here
}

sub Help {
    # add your additional help messages or functions here
}


##############################################################
package main;
##############################################################

# any additional support code can go here

# module references
use Config::Inifiles;
use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 );
use Win32::EventLog;
use Win32::ODBC; 


# Constant definitions

$ImagePath = $Registry->{"LMachine/SYSTEM/CurrentControlSet/Services/$
+PerlSvc::Name//ImagePath"};
$INIFILE = $logfile = $ImagePath->[0];
$INIFILE =~ s/[^\\:]+$/filepoll.ini/;
$logfile =~ s/[^\\:]+$/filepoll.log/;

sub GetConfig () {

    my $cfg = Config::IniFiles->new (-file => "$INIFILE",-default=>"De
+fault");
    if (defined ($cfg)) {
        # load configuration variables.

        $Delay=$cfg->val("Common","PollFileDelay");
        $PollDir = $cfg->val("Common","PollDir");
        $ServerClasses = $cfg->val("Common","ServerClasses");
        $Exclude = $cfg->val("Common","Exclude");

        @ExcludeList = split(/^/,$Exclude);
    }
    else {
        ::Log ("Failed to open $INIFILE."); 
    }
    return;
}


sub Datestr(){
# Generate a date string
    my $time = $_[0];
    my ($sec,$min,$hour,$mday,$mon,$year,undef,undef,undef) = localtim
+e($time);
    $year += 1900;
    $mon += 1;
    $datestr = sprintf ("%2d%s%02d%s%04d%s%2d%s%02d%s%02d",$mday,"-",$
+mon,"-",$year," ",$hour,":",$min,":",$sec);
    return ($datestr);
}

sub PingCheck () {
    my $ipaddress = $_[0];
    my $results = `ping $ipaddress -n 1`;
    return (-1) if ($? != 0);
    return (-1) if ($results =~ /Request timed out/);
    return (-1) if ($results =~ /Destination host unreachable/);
    return (0);
}

sub Error {
    my $message = $_[0];
    `cawto LLH0001ELS $message`;
}

sub Log {
    my $message = $_[0];
    my $EventLog;
    my %event=(
        'EventID',100,
        'EventType',EVENTLOG_INFORMATION_TYPE,
        'Category',NULL,
        'Strings',$message,
    );
    $EventLog = new Win32::EventLog( 'FilePoller' ) || die $!;
    $EventLog->Report(\%event) || die $!;
}

sub GetServerList {
    my @array = ();
    my @results = `wvgethosts -o hosts -c $ServerClasses`;
    
    for (@results){
        push (@array, $1) if (/\s+(\w\w\w\d\d\d\d\w\w\w)\s+\//);
    }
    
    @array = sort {$a cmp $b} @array;
    return (@array);
}

[download]

In reply to Re: Re: file poll script by northen.soul
in thread file poll script by northen.soul

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.