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]