#!/user/bin/perl 
#
#	Thread_Daemon_Test3.pl
#	---------------------
#	This is a script to test that Win32::Daemon can 
#	work correctly even if it is spawning new threads.
#  
#	This particular thread test tests Win32::Daemon 
#	and fork().
#
#	2008.03.24 rothd

use Getopt::Long;
use Win32::Daemon;
use Win32::Sound;
use vars qw( $VERSION %STATE %EVENT );

$VERSION = 20070105;

###########################
#
#	Declare shared globals
my $gfPaused = 0;
my $gfContinue = 1;
my $WorkerThreadPid = 0;

%STATE = ( 
    eval( SERVICE_NOT_READY )      => 'SERVICE_NOT_READY',
    eval( SERVICE_STOPPED )        => 'SERVICE_STOPPED',
    eval( SERVICE_RUNNING )        => 'SERVICE_RUNNING',
    eval( SERVICE_PAUSED )         => 'SERVICE_PAUSED',
    eval( SERVICE_START_PENDING )  => 'SERVICE_START_PENDING',
    eval( SERVICE_STOP_PENDING )   => 'SERVICE_STOP_PENDING',
    eval( SERVICE_CONTINUE_PENDING )  => 'SERVICE_CONTINUE_PENDING',
    eval( SERVICE_PAUSE_PENDING )  => 'SERVICE_PAUSE_PENDING',
);

%EVENT = (
    eval( SERVICE_START_PENDING )  => 'SERVICE_START_PENDING',
    eval( SERVICE_STOP_PENDING )   => 'SERVICE_STOP_PENDING',
    eval( SERVICE_CONTINUE_PENDING )  => 'SERVICE_CONTINUE_PENDING',
    eval( SERVICE_PAUSE_PENDING )  => 'SERVICE_PAUSE_PENDING',
);

my %Config = (
   service_name      => "PerlThreadTest",
   service_display   => "Perl: Win32::Deamon Thread Test Service",
   service_desc      => "Perl Win32::Daemon test service to validate Perl threading support",
);

# For DEBUG version ONLY!!
if( Win32::Daemon::IsDebugBuild() )
{
    Win32::Daemon::DebugOutputPath( "\\\\.\\pipe\\syslog" );
}

Configure( \%Config );
if( $Config{help} )
{
   Syntax();
   exit();
}
elsif( $Config{install} )
{
   InstallService();
   exit();
}
elsif( $Config{remove} )
{
   RemoveService();
   exit();
}



# Common Code Library to determine log file path
my ( $SCRIPT_PATH ) = Win32::GetLongPathName( scalar Win32::GetFullPathName( $0 ) );
my ( $SCRIPT_DIR ) = ( ( $SCRIPT_PATH ) =~ /^(.*)\\[^\\]*$/ );
my ( $SCRIPT_NAME ) = ( ( $SCRIPT_PATH ) =~ /([^\\]*)\..*$/ );
#my $LogFile = "$SCRIPT_DIR\\$SCRIPT_NAME.log";
my $LogFile = "\\\\.\\pipe\\syslog2";

if( open( LOG, ">$LogFile" ) )
{
    my $TempSelect = select( LOG );
    $| = 1;
    select( $TempSelect );
    print LOG "# Software: $0\n";
    print LOG "# Date: " . localtime() . "\n";
}

ReportLog( EVENTLOG_INFORMATION_TYPE, "Starting the $SERVICE_NAME service at " . localtime() );

Log( "Starting $SERVICE_NAME Daemon...\n" );

# Register for callbacks...
Win32::Daemon::RegisterCallbacks( \&CallbackRoutine );

# Start the service.
# It will stay in StartService() until the callback routine tells the SCM
# to terminate.
# Pass in 0 for the callback timer. This way we won't call into the 
# callback routine unless the SCM tells us to. We can reset the callback
# timer to another value once we start the service...
if( ! Win32::Daemon::StartService( { start => time() }, 2000 ) )
{
    my $String = "Failed to start this script as a Win32 service.\nError: " . GetError();
    Log( $String );
    ReportLog( EVENTLOG_ERROR_TYPE, $String );
    exit();
}
# We get here only if StartService() was successful and there was a termination request
# from the callback routine...
Win32::Daemon::StopService();
TerminateScript();
ReportLog( EVENTLOG_INFORMATION_TYPE, "Shutting down $SERVICE_NAME service" );

