$script_db = "C:\\nt\\private\\windows\\setup\\bom\\scripts.dat"; @script_fields = ( "time", "script", "lang", "machine", "status", "eta", "build", "error", "state" ); sub LOCK_SH { 1 } sub LOCK_EX { 2 } sub LOCK_NB { 4 } sub LOCK_UN { 8 } sub script_status_update { my ( $state, $status, $time, $script, $script_id, $lang, $build, $date, $products, $machine, $new ) = 0; $state = shift @_; $time = shift @_; $machine = shift @_; $status = shift @_; @args = split ' ', $_[0]; $script = shift @args; $script =~ s/(\w+)\.bat/$1/i; foreach $arg ( @args ) { SWITCH: { if ( $sup_lang{uc $arg} ) { $lang = uc $arg; last SWITCH; } if ( is_build($arg) ) { $build = uc $arg; last SWITCH; } if ( is_date($arg) ) { $date = $arg; last SWITCH; } if ( $sup_prod{uc $arg} ) { $products{uc $arg} = 1; last SWITCH; } } } $lang = USA unless $lang; ### Load the DB. &read_script_dat(); if ( $Scripts{time}{$time} ) { $script_id = $time; } else { if ( $Scripts{script}{$script} ) { foreach $key ( keys %{ $Scripts{script}{$script} } ) { $new = 0; foreach $sub_key ( "script", "lang", "build", "machine" ) { unless ( eval "\$Scripts{script}{\$script}{\$key}{\$sub_key} =~ /\$$sub_key/i" ) { $new = 1; next; } } $script_id = $key; last unless $new; } } else { $new = 1; } } if ( $script_id and $state =~ /START/i ) { my $new_id = $time; foreach $sort_method ( @script_fields ) { eval "\$Scripts{time}{\$new_id}{\$new_id}{\$sort_method} = $Scripts{time}{\$script_id}{\$script_id}{\$sort_method}"; } delete $Scripts{time}{$script_id}; $script_id = $new_id; } ### Make new script ID; $script_id = $time if $new; foreach $sort_method ( @script_fields ) { eval "\$Scripts{time}{\$script_id}{\$script_id}{\$sort_method} = \$$sort_method"; } $Scripts{time}{$script_id}{$script_id}{error} = "NO" unless $Scripts{time}{$script_id}{$script_id}{error} or $Scripts{time}{$script_id}{$script_id}{error} =~ /YES/i; write_script_dat(); } sub clear_script_hash { foreach $sort_method ( @script_fields ) { delete $Scripts{$sort_method}; } } sub read_script_dat { ### Clear out the Scripts hash. clear_script_hash; open (DB, $script_db) || die "Can't read $script_db: $!\n"; unless ( flock ( DB, LOCK_EX | LOCK_NB ) ) { print "$$: Can't read during write update! Waiting for read lock ($!) ...."; unless ( flock ( DB, LOCK_EX)) { print "ERROR: flock: $!" } } while () { chomp; my ($time, $script, $lang, $machine, $status, $last_err, $eta, $build, $state) = split(/\|/); ### Strip .bat from $script $script =~ s/(\w+)\.bat/$1/i; foreach $sort_method ( @script_fields ) { eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{script} = \$script"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{lang} = \$lang"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{machine} = \$machine"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{status} = \$status"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{error} = \$last_err"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{eta} = \$eta"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{time} = \$time"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{build} = \$build"; eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{state} = \$state"; } } flock ( DB, LOCK_UN ); close (DB); } sub write_script_dat { my $Script_Save; ### Make sure we can get an exclusive lock open (DB, "$script_db") || die "Can't read $script_db: $!\n"; unless ( flock (DB, LOCK_EX | LOCK_NB ) ) { print "$$: Must have exclusive lock! - $!\n"; unless ( flock ( DB, LOCK_EX ) ) {die "flock: $!\n" } } close DB; ### Open DB. open (DB, ">$script_db") || die "Can't read $script_db: $!\n"; ### Lock the DB. for ( $x = 0; $x <= 10; $x++ ) { my $success = 0; if ( flock (DB, LOCK_EX | LOCK_NB ) ) { $success = 1; } else { print "\n$$: Must have exclusive lock! - $!\n"; } last if $success; } # unless ( flock (DB, LOCK_EX | LOCK_NB ) ) { # $bogus = 1; # print "$$: Must have exclusive lock! - $!\n"; # unless ( flock ( DB, LOCK_EX ) ) {print "ERROR: flock: $!\n" } # } # } ### Create the new DB file. foreach $key ( sort bykey keys %{ $Scripts{time} } ) { $Script_Save .= "$key|$Scripts{time}{$key}{$key}{script}|$Scripts{time}{$key}{$key}{lang}|$Scripts{time}{$key}{$key}{machine}|$Scripts{time}{$key}{$key}{status}|$Scripts{time}{$key}{$key}{error}|$Scripts{time}{$key}{$key}{eta}|$Scripts{time}{$key}{$key}{build}|$Scripts{time}{$key}{$key}{state}\n" if $Scripts{time}{$key}{$key}{script}; } ### Write out the DB. print DB $Script_Save; close DB; flush; } sub time { my ($tm, $short) = @_; my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($tm); my $ampm; if ( $hour >= 12 ) { $ampm = "p"; $hour = $hour - 12; } else { $ampm = "a"; } if ( $short =~ /short/i ) { return ( sprintf( "%d:%0.2d%s", $hour, $min, $ampm ) ); } else { return ( sprintf( "[%d/%0.2d] %d:%0.2d%s", $mon, $wday, $hour, $min, $ampm ) ); } } sub bykey { lc($a) cmp lc($b); } sub bykey_rev { lc($b) cmp lc($a); } sub bynum { $a <=> $b; } sub bynum_rev { $b <=> $a; } 1;