#!/usr/bin/perl -w


=head1 NAME

argo-perl - A Perl + Gtk interface to Argo

=head1 SYNOPSIS

 argo-perl [options]

  Help Options:
   --help     Show this scripts help information.
   --version  Show the version number and exit.

=cut

=head1 OPTIONS

=over 8

=item B<--help>
Show the brief help information.

=item B<--version>
Show the version number and exit.

=back

=cut

=head1 AUTHOR


 Steve
 --
 http://www.steve.org.uk/

 $Id: argo-perl,v 1.22 2006/03/07 19:53:53 steve Exp $

=cut



use strict;


use Getopt::Long;
use Gtk;
use IO::Socket;
use Pod::Usage;
use strict;


my $RELEASE = "0.6";


#
#  Server + port we connect to.
#
my $g_host = "";
my $g_port = "20203";

#
# Login details
#
my $g_user = "";
my $g_pass = "";


#
#  Global variables.
#
my $false   = 0;
my $true    = 1;
my $window;
my $pane;
my $vbox;
my $tree_scrolled_win;
my $list_scrolled_win;
my $entry;
my $tree;
my $item;
my $list;
my $socket = undef;




#
#  Parse any arguments.
#
parseCommandLineArguments();


#
#
#  Initialize Gtk
#
init Gtk();
set_locale Gtk ;



$window = new Gtk::Window( 'toplevel' );
$window->set_usize( 725, 500 );
$window->set_title( "Argo Client" );
$window->signal_connect( "delete_event", sub { Gtk->exit( 0 ); } );

# A vbox to put a menu and a button in:
my $menubox = new Gtk::VBox( $false, 0 );
$window->add( $menubox );
$menubox->show();

# Create a menu-bar to hold the menus and add it to our main window
my $menubar = get_main_menu( $window );
$menubox->pack_start( $menubar, $false, $false, 2 );
$menubar->show();

$pane = new Gtk::HPaned();
$menubox->add( $pane );
$pane->set_handle_size( 10 );
$pane->set_gutter_size( 8 );
$pane->show();

# Create a ScrolledWindow for the tree
$tree_scrolled_win = new Gtk::ScrolledWindow( undef, undef );
$tree_scrolled_win->set_usize( 150, 400 );
$tree_scrolled_win->set_policy( 'automatic', 'automatic' );
$tree_scrolled_win->show();
$pane->add( $tree_scrolled_win );

# Create a ScrolledWindow for the list
$list_scrolled_win = new Gtk::ScrolledWindow( undef, undef );
$pane->add2( $list_scrolled_win );
$list_scrolled_win->set_policy( 'automatic', 'automatic' );
$list_scrolled_win->show();

# Create root tree
my $vbox2 = new Gtk::VBox( $false, 0 );
my $xenlable = new Gtk::Label( "Available Instances");
$xenlable->show();
$vbox2->pack_start( $xenlable, $false, $false, 2 );
$tree = new Gtk::Tree();

$vbox2->add($tree);
$tree_scrolled_win->add_with_viewport($vbox2);
$tree->set_selection_mode( 'single' );
$tree->set_view_mode( 'item' );
$tree->show();
$xenlable->show();
$vbox2->show();


# Create list box
my $vbox3 = new Gtk::VBox( $false, 0 );

my @titles = qw( Name Status );
$list = new_with_titles Gtk::CList( @titles );

$list_scrolled_win->add_with_viewport( $vbox3 );
$list->set_column_width( 0, 200 );
$list->set_column_width( 1, 200 );
$list->set_selection_mode( 'single' );
$list->set_shadow_type( 'none' );
$list->show();


# Buttons
my $hbox2 = new Gtk::HBox( $false, 0 );
my $start = new Gtk::Button( "Start" );
$start->signal_connect( "clicked", \&startMachine );

my $stop = new Gtk::Button( "Stop" );
$stop->signal_connect( "clicked", \&stopMachine );

my $pause = new Gtk::Button( "Pause" );
$pause->signal_connect( "clicked", \&pauseMachine );

