@rem = '--*-Perl-*--;

@echo off

mkdir "%windir%\BatchGotAdmin" ;
if "%errorlevel%" == "0" (
  rmdir "%windir%\BatchGotAdmin" & goto gotAdmin 
) else ( goto UACPrompt )

:UACPrompt
    echo Set UAC = CreateObject^("Shell.Application"^) > "%temp%\getadmin.vbs"
    echo UAC.ShellExecute "%~0", "", "", "runas", 1 >> "%temp%\getadmin.vbs"

    "%temp%\getadmin.vbs"
	exit /B
	
:gotAdmin
    if exist "%temp%\getadmin.vbs" ( del "%temp%\getadmin.vbs" )
    pushd "%CD%"      
    CD /D "%~dp0"
	


wperl -x -S %0 %*
goto endofperl

@rem -- BEGIN PERL -- ';
#!wperl.exe -w
#line 10
#
# Copyright (C) 2015 by Institute for Systems Biology
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 
#
# Institute for Systems Biology
# 401 Terry Ave N
# Seattle, WA  98109  USA
#
# $Id: tpptray.pl 6911 2015-05-01 05:14:27Z slagelwa $
#

#
# Program sits in the Windows system tray and monitors/manages the TPP's
# Apache web server. Can also be used to start/stop the service from the
# the command line.  
#
# Notes:
#
# * The installation and removal of the service is done in the Windows
#   installer however in the future it may make more sense to add these
#   commands to this program along with enable/disabling of service.
#
# * There is a known bug in Win32::GUI that leaves the icon in the system
#   tray when the process exits.  The icon disappears when the cursor is moved
#   over it.  They may be a workaround for addressing this but it didn't seem
#   to work.
#
# * Wouldn't it be nice to have icons indicating state.  Not easy to do.  See:
#    http://www.perlmonks.org/?node_id=876818
#
use strict;
use warnings;

use File::Basename;
use File::Spec::Functions qw( catfile rel2abs updir );
use Getopt::Long;
use Pod::Usage;
use Win32 qw(SW_HIDE);
use Win32::GUI;
use Win32::GuiTest qw(GetWindowText GetClassName);
use Win32::Service;	
use Win32::SysTray;

use FindBin::libs qw( subdir=perl );
use tpplib_perl;



#-- @GLOBALS ------------------------------------------------------------------#

my $REVISION = ('$Revision: 6911 $' =~ m{ \$Revision: \s+ (\S+) }x)[0];
my $VERSION  = tpplib_perl::getTPPVersionInfo() || 'unknown';

my $SERVICENAME = 'TPPApacheWebService';	# w/o spaces intentional
my $WINDOWNAME  = 'TPP Service Monitor';

my $prog = basename($0);        # Program name
my %opts;                       # Program invocation options

my $aboutDialog;		# About dialog window
my $tray;			# System tray window

my %statusCode = (              # Service status codes
   Stopped       => 1,
   StartPending  => 2,
   StopPending   => 3,
   Running       => 4,
   ResumePending => 5,
   PausePending  => 6,
   Paused        => 7
);


#-- @GENERAL ------------------------------------------------------------------#

#
# Processes the command line arguments and initialize the global %opts
# variable.
#
sub parseOptions
   {
   # Get options...
   my @flags;
   push @flags, qw( help|h|? man version|V verbose|v+ );        # Standard flags
   Getopt::Long::Configure( "bundling" );
   GetOptions( \%opts, @flags ) || pod2usage(2);
   $opts{verbose} = 0 unless ( $opts{verbose} );

   # Standard flags
   pod2usage(2)               if ( $opts{help} );
   pod2usage( -verbose => 2 ) if ( $opts{man} );
   printVersion() && exit     if ( $opts{version} );
   }

#
# Output program version
#
sub printVersion
   {
   print STDOUT "$prog $VERSION (revison ${REVISION})\n";
   }

#
# Print verbose output
#
sub loginfo
   {
   print STDOUT "$prog: ", @_, "\n" if ( $opts{verbose} );
   }