sub CallbackRoutine 
{
   my( $Event, $Context ) = @_;
   my $State = Win32::Daemon::State();
   my $ReportState;
   
   # Increase the iteration count so that we can track how often the callback routine
   # is called.
   $Context->{iteration}++;
   
   Log( "Received event: '$EVENT{$Event}' ($Event): iteration '$Context->{iteration}'...current state: '$STATE{$State}' ($State)" );

#   if( SERVICE_NOT_STARTED == Win32::Daemon::State() )
#   {
#      return();
#   }
	# Process the event...   
	if( SERVICE_START_PENDING == $State )
	{
		# Service is Starting...
		
		# Fork() a new worker thread...
		if( $WorkerThreadPid = fork() ) 
		{
			Log( "Forked the worker thread (PID: $Pid )" );
		}
		else
		{
			# We get here if we are the child process
			WorkerThread();
			
			# If the worker thread really terminated then the child thread needs to end
			exit;
		}

		Log( "Starting!" );
		$ReportState = SERVICE_RUNNING;		
   }
   elsif( SERVICE_PAUSE_PENDING == $State )
   {
		# Starting...
		Log( "    Pausing!" );
		$gfPaused = 1;
		$ReportState = SERVICE_PAUSED;

		# Configure how often to call the callback routine wiht the "running" 
		# event (in milliseconds)...
		Win32::Daemon::CallbackTimer( 8000 );
   }
   elsif( SERVICE_CONTINUE_PENDING == $State )
   {
		# Starting...
		Log( "    UN-Pausing!" );
		$gfPaused = 0;
		$ReportState = SERVICE_RUNNING;
   }
   elsif( SERVICE_STOP_PENDING == $State )
   {
      Log( "Calling StopService()..." );
      $gfContinue = 0;
      kill( $WorkerThreadPid );
      $ReportState = SERVICE_STOPPED;
      my $iResult = Win32::Deamon::StopService();
      Log( "StopService() returned '$iResult'" );
   }
   elsif( SERVICE_RUNNING == $Event )
   {
      Log( "    running event" );
      $Context->{running}++;

   }
   else
   {
      # This is the catch-all block...
      # Take care of unhandled states by setting the State()
      # to whatever the last state was we set...
      Log( "    unknown event" );
      $ReportState = $Context->{previous_state};
   }

   $Context->{previous_event} = $Event;
   $Context->{previous_state} = $State;

   return( $ReportState );
}

##########################################################
#
#
#
#
sub WorkerThread
{
	my $SoundFile = "c:\\windows\\Media\\chimes.wav";
	while( $gfContinue )
	{
		my $String = "!!!!!!!!! HEY WORKER THREAD ";
		$String .= "( IN PAUSED MODE )" if( $gfPaused );
		$String .= " !!!!!!!!!!";
		Log( $String );

		if( ! $gfPaused )
		{
			Win32::Sound::Play( $SoundFile );
	
		}	
		sleep( 1 );
	}
}



##########################################################
#
#
#
#
sub GetServiceConfig
{
    my $ScriptPath = join( "", Win32::GetFullPathName( $0 ) );
    my %Hash = (
        name    =>      $Config{service_name},
        display =>      $Config{service_display},
        path    =>      $^X,
        user    =>      $Config{account},
        password   =>   $Config{password},
        parameters =>   "\"$ScriptPath\"",
        description =>  $Config{service_desc},
    );
    $Hash{parameters} .= " -debug" if( $Config{debug} );
    $Hash{parameters} .= " -console" if( $Config{console} );
#    $Hash{parameters} .= " -nopage" if( $Config{nopage} );
    return( \%Hash );
}

sub InstallService
{
  my $ServiceConfig = GetServiceConfig();
  
  if( Win32::Daemon::CreateService( $ServiceConfig ) )
  {
    print "The $ServiceConfig->{display} was successfully installed.\n";
  }
  else
  {
    print "Failed to add the $ServiceConfig->{display} service.\nError: " . GetError() . "\n";
  }
}

sub RemoveService
{
  my $ServiceConfig = GetServiceConfig();
  
  if( Win32::Daemon::DeleteService( $ServiceConfig->{name} ) )
  {
    print "The $ServiceConfig->{display} was successfully removed.\n";
  }
  else
  {
    print "Failed to remove the $ServiceConfig->{display} service.\nError: " . GetError() . "\n";
  }
}


sub ReportLog
{
  my( $EventType, $Message ) = @_;
  
  Log( "Report: $Message" );
}

sub Log
{
  my( $Message ) = @_;

  print LOG "$Message\n" if( fileno( LOG ) );
}

sub TerminateScript 
{
  Log( "Shutting down $SERVICE_NAME service" );
  close( LOG ) if( fileno( LOG ) );
  $Server->Close();
  undef $Server;
}

sub Configure
{
    my( $Config ) = @_;
    my $fResult = 0;
    Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
    $fResult = GetOptions( $Config, 
                          qw( 
                            console|c
                            debug|d
                            nopage|n
                            install|i
                            remove|delete|r|d
                            help|?
                          ) );

    $Config->{help} = 1 unless( $fResult );
    return( $fResult );
}

sub Syntax
{
    my( $Script ) = ( $0 =~ m#([^\\/]+)$# );
    my $Line = "-" x length( $Script );
    print STDERR << "EOT";

    $Script
    $Line
    Tests the Win32::Deamon extension with threads.
    Version: $VERSION
    Syntax: $0 [-cdn] [-p Number]
      c.............Run from the console, not as a service.
                    Use this to run the script from a command line.
      d.............Run in debug mode.
      install.......Installs the service.
      remove........Uninstalls the service.

EOT
}



END
{
  print STDERR "\nQuitting...\n";
  undef $Server;
}

__END__

History
  20060901 rothd
   -Created.