my $unpause = new Gtk::Button( "Unpause" );
$unpause->signal_connect( "clicked", \&unpauseMachine );

$hbox2->add( $start );
$hbox2->add( $stop );
$hbox2->add( $pause );
$hbox2->add( $unpause );
$start->show();
$stop->show();
$pause->show();
$unpause->show();
$hbox2->show();
#$vbox3->add($hbox2);
$vbox3->pack_start( $hbox2, $false, $false, 2 );
$vbox3->add($list);
$vbox3->show();



$window->set_position( 'center' );
$window->show();

#
#  If we have a host then do a connection?
#
if ( $g_host )
{
    connect_to_host( $g_host, $g_port, $g_user, $g_pass ) ;
}
main Gtk;
exit( 0 );




# Called whenever an item is clicked on the tree widget.
sub select_item
{
    my ( $widget, $path ) = @_;
    show_host_info( $path );
}


#
#  Handlers for our buttons.
#
sub startMachine
{
    send_host_command( "start" );
}
sub stopMachine
{
    send_host_command( "stop" );
}
sub pauseMachine
{
    send_host_command( "pause" );
}
sub unpauseMachine
{
    send_host_command( "unpause" );
}


#
#  Send a message to the server and ask it to perform an action upon
# the selected host.
#
sub send_host_command
{
    my $action = shift;

    my $item = $tree->selection();
    if ( !defined( $item ) )
    {
	print "No instance selected\n";
	return;
    }
    my $name = $item->get_user_data();
    if ( ! defined( $name ) )
    {
	print "No user data!\n";
	return;
    }

    my $line;
    
    #
    # Connect
    #
    if ( ! defined( $socket ) )
    {
	$socket = IO::Socket::INET->new($g_host . ":" . $g_port );
    }
    if ( !defined( $socket ) )
    {
	print "Connect failed\n";
	return;
    }

    #
    #  Authenticate.
    #
    print $socket "auth $g_user $g_pass\r\n";
    my  $continue =1;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined( $line ) )
	{
	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /400/ )
	    {
		print "Error - $line\n";
	    }
	}
	else
	{
	    $continue = 0;
	}
    }


    #
    #  Get instances.
    #
    print $socket "$action $name\r\n";
    $continue =1;
    my @hosts;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined( $line ) )
	{
	    $line =~ s/\r\n//g;

	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /400/ )
	    {
		print "Error - $line\n";
	    }
	}
	else
	{
	    $continue = 0;
	}
    }

    show_host_info( $name );
}



#
# Fill the tree control with the available Xen instances.
#
sub fill_tree
{
    my $line;
    
    #
    # Connect
    #
    if ( ! defined( $socket ) )
    {
	$socket = IO::Socket::INET->new( $g_host . ":" . $g_port );
    }
    if ( !defined( $socket ) )
    {
	print "Connect failed\n";
	return;
    }

    #
    #  Authenticate.
    #
    print $socket "auth $g_user $g_pass\r\n";
    my  $continue =1;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined ($line ) )
	{
	    $line =~ s/\r\n//g;
	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /400/ )
	    {
		print "Error - $line\n";
	    }
	}
	else
	{
	    $continue = 0;
	}
    }


    #
    #  Get instances.
    #
    print $socket "list available\r\n";
    $continue =1;
    my @hosts;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined ( $line ) )
	{
	    $line =~ s/\r\n//g;

	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /400/ )
	    {
		print "Error - $line\n";
	    }

	    next if (  $line =~ /^[2-4]00/ );
	
	    #
	    # Found a machine.
	    #
	    push @hosts, $line;
	}
	else
	{
	    $continue = 0;
	}
    }


    #
    foreach my $host ( sort @hosts )
    {
	my $item_new = new_with_label Gtk::TreeItem( $host );
	$item_new->set_user_data( $host );
	$item_new->signal_connect( 'select', \&select_item, $host );
	$tree->append( $item_new );
	$item_new->show();
    }

}