#
# Error
#
sub logerr
   {
   print STDERR "$prog: ", @_, "\n";
   }


#-- @CALLBACKS ----------------------------------------------------------------#

#
# Change the state of the web server
#
sub onServerAction {
   updateStatus();
   return 1;		# Do nothing
}

#
# Start the web server
#
sub onStartWebServer {
   if ( startService() ) {
   }
   updateStatus();
   return 1;		# Do nothing
}

#
# Stop the web server
#
sub onStopWebServer {
   if ( stopService() ) {
   }
   updateStatus();
   return 1;		# Do nothing
}

#
# Browse to the TPP web interface
#
sub onOpenTPPWebInterface {
   my $cmd = 'start http://localhost:'. tpplib_perl::getTPPPort() . tpplib_perl::getBaseUrl();
   system($cmd) == 0
      or logerr "$prog: Couldn't launch $cmd $!/$?"; 
}

#
# Browse to the TPP data area
#
sub onOpenTPPData {
   my $cmd = 'start ' . tpplib_perl::getDataPath();
   system($cmd) == 0
      or logerr( "$prog: Couldn't launch $cmd $!/$?" );
}

#
# Browse to the TPP log area
#
sub onOpenTPPLog {
   my $cmd = 'start ' . tpplib_perl::getLogPath();
   system($cmd) == 0
      or logerr( "$prog: Couldn't launch $cmd $!/$?" ); 
}

#
# Browse to the TPP web site
#
sub onOpenTPPWebsite {
   my $cmd = 'start http://tools.proteomecenter.org/wiki';
   system($cmd) == 0
      or logerr( "$prog: Couldn't launch $cmd $!/$?" );
}

#
# Open support mailing list
#
sub onOpenTPPSupport {
   my $cmd = 'start http://groups.google.com/group/spctools-discuss';
   system($cmd) == 0
      or logerr( "$prog: Couldn't launch $cmd $!/$?" ); 
}

#
# Called when user clicks on About
#
sub onAbout {
   if ( !$aboutDialog ) {
#      my $font = Win32::GUI::Font->new( -size => 18 );

      $aboutDialog = new Win32::GUI::DialogBox(
         -name        => "AboutDialog",
         -text        => "About Trans-Proteomic Pipeline",
         -helpbutton  => 0,
         -menu        => 0,
         -maximizebox => 0,
         -minimizebox => 0,
         -resizable   => 0,
         -width => 100, -height => 100,		# to get nonclient dimensions
      );

      my $label = $aboutDialog->AddLabel( -text => " $VERSION ",
#                                          -font => $font
                                        );
      my $ok = $aboutDialog->AddButton( -name => "AboutOkButton",
                                        -text => "  OK  ", 
#                                        -font => $font,
                                        -align => 'center',
                                        -ok => 1,
                                        -default => 1,
                                        -tabstop => 1 );


      my $ncw = $aboutDialog->Width()  - $aboutDialog->ScaleWidth();
      my $nch = $aboutDialog->Height() - $aboutDialog->ScaleHeight();

      my $lw = $label->Width() + 40;
      my $lh = $label->Height() + 20;

      my $bw = $ok->Width() + 20;
      my $bh = $ok->Height() + 10;

      # Resize window
      my $w = $lw;
      my $h = $lh + $bh;
      $aboutDialog->Resize( $w + $ncw, $h + $nch + 10 );

      my $msw = $aboutDialog->ScaleWidth();
      my $msh = $aboutDialog->ScaleHeight();
      my $hh  = $aboutDialog->Height();

      # Center window
      my $desk = Win32::GUI::GetDesktopWindow();
      my $dw   = Win32::GUI::Width($desk);
      my $dh   = Win32::GUI::Height($desk);
      my $x = ($dw - $aboutDialog->Width()) / 2;
      my $y = ($dh - $aboutDialog->Height()) / 2;
      $aboutDialog->Move( $x, $y );

      # Center label
      $label->Left(int(40 / 2));
      $label->Top(int(($h - $lh) / 2));

      # Align button
      $ok->Left(int(($w - $bw) / 2));
      $ok->Top( $h + 10 - $bh );
   }
   $aboutDialog->Show();
   return 1;
}

