windows-server-2003/tools/postbuildscripts/cookie.pm

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( 1, 0, $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( 1, 0, $CookieName );
    unless ( defined( $Event ) ) {return( undef ); }

    # at this point, we've created our cookie.
    # just return the cookie name.
    return( $Event );
}