#
# Send a message to the server, and ask for the information about the
# given host.
#
sub show_host_info
{
    my $host = shift;
    my $line;

    $list->clear();
    
    #
    # Connect
    #
    if ( ! defined( $socket ) )
    {
	$socket = IO::Socket::INET->new( $g_host . ":" . $g_port );
    }
    if ( !defined( $socket ) )
    {
	print "Connect failed\n";
	return;
    }

    #
    #  Authenticate.
    #
    print $socket "auth $g_user $g_pass\r\n";
    my  $continue =1;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined ($line ) )
	{
	    $line =~ s/\r\n//g;

	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /400/ )
	    {
		print "Error - $line\n";
	    }
	}
	else
	{
	    $continue = 0;
	}
    }


    #
    #  Get instances.
    #
    print $socket "info $host\r\n";
    $continue =1;
    my @info;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined ($line ) )
	{
	    $line =~ s/\r\n//g;
	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /400/ )
	    {
		print "Error - $line\n";
	    }

	    next if (  $line =~ /^[2-4]00/ );
	
	    #
	    # Found some status information.
	    #
	    push @info, $line;
	}
	else
	{
	    $continue = 0;
	}
    }

    #
    #  Insert the data into the list view. 
    #
    foreach my $detail ( sort @info )
    {
	my $key;
	my $val;
	if ( $detail =~ /([^:]+):(.*)/ ) 
	{ 
	    $key = $1;
	    $val = $2; 
	    $list->append( $key, $val );
	}
    }
}

          

=head2 open_host

  This routine will create a dialog box to prompt the user for connection
 details.

=cut

sub open_host
{
    my $dialog = new Gtk::Window();
    $dialog->title ("Connect to server" );

    #
    # create a table to align the things neatly.
    #
    my $table = new Gtk::Table( 5, 2, $true );
    $dialog->add( $table );

    #
    # Create a hbox for the server
    #
    my $server_label = new Gtk::Label( "Server");
    my $server_text  = new Gtk::Entry();
    $server_text->set_text( $g_host );
    $table->attach_defaults( $server_label, 0, 1, 0, 1 );
    $table->attach_defaults( $server_text, 1, 2, 0, 1 );


    #
    # Create a hbox for the port
    #
    my $port_label = new Gtk::Label( "Port");
    my $port_text  = new Gtk::Entry();
    $port_text->set_text( $g_port );
    $table->attach_defaults( $port_label, 0, 1, 1, 2 );
    $table->attach_defaults( $port_text, 1, 2 , 1, 2 );

    #
    # Create a hboxy for the username
    #
    my $user_label = new Gtk::Label( "Username");
    my $user_text  = new Gtk::Entry();
    $user_text->set_text( $g_user );
    $table->attach_defaults( $user_label, 0, 1, 2, 3 );
    $table->attach_defaults( $user_text, 1, 2, 2, 3 );

    #
    # Create a hboxy for the password
    #
    my $pass_label = new Gtk::Label( "Password");
    my $pass_text  = new Gtk::Entry();
    $pass_text->set_visibility( 0 );
    $pass_text->set_text( $g_pass );
    $table->attach_defaults( $pass_label, 0, 1, 3, 4 );
    $table->attach_defaults( $pass_text, 1, 2, 3, 4 );


    #
    # Create a hboxy for the buttons
    #
    my $button_box = new Gtk::HBox( $false, 0 );
    my $ok	   = new Gtk::Button( "OK" );
    my $cancel	   = new Gtk::Button( "Cancel" );

    $ok->signal_connect( "clicked", sub { 
			     my $host = $server_text->get_text();
			     my $port = $port_text->get_text();
			     my $user = $user_text->get_text();
			     my $pass = $pass_text->get_text();
			     clear_host();
			     connect_to_host( $host, $port, $user, $pass ) ;
			 $dialog->hide_all()} );
    $cancel->signal_connect( "clicked", sub {
				 $dialog->hide_all(); } );
    $button_box->pack_start( $cancel, $false, $false, 2 );
    $button_box->add( $ok );
    $table->attach_defaults( $button_box, 1, 2, 4, 5 );

    $dialog->set_position( 'center' );
    $dialog->show_all();
} 




