147 lines
3.8 KiB
Perl
147 lines
3.8 KiB
Perl
package cookie;
|
|
|
|
use strict;
|
|
use lib $ENV{RAZZLETOOLPATH};
|
|
use Win32::Event;
|
|
use Win32::IPC;
|
|
use Logmsg;
|
|
|
|
# declare globals for this package
|
|
my( $LogFile, $ScriptName, $Ext );
|
|
|
|
$LogFile = $ENV{ "LOGFILE" };
|
|
unless ( defined( $LogFile ) ) {
|
|
$0 =~ /(.*)\.(.*?)$/;
|
|
$ScriptName = $1;
|
|
$Ext = "\L$2";
|
|
if ( $Ext ne "log" ) { $LogFile = $ScriptName . ".log"; }
|
|
else { $LogFile = $ScriptName . ".logfile"; }
|
|
}
|
|
|
|
return( 1 );
|
|
|
|
|
|
#
|
|
# CreateCookie( $CookieName )
|
|
#
|
|
# this routine will firstly query to make sure an event with the requested name
|
|
# does not yet exist. if it doesn't, it attempts to create an event. upon
|
|
# failure of either of these tasks, we log an error and return undef. upon
|
|
# success, we return the event created.
|
|
#
|
|
sub CreateCookie
|
|
{
|
|
# get passed args
|
|
my( $CookieName ) = @_;
|
|
|
|
# declare locals
|
|
my( $Event );
|
|
|
|
# check to make sure we don't already have a cookie with this name
|
|
if ( &QueryCookie( $CookieName ) ) {
|
|
errmsg( "A cookie with name '$CookieName' already exists.",
|
|
$LogFile );
|
|
return( undef );
|
|
}
|
|
|
|
$Event = Win32::Event->new( "TRUE", undef, $CookieName );
|
|
unless ( defined( $Event ) ) {
|
|
errmsg( "Failed to create cookie '$CookieName'.", $LogFile );
|
|
return( undef );
|
|
}
|
|
|
|
# at this point, we've created our cookie.
|
|
# just return the cookie name.
|
|
return( $Event );
|
|
}
|
|
|
|
|
|
#
|
|
# QueryCookie( $CookieName )
|
|
#
|
|
# this routine will simply query to see if a cookie with the given name already
|
|
# exists. if so, we return the event. if not, we return undef.
|
|
#
|
|
sub QueryCookie
|
|
{
|
|
# get passed args
|
|
my( $CookieName ) = @_;
|
|
|
|
# declare locals
|
|
my( $Event );
|
|
|
|
$Event = Win32::Event->open( $CookieName );
|
|
# at this point, if event is defined, we created the cookie. if not, we
|
|
# didn't. so event is what we want to return.
|
|
return( $Event );
|
|
}
|
|
|
|
|
|
#
|
|
# KillCookie( $CookieName, $ForceKill )
|
|
#
|
|
# BUGBUG
|
|
# perl does not support a kill for events! thus, we can't really kill an
|
|
# event using the Win32::Event module. so instead, we just return undef.
|
|
#
|
|
# this routine will kill the cookie with the given name. if the $ForceKill
|
|
# parameter is true (non-undef), it will not report errors attempting to kill
|
|
# the cookie. if the kill succeeds, we return the cookie name, otherwise undef.
|
|
#
|
|
sub KillCookie
|
|
{
|
|
# get passed args
|
|
my( $CookieName, $ForceKill ) = @_;
|
|
|
|
# declare locals
|
|
my( $ReturnCode );
|
|
|
|
# BUGBUG
|
|
# perl doesn't support a kill for events, so just return for now.
|
|
return( undef );
|
|
|
|
# close the event
|
|
$ReturnCode = Win32::Event->close( $CookieName );
|
|
if ( $ReturnCode != 0 ) {
|
|
if ( ! ( defined( $ForceKill ) ) ) {
|
|
errmsg( "Failed to kill cookie '$CookieName'.",
|
|
$LogFile );
|
|
}
|
|
return( undef );
|
|
}
|
|
|
|
# we successfully killed the cookie, return the cookie name.
|
|
return( $CookieName );
|
|
}
|
|
|
|
|
|
#
|
|
# CreateCookieQuiet( $CookieName )
|
|
#
|
|
# this routine will firstly query to make sure an event with the requested name
|
|
# does not yet exist. if it doesn't, it attempts to create an event. upon
|
|
# failure of either of these tasks, we log an error and return undef. upon
|
|
# success, we return the event created.
|
|
#
|
|
# this routine differs from CreateCookie in that it will not attempt any
|
|
# logging.
|
|
#
|
|
sub CreateCookieQuiet
|
|
{
|
|
# get passed args
|
|
my( $CookieName ) = @_;
|
|
|
|
# declare locals
|
|
my( $Event );
|
|
|
|
# check to make sure we don't already have a cookie with this name
|
|
if ( &QueryCookie( $CookieName ) ) {return( undef ); }
|
|
|
|
$Event = Win32::Event->new( "TRUE", undef, $CookieName );
|
|
unless ( defined( $Event ) ) {return( undef ); }
|
|
|
|
# at this point, we've created our cookie.
|
|
# just return the cookie name.
|
|
return( $Event );
|
|
}
|