The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# Simple Tk windows proxy client built on POE::Component::Proxy::TCP.

# Andrew Purshottam Oct 2003

# To do:
# - catch interrupt and recovery gracefully from shutdowns
# - recover from remote server and client crashes
# - (speculative) support multiple connections by generating extra 
#   request/response window pairs (maybe side by side, and with
#   kill checkbox for the pair. This might be easy or impossible dependingon what
#   toolkit gives.)
# - label output from different connections somehow.

use warnings;
use strict;
use diagnostics;
use Getopt::Std;
use Tk;
use Tk::ProgressBar;    
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE;
use POE::Filter::Stream;
use POE::Filter::Line;
use POE::Component::Proxy::TCP;
use Data::Dumper;
use POSIX;

$|++;  

# Command line arg processing
my $debug_flag = 1;             
my $remote_server_host = "localhost";
my $remote_server_port = 80;
my $local_server_port = 8080;
my %argv;
getopt("dlrshw", \%argv);
$debug_flag = $argv{'d'} unless !exists($argv{'d'});
$remote_server_port = $argv{'r'} unless !exists($argv{'r'});
$local_server_port = $argv{'l'} unless !exists($argv{'l'});
$remote_server_host = $argv{'s'} unless !exists($argv{'s'});

# Create UI session which when started brings up the main frame window
# and listens for events to put text in request and response view 
#scrolling text boxes.
my $ui_session = POE::Session->create
  ( inline_states =>
    { _start => \&ui_start,
      ev_post_string => \&ui_post_string_to_widget,
      ev_clear => \&ui_clear,
    }
  );

# Server side of proxy, clients connect to this, and this in turn
# connects to a remote server.
my $proxy_component = POE::Component::Proxy::TCP->new
  ( Alias => "ProxyServerSessionAlias",
    Port               => $local_server_port,
    OrigPort           => $remote_server_port,
    OrigAddress        => $remote_server_host,

    DataFromClient    => sub {
      my $s = shift; 
      $poe_kernel->post($ui_session, "ev_post_string", 
			$s, "to_orig_server_text_widget");  
      print "**from client $s\n"; 
      
    },

    # In addition to passing data from original server to client,
    # also show the data in a text window.
    DataFromServer    => sub {
      my $s = shift; 
      $poe_kernel->post($ui_session, "ev_post_string", 
			$s, "from_orig_server_text_widget");  
      print "**from server $s\n"; 
    },
    #ClientFilter       =>POE::Filter::Line->new(OutputLiteral => "\n\r")
  );


# 
# Event loop.
#

# Run the program until it is exited.
$poe_kernel->run();
exit 0;

# 
# Event handlers.
#

# Set up main Tk window
sub ui_start {
  my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];

  $poe_main_window->Label( -text => "HTTP Progress Monitor",
			   -justify => 'left',
			 )->pack(-expand => 1, -fill => 'x');

  $poe_main_window->Button
    ( -text => "Clear",
      -command => $session->postback("ev_clear")
    )->pack;

  $poe_main_window->Label( -text => "Requests to Server." )->pack;
  my $to_orig_server_text_widget = $heap->{to_orig_server_text_widget} 
    = $poe_main_window->Scrolled(qw/Text -height 6 -scrollbars e/ ); 
  $to_orig_server_text_widget->insert('end', "\n\n\n");
  $to_orig_server_text_widget->pack(-side => 'top', -fill => 'both', -expand => 1); 
  
  $poe_main_window->Label( -text => "Replies from Server." )->pack;
  my $from_orig_server_text_widget = $heap->{from_orig_server_text_widget} 
    = $poe_main_window->Scrolled(qw/Text -height 6 -scrollbars e/ ); 
  $from_orig_server_text_widget->insert('end', "\n\n\n");
  $from_orig_server_text_widget->pack(-side => 'top', -fill => 'both', -expand => 1); 
}

# Handle the "ev_post_string" event by appendiong sytring to appropriate 
# widget window.
sub ui_post_string_to_widget {
  my ( $kernel, $heap, $string, $widget_name ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
  if (defined($heap->{$widget_name})) {
    append_line_to_widget($string, $heap->{$widget_name});
 
  }
}

# XXX probably this should get squished in above.
sub append_line_to_widget {
  my $line = shift;
  my $widget = shift;
  $widget->insert('end', $line . "\n"); 
  $widget->yview('end');
}

# Clear text windows and progress meter.
sub ui_clear {
  my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
  my $from_orig_server_text_widget = $heap->{from_orig_server_text_widget};
  $from_orig_server_text_widget->delete('1.0', 'end');
  my $to_orig_server_text_widget = $heap->{to_orig_server_text_widget};
  $to_orig_server_text_widget->delete('1.0', 'end');
}