#!perl -w
use strict;
use Tk;
use IO::Pipe;

use constant DEBUGGING => 1; # No log. Generates trace messages as war
+nings.

SetEnv();

# Create the TK window.
my $top = MainWindow->new();

my %Servers;
$Servers{TomCat}=AddServer('TomCat',
            # Start command
                'start /min java -Dtomcat.home="%TOMCAT_HOME%" '.
                'org.apache.tomcat.startup.Tomcat', 
            # Stop command 
                'java -Dtomcat.home="%TOMCAT_HOME%" '.
                'org.apache.tomcat.startup.Tomcat -stop' 
);

$Servers{Apache}=AddServer('Apache',
            # Start command 
                "start /min $ENV{APACHE_HOME}\\Apache.exe ".
                "-d $ENV{APACHE_HOME} -s",
            # Stop command 
                "start /min $ENV{APACHE_HOME}\\Apache.exe ".
                "-d $ENV{APACHE_HOME} -k shutdown",
);

$Servers{JSWDK}=AddServer('JSWDK',
            # Start command 
                'start /min java com.sun.web.shell.Startup ', 
            # Stop command 
                'java com.sun.web.shell.Shutdown',
);

# Add the above servers to the TK window.                             
+             
foreach( sort keys %Servers )
{
    $Servers{$_}{Button}->pack();
}

# Start the TK loop:
MainLoop();

# Shut down the server if it is running when the window is closed.
END{ for( keys %Servers ){ &{$Servers{$_}{Stop}} if $Servers{$_}{Runni
+ng} } }

# Subs
######

sub ButtonHandler
{
    my $server = shift;

    return sub 
    {
        $Servers{$server}{Running} ? &{$Servers{$server}{Stop}} :
                                     &{$Servers{$server}{Start}};
        ChangeLabel( $server );
    }
}

sub StartLabel
{
    my $name = defined $_[0] ? $_[0] : chr(8);
    return "Start $name Server";
}

sub StopLabel
{
    my $name = defined $_[0] ? $_[0] : chr(8);
    return "Stop $name Server";    
}

sub ChangeLabel
{
    my $server = shift;
    $Servers{$server}{Button}->cget( 'text' ) eq StartLabel($server) ?
        $Servers{$server}{Button}->configure( 'text', StopLabel($serve
+r)  ):
        $Servers{$server}{Button}->configure( 'text', StartLabel($serv
+er) );
}

sub Cmd
{ 
    my $startcmd = IO::Pipe->new();
    my $stopcmd = IO::Pipe->new();

    my $server = shift;
    my $start_command = shift;
    my $stop_command = shift;

    my $Start = sub
    {
        close $stopcmd if defined fileno( $stopcmd );
        warn "Running \"$start_command\"\n" if DEBUGGING;
        open $startcmd, "$start_command |" or die $!;
        $Servers{$server}{Running} = 1;
    };
    
    my $Stop = sub
    {
        open $stopcmd, "$stop_command |" or die $!;
        warn "Running \"$stop_command\"\n" if DEBUGGING;        
        close $startcmd; # Clean up.
        $Servers{$server}{Running} = 0;
    };
    
    return ( $Start, $Stop );
}

sub AddServer
{
    my $SName = shift;
    my $StartCmd = shift;
    my $StopCmd = shift;

    my %entry;

    $entry{Running} = 0;
    $entry{Button}  = $top->Button( 'text', StartLabel( $SName ),
                                    'command', ButtonHandler( $SName )
+ );
    ( $entry{Start}, $entry{Stop} ) = Cmd( $SName, $StartCmd , $StopCm
+d );

    return \%entry;
}

# This env monkey buisness is taken from the various startup scripts 
# that came with the servers. It is a point of consternation.
sub SetEnv  
{
    my $TomcatRoot = 'E:\jakarta-tomcat';
    exists $ENV{TOMCAT_HOME}    ?
      $TomcatRoot = $ENV{TOMCAT_HOME}:
      $ENV{TOMCAT_HOME} = $TomcatRoot;

    my $ApacheRoot = 'E:\Progra~1\Apache~1\Apache';
    $ENV{APACHE_HOME} = $ApacheRoot;

    # Set up the CLASSPATH that we need    
    my $cp= exists $ENV{CLASSPATH} ? $ENV{CLASSPATH} : '';    
    $ENV{CLASSPATH}="$TomcatRoot\\classes;$TomcatRoot\\lib\\webserver.
+jar";
    $ENV{CLASSPATH}=$ENV{CLASSPATH}.";$TomcatRoot\\lib\\jasper.jar";
    $ENV{CLASSPATH}=$ENV{CLASSPATH}.";$TomcatRoot\\lib\\xml.jar";
    $ENV{CLASSPATH}=$ENV{CLASSPATH}.";$TomcatRoot\\lib\\servlet.jar;";
    $ENV{CLASSPATH}=$ENV{CLASSPATH}.$ENV{JAVA_HOME}."\\lib\\tools.jar;
+";
    $ENV{CLASSPATH}=$ENV{CLASSPATH} . $cp;

    my $JwsdkRoot = 'E:\jswdk-1.0.1';
    my $JwsdkJars = "$JwsdkRoot\\webserver.jar;".
                    "$JwsdkRoot\\lib\\jakarta.jar;".
                    "$JwsdkRoot\\lib\\servlet.jar;".
                    "$JwsdkRoot\\lib\\jsp.jar;".
                    "$JwsdkRoot\\lib\\jspengine.jar;".
                    "$JwsdkRoot\\lib\\moo.jar;";
                    "$JwsdkRoot\\examples\\WEB-INF\\jsp\\beans;".
                    "$JwsdkRoot\\webpages\\WEB-INF\\servlets;".
                    "$JwsdkRoot\\webpages\\WEB-INF\\jsp\\beans;";
    
    $ENV{CLASSPATH}="$ENV{CLASSPATH};$JwsdkRoot\\classes;$JwsdkJars";
    $cp = $ENV{CLASSPATH};

    warn "CLASSPATH is:\n", join("\n",split(';',$cp)), "\n" if DEBUGGI
+NG;
}