#!d:\perli\bin\perl -w
#
#	UDP example of a listening socket
# 	save as udp3.pl
#

    #!/usr/bin/perl -w

    use strict;
    use Socket;
    use Sys::Hostname;
    my ( $count, $hisiaddr, $hispaddr, $histime,
         $host, $iaddr, $paddr, $port, $proto,
         $rin, $rout, $rtime, $SECS_of_70_YEARS);

    $SECS_of_70_YEARS      = 2208988800;

    # $iaddr = gethostbyname(hostname());
    $iaddr = gethostbyname('127.0.0.1');

    $proto = getprotobyname('udp');
    $port = getservbyname('time', 'udp');

    $port = shift || 2347;

    $paddr = sockaddr_in($port,inet_aton("127.0.0.1"));

    socket(SOCKET, PF_INET, SOCK_DGRAM, $proto)   || die "socket: $!";
    bind(SOCKET, $paddr)                          || die "bind: $!";
    $| = 1;
    printf "%-12s %8s %s\n",  "localhost", 0, scalar localtime time;
    $count = 0;

    while( 1 ) {  
        $rin = '';

        vec($rin, fileno(SOCKET), 1) = 1;
        #vec($rin, fileno(STDIN),  1) = 1;
       
        # timeout after 10.0 seconds
        my $finished = 0;

        my $rout = $rin;
        my $icMessage;
        my ( $junk, $ts, $protocol, $OrigID, $DestID, $Operation, $p1, $p2, $p3, $p4, $p5 );
        my $mask;
        while ( !$finished ) {
            $ts ++;
            $finished = 0;
            # Block until input or 1 second
            $count = select($rout = $rin, undef, undef, 1 ) ;
            #$count = select( undef, undef, undef, 1 ) ;
            print "\r\n ---------------------------------------------\r\n";
            print "$ts $count ".unpack("b*",$rout)."\r\n";
            my $icMessage = ' ';
	     	
	    # event - is it TIMEOUT
            if(  $count == 0 ){
            #  print " ---------------------------------------------\r\n";
              print " Timeout\r\n\r\n\r\n";
            }

	    # event - is it SOCKET 	
            if ( vec($rout, fileno(SOCKET), 1) == 1 ) { 
              my $message = recv(SOCKET, $icMessage, 255, 0);

	      #TS,Protocol,OrigID,DestID,Operation,P1,,,CRLF
              ( $junk,$ts,$protocol,$OrigID,$DestID,$Operation,$p1,$p2,$p3,$p4,$p5)=split(/,/,$icMessage);

              print "$icMessage\r\n";
 		
              print "TS: $ts,";
              print "PROT: $protocol,  TO:  $OrigID,  FROM: $DestID OPERATION: $Operation\n\r";
            } 
        }
    }