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

   1 #!/usr/bin/perl -w
   2 #############################################################################
   3 ## Name:        samples/socket/wxSocketServer.pl
   4 ## Purpose:     wxSocketServer minimal demo
   5 ## Author:      Graciliano M. P.
   6 ## Created:     06/02/2003
   7 ## RCS-ID:      $Id: wxSocketServer.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, 'Start' );
  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_CONNECTION) ;
  85
  86   my $sock = Wx::SocketServer->new('localhost',5050,wxSOCKET_WAITALL);
  87
  88   EVT_SOCKET_CONNECTION($this , $sock , \&onConnect ) ;
  89
  90   my $stat = $sock->Ok ;
  91   $this->{TEXT}->AppendText("Ok: <$stat>\n") ;
  92   if (! $stat) { return ;}
  93
  94 }
  95
  96 sub onConnect {
  97   my ( $sock , $this , $evt ) = @_ ;
  98
  99   my $client = $sock->Accept(0) ;
 100
 101   my @lcaddr = $client->GetLocal ;
 102   my @praddr = $client->GetPeer ;
 103
 104   $this->{TEXT}->AppendText("-------------------------\n") ;
 105   $this->{TEXT}->AppendText("New Client\n") ;
 106   $this->{TEXT}->AppendText("  Local: <@lcaddr>\n") ;
 107   $this->{TEXT}->AppendText("  Peer: <@praddr>\n") ;
 108
 109   $client->Write("This is a data test!\n") ;
 110   $client->Close ;
 111   $client->Destroy ;
 112   $this->{TEXT}->AppendText("\n-------------------------(closed)\n") ;
 113 }
 114
 115 package main;
 116
 117   my( $app ) = MyApp->new();
 118   $app->MainLoop();
 119
 120 exit ;
 121
 122 # Local variables: #
 123 # mode: cperl #
 124 # End: #