###############################################################################
#
# runVPM.pl
#
# Author: Michael Smith <mike.smith@activestate.com
#
# Copyright © 1999 ActiveState Tool Corp. All rights reserved.
#
###############################################################################
use strict;
use Config;
use Win32;
use Win32::Registry;
use Win32::Process;
use IO::Socket;
eval "use Win32::Service;";

use vars qw( $HKEY_LOCAL_MACHINE $HKEY_CLASSES_ROOT );

my $VPM_PerlSockKey = 'Software\ActiveState\PerlSock\1.0\VPM';
my $VPM_MiniSrvKey = 'Software\ActiveState\MiniSrv';
my $default_Port = 4444;
my $default_IP = '127.0.0.1';
my $servicename = 'PerlSock';

my $servicestarted = 0;

    LaunchVPMNoPerlSock();
    LaunchBrowser();

sub LaunchVPMPerlSockCommand {
    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 LaunchVPMPerlSockService {
    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 );
    }

    if($ok) {
	$servicestarted = 1;
    } else {
	LaunchVPMNoPerlSock();
    };
}

sub LaunchVPMNoPerlSock {
    my $prefix = $Config{'prefix'};
    my $minisrv = $prefix . '/VPM/minisrv.pl';
    my $proc;
    
    my $running = IO::Socket::INET->new( Timeout  => '4', # was 10
				       PeerAddr => '127.0.0.1:4444',
				       Proto    => 'tcp',
				       );
    if (! $running) {
	Win32::Process::Create( $proc,
			    $^X,
			    "$^X $minisrv",
			    0,
			    NORMAL_PRIORITY_CLASS,
			    $prefix . '/vpm') || 
				ErrorQuit( $^X . ' : ' . Win32::FormatMessage( Win32::GetLastError() ) );
    }
    close $running if $running;
}

sub LaunchBrowser {
    my $VPM_PerlSock_RegObj;
    my $IP = $default_IP;
    my $Port = $default_Port;
    my $type;
    my $proc;
    my $keyName = ($servicestarted == 1 ? $VPM_PerlSockKey : $VPM_MiniSrvKey);

    if ($HKEY_LOCAL_MACHINE->Open( $VPM_PerlSockKey, $VPM_PerlSock_RegObj)) {
	$VPM_PerlSock_RegObj->QueryValueEx( 'IP', $type, $IP ) ||
	    ($IP = $default_IP);
	$VPM_PerlSock_RegObj->QueryValueEx( 'Port', $type, $Port ) ||
	    ($Port = $default_Port);
	$VPM_PerlSock_RegObj->Close();
    }

    my $htmlclass_regobj;
    my $htmlclass_name;
    $HKEY_CLASSES_ROOT->Open( '.html', $htmlclass_regobj ) ||
    	ErrorQuit( Win32::FormatMessage( Win32::GetLastError() ) );
    $htmlclass_regobj->QueryValue( '', $htmlclass_name ) ||
    	ErrorQuit( Win32::FormatMessage( Win32::GetLastError() ) );
    $htmlclass_regobj->Close();

    # Remove trailing \0s that some installers seem to put here.
    $htmlclass_name =~ s/\0.*//;

    my $value;
    $HKEY_CLASSES_ROOT->Open( "$htmlclass_name\\Shell\\Open\\Command", $htmlclass_regobj ) ||
    	ErrorQuit( Win32::FormatMessage( Win32::GetLastError() ) );
    $htmlclass_regobj->QueryValue( '', $value ) ||
    	ErrorQuit( Win32::FormatMessage( Win32::GetLastError() ) );
    $htmlclass_regobj->Close();

    my ($command, $args);
    if( $value =~ /^"(.*?)"\s*(.*)/ or $value =~ /([^\s]+)\s*(.*)/ )
    {
        ($command, $args) = ($1, $2);
    }

    $command =~ s/"//g;

    my $running = undef;
    my $i;
    while (! $running ) {
	if ($i++ > 8) {
	    Win32::MsgBox ("Could not make connection to VPM server, quitting!");
	    exit(1);
	}  
	$running = IO::Socket::INET->new( Timeout  => '4', # was 10
				       PeerAddr => '127.0.0.1:4444',
				       Proto    => 'tcp',
				       );
	sleep (1);
    }
    
    close $running if $running;
    
    Win32::Process::Create( $proc,
			    $command,
			    "$args http://$IP:$Port/index.html",
			    0,
			    NORMAL_PRIORITY_CLASS,
			    '.') || 
		ErrorQuit( $command . ' : ' .Win32::FormatMessage( Win32::GetLastError() ) );
}

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

