#! /usr/bin/perl -w

############################################################
#
# This code is GPL|Artistic 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>

use XML::Writer;

require Exporter;

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

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

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 Data::Dumper;

=pod

=head1 NAME

MRML::Client::Base - a minimal client for testing MRML servers

=head1 SYNOPSIS

use MRML::Client::Base;

 $client = new MRML::Client::Base(address => localhost,
			   port    => 12345);

 $response=$client->open_session('user-id'=>"user",
                                'session-name'=>"sessionname");
 $response=$client->send_message(tree=>[{
					 type=>'e',
					 name=>'query-step',
					 content=>[
						   {
						    type=>'e',
						    name=>'user-relevance-element-list',
						    attrib=>{}
						    content[{
							     type=>'e',
							     name=>'user-relevance-element',
							     attrib=>{
								      'image-location'=>"http://www.benchathlon.net/img/done/128x192/3328_2013/0519/0011.jpeg",
								      'user-relevance'=>1
								     }
							    }]
						   }
						  ]
					}
				       ]);
$client->delete_session("user","sessionname");

=head1 DESCRIPTION

This is an MRML client that is designed for testing and subclassing. 
The main focus here is on 

  providing enough infrastructure to open a new MRML session

  providing some functions for passing through MRML messages


The functions in detail:

=cut


=pod

=head2 new()

new calls initialize for initialisation. The list of parameters is
interpreted as attribute/value pairs, and fed directly into $self

=cut

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

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

=pod

=head2 open_session()

This function connects to a server, and sends an open-session MRML command. 

=cut


sub open_session{
  my $self=shift;

  my $in_params={};
  (%{$in_params})=(@_);

  my $l_message=[{
		  type=>'e',
		  name=>'mrml',
		  attrib=>{'session-id'=>'nothing'},
		  content=>[{
			    type=>'e',
			    'name'=>'open-session',
			    attrib=>{
				     'user-id'=>$in_params->{"user-id"} || 'anonymous',
				     'session-name'=>$in_params->{"session-name"} || 'no-session-name-given'
				    },
			    content=>[]
			    }]
		 }];
  my $l_response=$self->send_message(tree=>$l_message);

  my $l_session_id=$l_response->[0]->{attrib}->{'session-id'};

  die("Server did not return session ID. Bailing out.")
    unless($l_session_id);

  $self->{'session-id'}= $l_session_id;

  return $l_response;
}

=pod

=head2 $self->configure_session()

Configure a previsously opened sessionneither by giving
  collection-id
  algorithm-id
  algorithm-type
like this:

 $self->configure_session( "collection-id"=>"TSR500", 
              			 "algorithm-id"=>"adefault",
                                 "algorithm-type"=>"adefault");

or by directly specifying the C<algorithm> element to be used

 $self->configure_session( "tree"=> [{
		 type=>'e',
		 name=>'algorithm',
		 attrib=>{
			  "collection-id"=>"TSR500",
			  "algorithm-id"=>"adefault",
			  "algorithm-type"=>"adefault"
			 },
		 content=>[]
		}];

=cut 

sub configure_session{
  my $self=shift;

  my $in_params={};
  (%{$in_params})=(@_);

  $self->{'algorithm-id'}=$in_params->{'algorithm-id'};

  my $l_content;
  if($in_params->{tree}){
    $l_content=$in_params->{tree};
  }else{
    $l_content=[{
		 type=>'e',
		 name=>'algorithm',
		 attrib=>{
			  "collection-id"=>$in_params->{'collection-id'},
			  "algorithm-id"=>$in_params->{'algorithm-id'},
			  "algorithm-type"=>$in_params->{'algorithm-type'}
			 },
		 content=>[]
		}];
  }


  my $l_message=[{
		  type=>'e',
		  name=>'mrml',
		  attrib=>{'session-id'=>$self->{'session-id'} || die "No session open yet" },
		  content=>[{
			    type=>'e',
			    'name'=>'configure-session',
			    attrib=>{
				     'session-id'=>$self->{"session-id"} || die "No session open yet"
				    },
			    content=>$l_content
			    }]
		 }];

  my $l_response=$self->send_message(tree=>$l_message);
  
  my $l_acknowledged=0;
  my $i;
  foreach $i (@{$l_response->[0]->{content}}){
    $l_acknowledged = 
      $l_acknowledged 
	|| ($i->{name}=~m/acknowledge\-session\-op/);
  }
  die unless $l_acknowledged;

  return $l_response;
}


=pod

=head2 my $l_mrml_tree=$self->generate_mrml(tree=>$tree);

  Wraps a given EasyTree with MRML tags and the session-id of 
  the currently open session

=cut
sub generate_mrml( $ ){
  my $self=shift;
  my $in_params={};
  (%{$in_params})=(@_);

  my $in_tree=$in_params->{tree} || die " no input ";
  
  return [{
	   type=>'e',
	   name=>'mrml',
	   attrib=>{'session-id'=>$self->{'session-id'} || die "No session open yet" },
	   content=>$in_tree
	  }];
}
=pod

=head2 my $l_mrml_tree=$self->query_step($tree);

  Wraps a given EasyTree with query-step tags and the session-id of 
  the currently open session

=cut

sub generate_query_step( $ ){
  my $self=shift;
  my $in_params={};
  (%{$in_params})=(@_);
  
  my $in_tree=$in_params->{tree} || die " no input ";
  
  delete $in_params->{tree};

  return $self->generate_mrml(tree=>[{
				      type=>'e',
				      name=>'query-step',
				      attrib=>{(%$in_params),#all parameters become attributes
					       # and these attributes will be overwritten
					       'algorithm-id'=> $in_params->{'algorithm-id'} 
					       ||  $self->{'algorithm-id'} 
					       ||  die "No algorithm configured",
					       'result-cutoff'=> $in_params->{'result-cutoff'} || 0,
					       'result-size'=> $in_params->{'result-size'} || 5,
					      },
				      content=>$in_tree
				     }]);
}

=pod

=head2 $self->send_message( tree=>$in_easy_tree )

This function opens a connection to the host, 
sends over an easy_tree, and gives back the response
(parsed, of course) given by the host, in form
of an EasyTree.

=cut

sub send_message( $ ){
  my $self=shift;

  my(%in_parameters)=(@_);

  my $in_tree=$in_parameters{tree};
  
  my $l_socket = IO::Socket::INET->new(PeerAddr => $self->{address}) || die "no socket";
  
  print "sending ",Dumper($in_tree) if $in_parameters{dump};

  if( $l_socket ){
    my $l_writer=new XML::Handler::EasyTree::Writer();
    $l_writer->write_to_stream($in_tree,$l_socket);
    $l_socket->shutdown(1);
  }
  my $l_builder=new XML::Handler::EasyTree::Builder();
  my $l_result=$l_builder->streamToTree($l_socket);
  
  #print "got back ",Dumper($l_result);

  $l_socket->shutdown(2);
  $l_socket=undef;
  return $l_result;
}


=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

 XML::Handler::EasyTree::Builder
 XML::Handler::EasyTree::Writer
 XML::Handler::EasyTree::Visitor
 XML::Handler::EasyTree::Traversal

=cut

sub END{
  my $self=shift;
  print "Destructor called\n";
}

