#!perl
##########################################################################
# PROGRAM    StartPerlSock.pl
# AUTHOR     DaveS@ActiveState.com
#
# ORIG       September 7, 2000
# COPYRIGHT  Copyright, (c) 2000 ActiveState Tool Corp
#            All Rights Reserved
##########################################################################
# REVISION HISTORY
#
# 07/09/2000 Original - based on runVPM.pl by MikeSm
##########################################################################
use strict;
use Config;
use Win32;
use Win32::Registry;
use Win32::Process;
eval "use Win32::Service;";

use vars qw( $HKEY_LOCAL_MACHINE $HKEY_CLASSES_ROOT );

my $servicename = 'PerlSock';

if( Win32::IsWinNT() || Win32::IsWin95() ) {

    if( Win32::IsWinNT() ) { # If its WinNT
	my %services;
	Win32::Service::GetServices( '', \%services ) ||
	    ErrorQuit( Win32::FormatMessage( Win32::GetLastError() ) );

# ... and PerlSock is installed
	if(grep( /$servicename/, values %services )) {
	    StartPerlSockService();
	}
	else {
	    my $perlsock = $Config{'binexp'} . '/perlsock.exe';
	    if( -e $perlsock ) {
		StartPerlSockCommand($perlsock);
	    }
	    else {
		ErrorQuit('PerlSock.exe is missing.');
	    }
	}
    }
    elsif( Win32::IsWin95() ) {
	my $perlsock = $Config{'binexp'} . '/perlsock.exe';
	if( -e $perlsock ) {
	    StartPerlSockCommand($perlsock);
	}
	else {
	    ErrorQuit('PerlSock.exe is missing.');
	}
    }
    Message("This computer is now listening for debugging connections.");
}
else {
    ErrorQuit( "Cannot run PerlSock on this platform!" );
}

sub StartPerlSockCommand {
    my $perlsock = shift;
    my $proc;
    Win32::Process::Create($proc,
			   $perlsock,
			   '',
			   0,
			   NORMAL_PRIORITY_CLASS|CREATE_NEW_CONSOLE,
			   '.') ||
	ErrorQuit( $perlsock . ' : ' . Win32::FormatMessage( Win32::GetLastError() ) );
    sleep(2);
}

sub StartPerlSockService {
    my %status;
    my $ok = 0;
    $ok = Win32::Service::GetStatus( '', $servicename, \%status );
    unless( !$ok || $status{'CurrentState'} == 4 ) {
	$ok = Win32::Service::StartService( '', $servicename );
    }

    while( $ok && $status{'CurrentState'} != 4 ) {
	$ok = Win32::Service::GetStatus( '', $servicename, \%status );
    }

    unless ($ok) {
	ErrorQuit("Failed to start PerlSock as a service.");
    }
}

sub ErrorQuit {
    print @_, "\n";
    print "Press the [ ENTER ] key to exit:\n";
    <STDIN>;
    exit(1);
}

sub Message {
    print @_, "\n";
    print "Press the [ ENTER ] key to exit:\n";
    <STDIN>;
}
