#! /usr/bin/perl -w

############################################################
#
# This code is dual licensed.
#
# See either Artistic.html or COPYING for the exact conditions.
# Choose among Artistic.html and COPYING the license you prefer.
#
# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# (C) 2001 Centre Universitaire d'Informatique, University of Geneva
#
# Author: Wolfgang M&uuml;ller  <Wolfgang.MUELLER@cui.unige.ch>


require Exporter;

package MRML::Server::Base;
use strict;
use vars qw(@ISA @EXPORT_OK $VERSION);

$VERSION="0.03";
@ISA=qw(Exporter);
@EXPORT_OK=qw(new
	      serve);

use Socket;
#use lib "..";
use IO::Socket;
use XML::Handler::EasyTree::Builder;
use XML::Handler::EasyTree::Writer;
use XML::Handler::EasyTree::Visitor;
use XML::Handler::EasyTree::Traversal;
use MRML::Server::Base::Visitor;

=pod

=head1 NAME

MRML::Server::Base - a simple MRML server in Perl

=head1 SYNOPSIS

use MRML::Server::Base;

$server = new MRML::Server::Base(address => localhost,
                                  port    => 12345);

$server->serve();

=head1 DESCRIPTION

This is a very simple MRML server designed for flexibility 
and extensibility. It opens a server socket on the port
given as parameter, and then it listens  on the port for 
messages.

Each message received is parsed into an XML tree. This tree
is then visited using an CXMLTreeVisitor. 

=head1 Functions:

=head2 new(port)

This function is called on construction.
It will take the parameters and call initialize. The parameter
is the port number on which the server will open a port. The actual
opening will be done by the function serve()

=cut


sub new{
  my $class = shift;
  my $self = {};
  bless $self, $class;
  $self->initialize(@_);
  return $self;
}

=pod

=head2 initialize(port)

Takes just the port number as argument.

Fills the array $self->{images} with a list of URLs of example images

=cut

sub initialize( @ ){
  my $self=shift;

  my($i,$j);
  while($i=shift @_){
      $j=shift @_;
      $self->{$i}=$j;
  }

  $self->{images}=$self->{images} || [
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0001.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0002.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0003.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0004.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0005.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0006.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0007.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0008.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0009.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0010.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0011.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0012.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0013.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0014.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0015.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0016.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0017.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0018.jpeg",
		   "http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0019.jpeg"
		  ];

  if($self->{address}){
    $self->{socket} = IO::Socket::INET->new(Listen    => 5,
					    #LocalAddr => INADDR_ANY,
					    LocalAddr => "$self->{address}",
					    LocalPort => $self->{port},
					    Proto     => 'tcp',
					    Reuse     => 1)
    or die "Could not open server socket on $self->{address}:$self->{port}: $!\n";
  }else{
    $self->{socket} = IO::Socket::INET->new(Listen    => 5,
					    LocalPort => $self->{port},
					    Proto     => 'tcp',
					    Reuse     => 1)
      or die "Could not open server socket on $self->{address}:$self->{port}: $!\n";
  }
  

  #
  # this array contains various DEBUG flags
  #
  # currently this only enables logging.
  # the printouts currently are mandatory.
  $self->{DEBUG}={
		  logfile=>"1"
		 };

  print STDERR "Logging into file ./e-m-s.log is enabled. 
See file MRML/ExampleServer.pm if you want to change that.
" if($self->{DEBUG}->{logfile});

}

=pod

=head2 serve()

This function does the actual serving.
It accepts connections on the object s socket,
and then uses an XML tree builder to build a 
parse tree of the string.

The parse tree is then visited using the XML::EasyTree::Traversal class.
The visitor is of the class MRML::Server::Base::Visitor

From the visitor we will request a document tree of the 
XML document tree of the message the server will send 
as response.

This response is sent using a CXMLTreeWriter

As you see, the main work is done by the MRML::Server::Base::Visitor


=cut


sub serve{
  my$self=shift;
  my(%lParameters)=( @_ );
  my $lAcceptedConnection;
  while($lAcceptedConnection=$self->{socket}->accept()){
    
    $lAcceptedConnection->autoflush(1);
    
    my $lRead;
    my $lChunk;
    #
    # read character-wise
    #
    while($lAcceptedConnection->read($lChunk,1)){
      $lRead.=$lChunk;
      # jump out of this when </mrml> has been found
      last if $lRead=~m'/mrml\s*>.*'s;
    }

    #
    # print out what's been read
    # if there is a need for a logfile
    #
    if($self->{DEBUG}->{logfile}){# write a log to e-m-s.log
      my $lLog=new IO::File(">>e-m-s.log") or die "Could not open logfile $!";
      $lLog->print("
------------------------------

Incoming:

------------------------------
$lRead

");
    }
    

    # construct CXMLTreeBuilder
    my $lXMLTreeBuilder = new XML::Handler::EasyTree::Builder();
    # build a parse tree
    my $lParseTree = $lXMLTreeBuilder->stringToTree($lRead); 
    # make a visitor
    my $lVisitor = $lParameters{VISITOR} || new MRML::Server::Base::Visitor(images=>$self->{images});
    
    $lVisitor->beforeTraversal();
    #
    # the visitor will now build a response
    # during this run of traverse
    #
    my $lTraversal=new XML::Handler::EasyTree::Traversal();
    $lTraversal->traverse($lParseTree,$lVisitor);

    # construct CXMLTreeWriter
    my $lXMLTreeWriter = new XML::Handler::EasyTree::Writer();

    
    $lXMLTreeWriter->write_to_stream($lVisitor->getResponse(),$lAcceptedConnection);

    if($self->{DEBUG}->{logfile}){# write a log to e-m-s.log
      my $lLog=new IO::File(">>e-m-s.log") or die "Logging asked for but not possible";
      my $lXMLTreeWriter = new XML::Handler::EasyTree::Writer();;
      $lLog->print("++++++++++++++++++++++++++++++

Outgoing

++++++++++++++++++++++++++++++");
      $lXMLTreeWriter->write_to_stream($lVisitor->getResponse(),$lLog);

      $lLog->print("\n\n");
    }

    # close the XML connection
    $lAcceptedConnection->close;
  }
}


=pod 

=head2 END()

This is a function that is called when this object is destroyed by the 
garbage collection. All it does is to close and destroy the server socket.

=head1 SEE

  MRML::Server::Base::Visitor

=cut

sub END{
  my $self=shift;
  print "Destructor called\n";
  if($self->{socket}){
    $self->{socket}->close;
  }
  $self->{socket}=undef;
}