=head2 clear_host

  This routine will clear our display and "disconnect" us from the
 argo-server.

=cut

sub clear_host
{
    #
    # Clear list
    #
    $list->clear();

    #
    # Clear Tree.
    #
    foreach my $child ( $tree->children() )
    {
	$tree->remove_items( $child );
    }
}



=head2 show_about

  This routine will create a dialog box to show our "About" information.

=cut

sub show_about
{
    my $dialog = new Gtk::Window();
    $dialog->title ("About ..." );

    #
    # create a table to align the things neatly.
    #
    my $table = new Gtk::Table( 3, 3, $true );
    $dialog->add( $table );

    #
    # The name + version
    #
    my $about_label = new Gtk::Label( "Argo-Perl v" . $RELEASE );
    $table->attach_defaults( $about_label, 0, 3, 0, 1 );

    my $author_label = new Gtk::Label( "by Steve Kemp");
    $table->attach_defaults( $author_label, 0,3, 1, 2 );

    #
    # Create an OK button.
    #
    my $ok = new Gtk::Button( "OK" );

    $ok->signal_connect( "clicked", sub { 
			     $dialog->hide_all()} );
    $table->attach_defaults( $ok, 2, 3, 2, 3 );

    $table->resize( 6, 4 );
      
    $dialog->set_position( 'center' );
    $dialog->show_all();
} 




=head2 view_dmesg

  This routine will create a dialog box, and fill it with text from
 the server's Dmesg output.

=cut

sub view_dmesg
{
    my $dialog = new Gtk::Window();
    $dialog->title ("About ..." );

    #
    # create a box to align the things neatly.
    #
    my $box = new Gtk::VBox( $false, 0 );
    $dialog->add( $box );

    #
    # The name + version
    #
    my $dmesg = new Gtk::CList(1 );
    my $dmesg_scrolled_win = new Gtk::ScrolledWindow( undef, undef );
    $dmesg_scrolled_win->set_usize( 400, 400 );
    $dmesg_scrolled_win->set_policy( 'automatic', 'automatic' );
    $dmesg_scrolled_win->show();

    my $line;
    $box->pack_start( $dmesg_scrolled_win, $false, $false, 2 );
    $dmesg_scrolled_win->add_with_viewport( $dmesg );

    #
    # Create an OK button.
    #
    my $ok = new Gtk::Button( "OK" );

    $ok->signal_connect( "clicked", sub { 
			     $dialog->hide_all()} );
    $box->add( $ok );
    $dialog->set_position( 'center' );

    #
    # Connect
    #
    if ( ! defined( $socket ) )
    {
	$socket = IO::Socket::INET->new( $g_host . ":" . $g_port );
    }
    if ( !defined( $socket ) )
    {
	print "Connect failed\n";
	return;
    }

    #
    #  Authenticate.
    #
    print $socket "auth $g_user $g_pass\r\n";
    my  $continue = 1;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined ($line ) )
	{
	    $line =~ s/\r\n//g;

	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /^400/ )
	    {
		print "Error - $line\n";
	    }
	}
	else
	{
	    $continue = 0;
	}
    }


    #
    #  Get instances.
    #
    print $socket "dmesg\r\n";
    $continue = 1;
    my @info;
    while( $continue )
    {
	$line = readline( $socket );

	if ( defined ($line ) )
	{
	    $line =~ s/\r\n//g;
	    if ( $line =~ /^[34]00/ )
	    {
		$continue = 0;
	    }
	    if ( $line =~ /^400/ )
	    {
		print "Error - $line\n";
	    }

	    next if (  $line =~ /^[2-4]00/ );
	
	    #
	    # Found some status information.
	    #
	    push @info, $line;
	}
	else
	{
	    $continue = 0;
	}
    }

    #
    #  Insert the data into the list view. 
    #
    foreach my $dmesg_line ( @info )
    {
	$dmesg->append( $dmesg_line );
    }

    $dialog->show_all();
} 



