vcs.maemo.org Git - pkg-perl/blob - deb-src/libwx-perl/libwx-perl-0.96/samples/socket/wxSocketClient.pl

   1 #!/usr/bin/perl -w
   2 #############################################################################
   3 ## Name:        samples/socket/wxSocketClient.pl
   4 ## Purpose:     wxSocketClient minimal demo
   5 ## Author:      Graciliano M. P.
   6 ## Created:     06/02/2003
   7 ## RCS-ID:      $Id: wxSocketClient.pl 2057 2007-06-18 23:03:00Z mbarbon $
   8 ## Copyright:   (c) 2003-2004 Graciliano M. P.
   9 ## Licence:     This program is free software; you can redistribute it and/or
  10 ##              modify it under the same terms as Perl itself
  11 #############################################################################
  12
  13 BEGIN {
  14   eval {
  15     require blib;
  16     'blib'->import;
  17   }
  18 }
  19
  20 use Wx;
  21 use Wx::Socket ;
  22
  23 package MyApp;
  24
  25   use vars qw(@ISA);
  26   @ISA=qw(Wx::App);
  27
  28 sub OnInit {
  29   my( $this ) = @_;
  30
  31   my( $frame ) = MyFrame->new( "wxSocket Minimal demo",
  32                                Wx::Point->new( 50, 50 ),
  33                                Wx::Size->new( 450, 350 )
  34                              );
  35
  36   $this->SetTopWindow( $frame );
  37   $frame->Show( 1 );
  38
  39   1;
  40 }
  41
  42 package MyFrame;
  43   use vars qw(@ISA);
  44   @ISA=qw(Wx::Frame);
  45
  46   use Wx qw(:sizer wxTE_MULTILINE );
  47   use Wx::Event qw(EVT_BUTTON) ;
  48
  49   use Wx qw(wxDefaultPosition wxDefaultSize wxDEFAULT wxNORMAL);
  50
  51 sub new {
  52   my( $class ) = shift;
  53   my( $this ) = $class->SUPER::new( undef, -1, $_[0], $_[1], $_[2] );
  54
  55   my $top_s = Wx::BoxSizer->new( wxVERTICAL );
  56
  57   my $text = Wx::TextCtrl->new( $this , -1, '' , wxDefaultPosition, [200,-1] , wxTE_MULTILINE );
  58   my $button = Wx::Button->new( $this, -1, 'Connect' );
  59
  60   $this->{TEXT} = $text ;
  61
  62   $top_s->Add( $text , 1, wxGROW|wxALL, 5 );
  63   $top_s->Add( $button , 0, wxGROW|wxALL, 0);
  64
  65   $this->SetSizer( $top_s );
  66   $this->SetAutoLayout( 1 );
  67
  68   EVT_BUTTON( $this, $button, \&OnConnect );
  69
  70   return( $this ) ;
  71
  72   $this;
  73 }
  74
  75
  76 #############
  77 # ONCONNECT #
  78 #############
  79
  80 sub OnConnect {
  81   my $this = shift ;
  82
  83   use Wx qw(:socket) ;
  84   use Wx::Event qw(EVT_SOCKET_INPUT EVT_SOCKET_LOST) ;
  85
  86   my $sock = Wx::SocketClient->new(wxSOCKET_WAITALL);
  87
  88   EVT_SOCKET_INPUT($this , $sock , \&onInput ) ;
  89   EVT_SOCKET_LOST($this , $sock , \&onClose ) ;
  90
  91   my $stat = $sock->Connect('localhost',5050) ;
  92
  93   my $stat = $sock->IsConnected ;
  94   $this->{TEXT}->AppendText("IsConnected: <$stat>\n") ;
  95   if (! $stat) { return ;}
  96
  97   my @lcaddr = $sock->GetLocal ;
  98   my @praddr = $sock->GetPeer ;
  99   $this->{TEXT}->AppendText("Local: <@lcaddr>\n") ;
 100   $this->{TEXT}->AppendText("Peer: <@praddr>\n") ;
 101
 102   $this->{TEXT}->AppendText("-------------------------\n") ;
 103 }
 104
 105 sub onInput {
 106   my ( $sock , $this , $evt ) = @_ ;
 107   my $buf = '#BEGIN#' ;
 108   while( $sock->Read($buf , 1 , length($buf) ) ) {
 109     if ($buf =~ /\n$/s) { last ;}
 110   }
 111   $this->{TEXT}->AppendText($buf."#END#") ;
 112 }
 113
 114 sub onClose {
 115   my ( $sock , $this , $evt ) = @_ ;
 116   $this->{TEXT}->AppendText("\n-------------------------(closed)\n") ;
 117   $sock->Destroy ;
 118 }
 119
 120 package main;
 121
 122   my( $app ) = MyApp->new();
 123   $app->MainLoop();
 124
 125 exit ;
 126
 127 # Local variables: #
 128 # mode: cperl #
 129 # End: #