#
# Called when the user clicks on the ok button in the about dialog
# 
sub AboutOkButton_Click {
   $aboutDialog->Hide();
}

#
# Called when the user clicks on the close window control in the about dialog
# 
sub AboutDialog_Terminate {
   $aboutDialog->Hide();
   return 0;
}

#
# Called when user clicks on exit
#
sub onExit {
   return -1;
}

#
# Update the status of the server
#
sub updateStatus
   {
   my %status;
   my %codes  = map { $statusCode{$_} => $_ } keys %statusCode;

   Win32::Service::GetStatus( '', $SERVICENAME, \%status ); 
   my $txt = %status ? lc($codes{$status{CurrentState}}) : "unknown/not found";
   $tray->{popup}->{MenuItem1}->Change( -text => "TPP web server is $txt" );

   if ( %status && $status{CurrentState} eq $statusCode{Stopped} ) {
      $tray->{popup}->{MenuItem3}->Enabled(1);
      $tray->{popup}->{MenuItem4}->Enabled(0);
   } else {
      $tray->{popup}->{MenuItem3}->Enabled(0);
      $tray->{popup}->{MenuItem4}->Enabled(1);
   }
}

#
# Become a systray application
#
sub systray {
   $tray = new Win32::SysTray (
      'name' => $WINDOWNAME,
      'icon' => catfile(tpplib_perl::getHtmlPath(), 'images', 'tpp.ico'),
      'single' => 1,
      ) or exit 0;

        
   $tray->setMenu(
      "> TPP web server is " => \&onServerAction,
      ">-" => 0,

      "> &Start TPP web server" => \&onStartWebServer,
      "> S&top TPP web server"  => \&onStopWebServer,
      ">-" => 0,

      "> Open TPP &web interface..." => \&onOpenTPPWebInterface,
      "> Open TPP &data folder..."   => \&onOpenTPPData,
      "> Open TPP &log folder..."    => \&onOpenTPPLog,
      "> Go to TPP website..."            => \&onOpenTPPWebsite,
#      ">-"      => 0,
#      "> Go to TPP support news group..." => \&onOpenTPPSupport,
      ">-"      => 0,
      "> A&bout TPP..." => \&onAbout,
      ">-"      => 0,
      "> E&xit TPP tray" => \&onExit,
      ); 

   onAbout();		# prime the about dialog
   updateStatus();

   # Catch signals and make sure icon is removed (doesn't appear to work)
#   $SIG{INT} = $SIG{TERM} = sub {
#      $tray->{DummyWindow}->NI->Remove();
#      $tray->{DummyWindow}->Terminate();
#      exit(0);
#   };

   $tray->runApplication;
   exit(0);
}

#
# Locate and terminate a running TPP monitor
#
sub quitMonitor {

   my @w = Win32::GuiTest::FindWindowLike( 0, $WINDOWNAME, 'PerlWin32GUI_STD' );
   foreach ( @w ) {			# Should be only one...
      loginfo( "quitting ", Win32::GuiTest::GetWindowText($_) );

      # Send a WM_SYSCOMMAND, SC_CLOSE message to the window
      Win32::GuiTest::SendMessage( $_, 274, 61536, 0 );
      Win32::Sleep(250);
   }
   return 0;
}


#-- @SERVICE COMMANDS ---------------------------------------------------------#
#
# Functions for managing an TPP web server service
#