=head2 connect_to_host

  This route will attempt to connect to the argo-server and fill in
 the tree control on the left of the display with all available
 instances.

=cut

sub connect_to_host
{
    my ( $host, $port, $user, $pass ) = (@_);
    
    $g_host = $host;
    $g_port = $port;
    $g_pass = $pass;
    $g_user = $user;

    if ( defined( $socket ) )
    {
	close( $socket );
	$socket = undef;
    }
    fill_tree();

}




=head2 get_main_menu

  Create and populate the main menu

=cut

sub get_main_menu
{
    my ( $window ) = ( @_ );
    
    my $menubar;
    my $item_factory;
    my $accel_group;

    my @menu_items = (
		    { path        => '/_File',
		      type        => '<Branch>' },
		    { path        => '/File/_Connect',
		      accelerator => '<control>C',
		      callback    => 
		      sub { 
			  open_host(); 
		      } },
		    { path        => '/File/_Disconnect',
		      accelerator => '<control>D',
		      callback    => 
		      sub { 
			  if (defined( $socket ) )
			  {
			      close( $socket);
			      $socket = undef;
			  }
			  clear_host(); } 
		      },
		    { path        => '/File/sep1',
		      type        => '<Separator>' },
		    { path        => '/File/Quit',
		      callback    => 
		      sub { 
			  Gtk->exit( 0 ); 
		      },
		      accelerator => '<control>Q', },
		    { path        => '/_View',
		      type        => '<Branch>' },
		    { path        => '/View/_DMESG',
		      accelerator => '<control>D',
		      callback    => 
		      sub { 
			  view_dmesg(); 
		      } },
		    { path        => '/_Help',
		      type        => '<LastBranch>' },
		    { path        => '/_Help/About' ,
		      callback    => 
		      sub { 
			  show_about(); 
		      }, }
		     );
    

    $accel_group = new Gtk::AccelGroup();

    # This function initializes the item factory.
    # Param 1: The type of menu - can be 'Gtk::MenuBar', 'Gtk::Menu',
    #          or 'Gtk::OptionMenu'.
    # Param 2: The path of the menu.
    # Param 3: The accelerator group.  The item factory sets up
    #          the accelerator table while generating menus.
    $item_factory = new Gtk::ItemFactory( 'Gtk::MenuBar',
					  '<main>',
					  $accel_group );

    # This function generates the menu items. Pass the item factory,
    # the number of items in the array, the array itself, and any
    # callback data for the the menu items.
    $item_factory->create_items( @menu_items );

    # Attach the new accelerator group to the window.
    $window->add_accel_group( $accel_group );

    # Finally, return the actual menu bar created by the item factory.
    #*menubar = gtk_item_factory_get_widget (item_factory, "&lt;main>");
    return ( $item_factory->get_widget( '<main>' ) );
}




=head2 parseCommandLineArguments

  Parse the arguments specified upon the command line.

=cut

sub parseCommandLineArguments
{
    my $HELP	= 0;
    my $MANUAL  = 0;
    my $VERSION	= 0;

    #  Parse options.
    #
    GetOptions(
	       "help",    \$HELP,
	       "manual",  \$MANUAL,
	       "version", \$VERSION,
	       "host=s",  \$g_host,
	       "port=s",  \$g_port,
	       "user=s",  \$g_user,
	       "pass=s",  \$g_pass,
	      );
    
    pod2usage(1) if $HELP;
    pod2usage(-verbose => 2 ) if $MANUAL;

    if ( $VERSION )
    {
	my $REVISION      = '$Revision: 1.22 $';

	if ( $REVISION =~ /1.([0-9.]+) / )
	{
	    $REVISION = $1;
	}

	print "argo-perl release v$RELEASE [CVS revision: $REVISION]\n";
	exit;
    }
}



=head1 LICENSE

Copyright (c) 2005 by Steve Kemp.  All rights reserved.

This module is free software;
you can redistribute it and/or modify it under
the terms of the GNU General Public License.

=cut
