Hello, i'm desperate
i need to watch some 20 textfiles in one special directory. whenever one or
more of the files are updated, i need to inform a script on a linux server,
that its supposed to check the referring - updated - file on the share, the
win32 system has written it to. since there is no real approach to
changenotify on linux, i'm forced - or rather prefer - taking the
perl/win32 solution using Win32:ChangeNotify. ok, now the filechange occurs
and i connect the linux server, so that he can supply database and mail
procession according to the updates in the file, wich filename has been
just submitted from my watcher script. problem is that the watcher script,
when detecting such a change is busy for half a minute, until it gets the
confiramtion from the linux script, that all has been very well. if, in the
meantime another fileupdate occurs, the watcher script will not take any
notic - simply ignore it. this update will not be recognised until the next
accepted notification change happens.
then there was this stuff about fork(), the ability to delegate all
incomming requests to child threads, so that the main one could check for
further updates. then, build 613 popped up like a miracle, just the moment
i've recognised, that i would need this function.
however, developement turned out to be very difficult for me. i was now
able to start a new thread whenever updating one of the files. apart from
the fact, that it ended up in an error like 'panic: pseudo fork()....' when
updates where too fast, it all looked great. but trying the exact thing a
little later in my script to do the socket for my connect the linux host,
it stopped working.
removing the first fork() resulted into a bizarre error: Bizarre SvTYPE[35]
pointint to a line written like this:
die "can't fork: $!" unless defined($kidpid = fork());
i think, this is not a bug in the fork implementation, i presume, its some
error in my code. therefore i take the liberty to post it here, maybe
somebody could check.. :)
however, the script should end up meeting the following requirements:
- whenever update on file in respective folder made, connect to server,
submitting file info, if other thread busy with that, wait until the
other's finished and then try again
- the server must be fed with the file name, session time and the
file-updatetime. the server returns error, or success to be evaluated by
the script
#!c:\perl\bin\perl.exe
use Win32::ChangeNotify;
use File::Find;
use IO::Socket;
$path="r:";
$Sig_Path = $path . "\\sig";
$key_file = $path . "\\key\\files.key";
$LOG = $path . "\\client.log";
$php_script = "C:\\php3\\php.exe -q r:\\scripts\\connect-local.php3";
$host = "192.168.0.1";
$port = 9000;
$WatchSubTree=0;
$Events='FILE_NAME';
$changes=0;
$notify = Win32::ChangeNotify->new($Sig_Path,$WatchSubTree,$Events);
while (1) {
$notify->wait;
++$changes;
# this fork code is mostly copied from an expample for fork
# in the perl book from larry wall
FORK: {
if($pid=fork){
wait;
} elsif(defined $pid){
&update_list;
} elsif($! =~ /No more processes/){
print "NO MORE!!\n";
sleep 5;
redo FORK;
} else {
die "Kann nix Fork: $!\n";
}
}
$notify->reset;
}
sub update_list
{
$SID = time;
if(-e $key_file){
open(KEY_FILE,"<$key_file") || die "Keyfile unreadable!\n$!\n";
while(<KEY_FILE>){
chop($_);
($this_file,$this_date) = split/;/,$_;
$old_file{$this_file} = $this_date;
}
close(KEY_FILE);
}
&scan_dir;
&write_keys;
&connect_server;
}
sub scan_dir
{
find(\&wanted, $Sig_Path);
sub wanted
{
$status = -T $_;
if(($status) && ($_ =~ m/\.sig/i)){
push @file_path, $File::Find::name;
push @file_name, $_;
$this_time = (stat($File::Find::name))[9];
if(!defined($file{$_})){
$this_action = "AD";
} else {
$this_action = "UP";
}
if($old_file{$_} < $this_time){
$file{$_} = $this_time;
push @file_cue, $_ . "*" . $SID . "*" . $this_time;
&client_log($this_action,$SID);
} else {
$file{$_} = $old_file{$_};
}
}
}
}
sub write_keys
{
open(KEY_FILE, ">$key_file") || die "Invalid folder!!\n$!\n";
while(($key,$val) = each %file){
print KEY_FILE $key . ";" . $val . "\n";
}
close(KEY_FILE);
}
sub connect_server
{
$status_type[1] = "Failed..........";
$status_line[1] = "Unknown Reason";
$status_type[2] = "Failed..........";
$status_line[2] = "Access denied";
$status_type[3] = "Success.........";
$status_line[3] = "Data transmitted";
my ($kidpid, $handle, $line);
$handle =
IO::Socket::INET->new(Proto=>"tcp",PeerAddr=>$host,PeerPort=>$port) or die
"can't connect to port $port on $host: $!";
$handle->autoflush(1); # so output gets there right away
# The script will hang itself up right here... the server detects a connect
but afterword get's stuck.
FORK: {
if($pid=fork){
while (defined ($line = <$handle>)) {
if($_ =~ "Data
recieved-([0-9]{4}).([0-9]{2}).([0-9]{2})
([0-9]{2}):([0-9]{2}):([0-9]{2})"){
$date = $3 . "." . $2 . "." . $1 . " " . $4 .
":" . $5 . ":" . $6;
if($status<3){
$status = 3;
}
} elsif($_ =~ "Access Denied"){
if($status<2){
$status = 2;
}
} else {
if($status<1){
$status = 1;
}
}
&client_log($status_type[$status],$status_line[$status])
}
kill("TERM", $kidpid);
} elsif(defined $pid){
print $handle "files#" . join(":",@file_cue);
print STDERR "[" . &get_date . "] Sending: files#" .
join(":",@file_cue)
. "\n";
undef @file_cue;
} elsif($! =~ /No more processes/){
print "NO MORE!!\n";
sleep 5;
redo FORK;
} else {
die "Kann nix Fork: $!\n";
}
}
}
sub client_log
{
$alias{"OH"} = "Update pending..";
$alias{"AD"} = "New Signalfile..";
$alias{"UP"} = "Signals updated.";
$date = &get_date;
open(LOG,">>$LOG") || die "No Debugging,\n$!\n";
print LOG "[" . $date . "] " . $alias{$_[0]} . ": " . $_[1] . "\n";
close(LOG);
print "[" . $date . "] " . $alias{$_[0]} . ": " . $_[1] . "\n";
print STDERR "[" . $date . "] " . $alias{$_[0]} . ": " . $_[1] . "\n";
}
sub get_date
{
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$date = sprintf("%02d.%02d.%04d %02d:%02d:%02d", $mday, ($mon+1),
($year+1900), $hour, $min, $sec);
return scalar $date;
}
---
You are currently subscribed to perl-win32-users as: [archive@jab.org]
To unsubscribe, forward this message to
[EMAIL PROTECTED]
For non-automated Mailing List support, send email to
[EMAIL PROTECTED]
