#!/usr/bin/perl

=pod

=head1 NAME

Server Script - A server written in procedural perl 

=head1 USAGE

server.prl [ -port <port num> -proto <tcp or udp> ]

=over 5 host defaults to localhost and proto to tcp
 
=head1 DESCRIPTION

This works with client.prl and creates a conversation with it.  It binds to the port, accepts connections and reads from the file handle, CLIENT.  Using simple regular expressions it gives appropriate answers.

=head1 BUGS

It demostrates how a simple server works and is not meant form more than play as it has only been tested using one machine through the local host.  The actual server script, admind, forks a new process with each connection.  The NT OS does not fork and only multithreads, so those lines were removed.  NT systems use mutlithreading and it would be an interesting exercise to improve the script with it.  I will soon build a _real_ server using the tcpserver package from the same guru who created the familuar packages qmail and ezmlm.

=back

=cut

use strict     ;
use Socket     ;
use FileHandle ;

=pod

=head1 How it works

=item strict assures compliance with the "scoping" rules, Socket is the IP module and FileHandle give OO access

=item This section uses Gopts to make $opt_<var> variables out of the command line arguments and then sets them to default if they are undefined

=cut
 
my ( $opt_port, $opt_proto ) ;
my ( $port, $proto )         ;

if ( @ARGV > 0 ) {
use Gopts ; eval Gopts::set_opts  ;
}

my @args = ( $opt_port, $opt_proto )  ;
my @keys = ( 'port', 'proto' ) ;
my @defs = ( '6666', 'tcp' ) ;
my $key ;

my $self ;

foreach $key (@keys) {
  my $arg = shift @args                                    ;
  my $def = shift @defs                                    ;
  if ( defined $arg ) { $self -> { $key } = $arg }
  else                { $self -> { $key } = $def }
}

  $self -> { 'host' } = `hostname` ;
  $self -> { 'proto' } = getprotobyname( $self -> { 'proto' } ) || die "getproto $!";

=pod

=item This section creates the socket and listens to the file descriptor which was created using typical unix, read posix, code

=cut

socket SERVER, PF_INET, SOCK_STREAM, $self -> { 'proto' } 
                                            or die "socket: $!" ;

setsockopt SERVER, SOL_SOCKET, SO_REUSEADDR, 1 
                                            or die "setsockopt: $!";

bind SERVER, sockaddr_in($self -> { 'port' }, INADDR_ANY) or die "bind: $!";

listen SERVER, 5 or die "listen: $!";
print "$0 listening to port ".$self -> { 'port' }."\n";

=pod

=item The for loop starts by accepting a client as it attaches to the open socket.  

=cut

my $addr  ;
for (;;) {
  $addr = accept CLIENT, SERVER;
  my $client_host ;
  $client_host = gethostbyaddr((unpack_sockaddr_in $addr)[1], AF_INET);

=pod

=item It prints a hello message to the client's file descriptor (handle) as soon as it accepts the connection and flushes the buffer to the handle

=cut 

  print STDERR "cxn from $client_host\n" ;
  print CLIENT "hello from ".$self -> {'host'}."\n" ;
  CLIENT->autoflush(1) ;

=pod

=item While data is still streaming from the client it reads the data and filters it for known phrases.  Remember that $_ is understood and the =~ type syntax is understood.  Every time a regular expression is matched then an action is taken and the flow is returned to the handle, CLIENT.  When the stream stops the handle is closed and the flow goes back to accepting a new client connection.  The client can also close by saying _goodbye_

=cut

  while (<CLIENT>) {  
    chomp ;
    /\bhello\b/     && do { 
                         print CLIENT "how are you\n";
                         next 
                          } ;
    /\bI am fine\b/ && do { 
                         print CLIENT "I am fine too\n" ;
                         next
                          } ;
    /\bgoodbye\b/   && do { 
                         print CLIENT "goodbye\n" ;
                         CLIENT->autoflush(1)     ;
                         CLIENT->close 
                            && print STDERR "close cxn $client_host\n";
                        } ;
    CLIENT->autoflush(1)
  }
  CLIENT->close && print STDERR "close cxn $client_host\n" ;
}