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

   1 #!/usr/bin/perl -w
   2 #############################################################################
   3 ## Name:        samples/socket/wxSocketServerDatagram.pl
   4 ## Purpose:     wxDatagramSocket demo
   5 ## Author:      Graciliano M. P., Mattia Barbon
   6 ## Created:     07/02/2004
   7 ## RCS-ID:      $Id: wxSocketServerDatagram.pl 2057 2007-06-18 23:03:00Z mbarbon $
   8 ## Copyright:   (c) 2004 Graciliano M. P., Mattia Barbon
   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 use Wx;
  14 use Wx::Socket ;
  15
  16 package MyApp;
  17
  18   use vars qw(@ISA);
  19   @ISA=qw(Wx::App);
  20
  21 sub OnInit {
  22   my( $this ) = @_;
  23
  24   my( $frame ) = MyFrame->new( "wxSocket Minimal demo",
  25                                Wx::Point->new( 50, 50 ),
  26                                Wx::Size->new( 450, 350 )
  27                              );
  28
  29   $this->SetTopWindow( $frame );
  30   $frame->Show( 1 );
  31
  32   1;
  33 }
  34
  35 package MyFrame;
  36   use vars qw(@ISA);
  37   @ISA=qw(Wx::Frame);
  38
  39   use Wx qw(:sizer wxTE_MULTILINE );
  40   use Wx::Event qw(EVT_BUTTON) ;
  41
  42   use Wx qw(wxDefaultPosition wxDefaultSize wxDEFAULT wxNORMAL);
  43
  44 sub new {
  45   my( $class ) = shift;
  46   my( $this ) = $class->SUPER::new( undef, -1, $_[0], $_[1], $_[2] );
  47
  48   my $top_s = Wx::BoxSizer->new( wxVERTICAL );
  49
  50   my $text = Wx::TextCtrl->new( $this , -1, '' , wxDefaultPosition, [200,-1] , wxTE_MULTILINE|wxTE_RICH2 );
  51   my $button = Wx::Button->new( $this, -1, 'Start' );
  52
  53   $this->{TEXT} = $text ;
  54
  55   $top_s->Add( $text , 1, wxGROW|wxALL, 5 );
  56   $top_s->Add( $button , 0, wxGROW|wxALL, 0);
  57
  58   $this->SetSizer( $top_s );
  59   $this->SetAutoLayout( 1 );
  60
  61   EVT_BUTTON( $this, $button, \&OnConnect );
  62
  63   return( $this ) ;
  64
  65   $this;
  66 }
  67
  68
  69 #############
  70 # ONCONNECT #
  71 #############
  72
  73 sub OnConnect {
  74   my $this = shift ;
  75
  76   use Wx qw(:socket) ;
  77   use Wx::Event qw(EVT_SOCKET_INPUT) ;
  78
  79   my $addr = Wx::IPV4address->new;
  80   $addr->SetAnyAddress;
  81   $addr->SetService( 4444 );
  82   my $sock = Wx::DatagramSocket->new( $addr );
  83
  84   EVT_SOCKET_INPUT($this , $sock , \&onConnect ) ;
  85
  86   my $stat = $sock->Ok ;
  87   $this->{TEXT}->AppendText("Ok: <$stat>\n") ;
  88   if (! $stat) { return ;}
  89
  90 }
  91
  92 sub onConnect {
  93   my ( $sock , $this , $evt ) = @_ ;
  94
  95   my $addr = Wx::IPV4address->new;
  96   my $buf = '';
  97   $sock->RecvFrom($addr, $buf, 1000) ;
  98   my $addr_str = $addr->GetHostname . ' ' . $addr->GetService;
  99
 100   $this->{TEXT}->AppendText("-------------------------\n") ;
 101   $this->{TEXT}->AppendText("New Client\n") ;
 102   $this->{TEXT}->AppendText("  Peer: <$addr_str>\n") ;
 103
 104   $sock->SendTo($addr, "This is a data test!\n", 21) ;
 105   $this->{TEXT}->AppendText("\n-------------------------(closed)\n") ;
 106 }
 107
 108 package main;
 109
 110   my( $app ) = MyApp->new();
 111   $app->MainLoop();
 112
 113 exit ;
 114
 115 # Local variables: #
 116 # mode: cperl #
 117 # End: #