lwes-perl-event-listener

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5 use Getopt::Long;
   6 use LWES::EventParser;
   7 use IO::Socket;
   8 use IO::Socket::Multicast;
   9 use Time::HiRes qw( gettimeofday );
  10
  11 # don't buffer stdout
  12 $| = 1;
  13
  14 my $port    = $ENV{'LWES_PORT'}    || 9191;
  15 my $addr    = $ENV{'LWES_ADDRESS'} || '224.0.0.69';
  16 my $debug   = 0;
  17 my $siteid  = 1;
  18
  19 sub printUsage {
  20     ( my $id = $0 ) =~ s/^.*\///;   # basename;
  21     STDERR->print(<<"EndOfUsage");
  22 Usage: $id [options] <listener name> <args>
  23                 {-m|--addr} <multicast_address>
  24                 {-p|--port} <multicast_port>
  25                 {-s|--site_id} <siteid>
  26                 {-d|--debug}              print extra debugging information
  27                 {--help}
  28
  29         <args> are passed directly to the listener constructor
  30 EndOfUsage
  31     exit(0);
  32 }
  33
  34 # Read the command line options
  35 {
  36   local $SIG{__WARN__}=
  37     sub {
  38       STDERR->print(join("\n",@_),"\n") if (@_);
  39       printUsage();
  40     };
  41
  42   GetOptions(
  43              'm|addr=s'       => \$addr,
  44              'p|port=s'       => \$port,
  45              's|site_id=s'    => \$siteid,
  46              'd|debug'        => \$debug,
  47              'help'           => \&printUsage,
  48             );
  49 }
  50
  51 my $listener = shift @ARGV;
  52
  53 unless ( defined($listener) ) {
  54   $listener = "EventPrintingListener";
  55 }
  56 my $package_name = undef;
  57 if ( $listener!~ /::/ ) {
  58   $package_name = "LWES::Listeners::".$listener;
  59 } else {
  60   $package_name = $listener;
  61 }
  62
  63 # Load the module and create an instance
  64 eval "use $package_name;";
  65 if ($@) {
  66   die "use $package_name failed ($@)";
  67 }
  68
  69 my $listener_object = $package_name->new(@ARGV);
  70
  71 # set up socket
  72 my $sock = IO::Socket::Multicast->new(LocalPort=>$port, Reuse=>1)
  73   or die "Can't create socket: $!";
  74
  75 $sock->sockopt(SO_RCVBUF,(16*1024*1024));
  76
  77 # add multicast address
  78 $sock->mcast_add($addr) or die "mcast_add: $!";
  79 while (1) {
  80   my ($message,$peer);
  81   die "recv error: $!" unless $peer = recv($sock,$message,65535,0);
  82   my ($port,$peeraddr) = sockaddr_in($peer);
  83
  84   my $event = bytesToEvent($message);
  85
  86   # set up a header similiar to the lwes header
  87   my ($seconds, $microseconds) = gettimeofday;
  88   $event->{'SenderPort'} = $port;
  89   $event->{'SenderIP'}   = inet_ntoa($peeraddr);
  90   $event->{'ReceiptTime'}= $seconds*1000+int($microseconds/1000);
  91
  92   # let the listener process the event
  93   $listener_object->processEvent($event);
  94 }
  95