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

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