#
# Start the service
#
sub startService {
   my %status;

   Win32::Service::GetStatus( '', $SERVICENAME, \%status ); 
   if ( $status{CurrentState} == $statusCode{Running} ) {
      loginfo( "$SERVICENAME is already running" );
      return 0;
   }

   if ( $status{CurrentState} == $statusCode{Stopped} ) {
      my $max = 3;
      my $cnt = 1;
      while ( $cnt <= $max ) {
         loginfo( "attempting to start $SERVICENAME" );
         Win32::Service::StartService('', $SERVICENAME );
         sleep($cnt);
         Win32::Service::GetStatus('', $SERVICENAME, \%status);
		 loginfo( "service status: ".$status{CurrentState});
         if ( $status{CurrentState} eq $statusCode{Running} ) {
            loginfo( "started $SERVICENAME in $cnt attempts" );
            return 0;
         }
         $cnt++;
      }

    if ($cnt >= $max ) {
      logerr( "unable to start $SERVICENAME in $cnt attempts" );
      return 1;
    }
   }

   logerr( "$SERVICENAME not in a state that can be started" );
   return 1;
}

#
# Stop the service
#
sub stopService {
   my %status;

   Win32::Service::GetStatus( '', $SERVICENAME, \%status ); 
   if ( $status{CurrentState} == $statusCode{Stopped} ) {
      loginfo( "$SERVICENAME is already stopped" );
      return 0;
   }

   # Regardless of other states try to stop
   my $max = 3;
   my $cnt = 1;
   while ( $cnt <= $max ) {
      loginfo( "attempting to stop $SERVICENAME" );
      Win32::Service::StopService('', $SERVICENAME );
      sleep($cnt);
      Win32::Service::GetStatus('', $SERVICENAME, \%status);
	  loginfo( "service status: ".$status{CurrentState});
      if ( $status{"CurrentState"} eq $statusCode{Stopped} ) {
         loginfo( "stopped $SERVICENAME in $cnt attempts" );
         return 0;
      }
      $cnt++;
   }

   logerr( "unable to stop $SERVICENAME in $cnt attempts" );
   return 1;
}


#-- @MAIN ---------------------------------------------------------------------#

$| = 1;                         # Flush STDOUT automatically
{
   parseOptions();

   # Your wish is my...
   my $cmd = $ARGV[0] || '';
   exit( startService() ) if ( $cmd eq 'start' );  
   exit( stopService() )  if ( $cmd eq 'stop' );  
   exit( quitMonitor() )  if ( $cmd eq 'quit' );  
   exit( systray() )      if ( $cmd eq '_tray_' );  
   die "$0: unrecognized command '$ARGV[0]'\n" if ( $ARGV[0] );

   # Default is to become a systray program
   Win32::SetChildShowWindow(SW_HIDE);
   my $perl = $^X;
   $perl =~ s/wperl.exe/perl.exe/i;
   system(1, $perl, $0, "_tray_" );
   exit(0);
}


#-- @DOCUMENTATION ----------------------------------------------------------#

__END__

=head1 NAME

tpptray - system tray application for managing TPP

=head1 DESCRIPTION

This program can be used to control TPP services, including the web server.  
When run without a command it minimizes itself as a system tray
application.

=head1 SYNOPSIS

tpptray[options] [<command>]

 Options:
   -h, --help           Print this help
   --man                Display full documentation and exit
   -V, --version        Print the version information and exit
   -v, --verbose        Enable verbose output 

 Commands:
   start                Start the TPP service(s)
   stop                 Stop the TPP service(s)
   quit                 Quits the TPP tray 

=head1 COOMANDS
 
=over 5

=item B<disable>

Disable TPP service(s) from automatically starting when the system is booted.

=item B<enable>

Enable TPP service(s) to start automatically starting on system boot.

=item B<start>

Starts the TPP service(s) manually.

=item B<stop>

Stop the TPP service(s) manually.

=item B<quit>

Quits the TPP tray.

=back

=head1 OPTIONS

=over 5

=item B<-h, --help>

Print a brief help message and exit.

=item B<--man>

Display the full man page documentation and exit.

=item B<-V, --version>

Output version information for this program and exit.

=item B<-v, --verbose>

Verbose mode.  Cause B<updatepaths> to print debugging messages about its 
progress. Multiple -v options increase the verbosity.  The maximum is 2.

=back

=head1 COPYRIGHT

Copywrite (C) Institute for Systems Biology

__END__
:endofperl
