#! /usr/bin/perl

############################################################
#
# This code is dual licensed.
#
# See either Artistic.html or COPYING.lib for the exact conditions.
# Choose among Artistic.html and COPYING.lib 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;
#use lib ".";
use strict;
#
# this is a helper class 
# the real server starts below
# in package MRML::Server::Base
#

package MRML::Server::Base::Visitor;
use vars qw(@ISA @EXPORT_OK);
@ISA=qw(Exporter);
@EXPORT_OK=qw(new
	      beforeTraversal
	      start_visit
	      end_visit);

use XML::Handler::EasyTree::Visitor;

=pod

=head1 NAME

MRML::Server::Base::Visitor - a visitor for XML elements

=head1 SYNOPSIS

my $lVisitor=new MRML::Server::Base::Visitor(images => \@list_of_images);

$lVisitor->start_visit($lDocumentRoot);

$lVisitor->end_visit($lDocumentRoot);

$lVisitor->getResponse();

=head1 DESCRIPTION

This visitor is designed for visiting MRML messages.
After the traversal of a complete query MRML tree you can
get an MRML parse tree from the visitor that contains
the I<response> to the query MRML tree visited.

This class is used by the MRML::Example server class 
for processing MRML messages.

=head1 The node format

The format of the node of an MRML parse tree is I<extremely> simple
compared to other XML representations. A node (==element) is
represented as the reference to a hash, that contains four
hash-elements:

=over 4

=item C<type> 
       either 't'(ext) or 'e'(lement)

=item C<element> 
       contains the name of the XML element

=item C<attrib>
       contains a reference to a hash containing 
       attributes and values of the XML element

=item C<content>
       contains a (possibly empty) list of other such XML elements
       (or the text), if a text node

=back

If you have trouble with the notation, please consult the perlref or
the perlreftut manpage, or in case of need the author of this file.

=head1 Functions:

=cut

#use lib ".";
use POSIX;
use XML::Handler::EasyTree::Visitor;

=pod

=head2 new()

New expects a list of attribute-value pairs as parameter 

It builds a new visitor object, and passes the parameters on 
to $self->initialize() . "initialize" does the real work.

Currently initialize expects the parameter "images" to be set to
a reference to a list containing image URLs (see synopsis).

=cut

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


sub initialize(){
  my $self=shift;
  
  
  my $lVariable;
  while($lVariable=shift){
    my $lValue=shift;
    print "setting $lVariable = $lValue\n";
    $self->{$lVariable}=$lValue;
  }
  $self->beforeTraversal();
  
  # write interaction into a log file
  $self->{DEBUG}->{logfile}=1;
}

=pod

=head2 getResponse()

Returns the response message that was generated 
during the visit of an MRML tree.

=cut

sub getResponse(){
  my$self=shift;
  # return a list reference for making
  # it an EasyTree
  return([$self->{response}]);
}

=pod

=head2 beforeTraversal()

Does partial initialisation. It initializes the response MRML element, 
and prepares some MRML subtrees that are used often.

This function is needed when using one visitor for multiple messages.

=cut

sub beforeTraversal(){
  my $self=shift;
  $self->{path}=[];
  
  #
  # this is the parse tree of the XML tag:
  #
  # <mrml/>
  #
  $self->{response}={		#
		     type=>'e',
		     name=>"mrml",
		     attrib=>{'session-id'=>1},
		     content=>[]
		    };
  #
  # query-paradigm-list which allows 
  # for all kinds of queries
  #
  $self->{all_paradigms}={type=>'e',
			   name=>"query-paradigm-list",
			   attrib=>{},
			   content=>[
				     {
				      type=>'e',
				      name=>"query-paradigm",
				      attrib=>{},
				      content=>[]
				     }
				    ]
			   
			 };
  #
  # property sheet with 2 example widgets
  #
  $self->{property_sheet}={	# a hardcoded example property sheet
			    type=>'e',
			    name=>"property-sheet",
			    attrib=>{
				     "property-sheet-id"  => 1,
				     "property-sheet-type"=> "subset",
				     "send-type"=> "none",
				     "minsubsetsize"=> "1",
				     "maxsubsetsize"=> "1"
				    },
			    content=>[
				      {
				       type=>'e',
				       name=>"property-sheet",
				       attrib=>{
						"property-sheet-id"  => 1,
						"property-sheet-type"=> "set-element",
						"send-type"=>"attribute",
						"send-name"=>"test",
						"send-name"=>"yes",
						"caption"=>"Hello, this is just for testing"
					       },
				       content=>[
						 {
						  type=>'e',
						  name=>"property-sheet",
						  attrib=>{
							   "property-sheet-id"  => 2,
							   "property-sheet-type"=> "numeric",
							   from=>0,
							   to=>12,
							   step=>2,
							   "send-type"=>"attribute",
							   "send-name"=>"test2",
							   "send-value"=>"0",
							   "caption"=>"This goes from 0 to 12 by steps of 2"
							  },
						  content=>[]
						 }
						]
				      }
				     ]
			  }  
}

=pod

=head2 addToResponse()

Add an MRML element to the response MRML tree

=cut

sub addToResponse( $ ){
  my $self=shift;
  my $lToBeAdded=shift;
  
  #
  # push the parameter to the parse tree
  # 
  push @{$self->{response}->{content}},$lToBeAdded;
}

=head2 addToQueryResultElementList()

Add an MRML element to the query result MRML tree

=cut

sub addToQueryResultElementList( $ ){
  my $self=shift;
  my $lToBeAdded=shift;
  
  #
  # push the parameter to the parse tree
  # 
  print "addToQueryResultElementList $self->{result}->{name}\n";
  push @{$self->{'query-result-element-list'}->{content}},$lToBeAdded;
}

=pod

=head2 start_visit()

Start visiting an MRML element, i.e. this function is called
when descending into the tree. The function receives the root of
an MRML subtree as input parameter. 

This function does actually most of the work in the server: It finds
out which tag currently is visited, and draws the necessary
consequences. People wanting to extend the server, please look at 
the C<query-step> and C<user-relevance-element> parts.

=cut



sub start_visit(){
  my $self=shift;
  my $lRoot=shift;
  if($lRoot->{type} eq 'e'){	# this is an element, and not free text
    #
    # add the name of the element to the path
    #
    push @{$self->{path}},$lRoot->{name};
    
    
    print join("/",@{$self->{path}}),"\n";
    
    #
    # get the sessionID
    #
    if($lRoot->{name} eq "open-session"){
      $self->addToResponse({
			    type=>'e',
			    name=>"acknowledge-session-op",
			    attrib=>{"session-id"=>1},
			    content=>[]
			   });
      
    }
    
    # client wants a list of available sessions
    if($lRoot->{name} eq "get-sessions"){
      # give back a list containing one session
      $self->addToResponse({
			    type=>'e',
			    name=>"session-list",
			    attrib=>{},
			    content=>[
				      {
				       type=>'e',
				       name=>"session",
				       attrib=>{
						"session-id"=>1,
						"session-name"=>"Default session"
					       }
				      }
				     ]
			   });
    }
    # client wants a list of available collections
    if($lRoot->{name} eq "get-collections"){
      # give back a list containing one collection
      $self->addToResponse({
			    type=>'e',
			    name=>"collection-list",
			    attrib=>{},
			    content=>[
				      {
				       type=>'e',
				       name=>"collection",
				       attrib=>{
						"collection-id"=>1,
						"collection-name"=>"Default collection"
					       },
				       content=>[
						 $self->{all_paradigms}
						]
				      }
				     ]
			   });
    }
    # client wants a list of available algorithms
    if($lRoot->{name} eq "get-algorithms"){
      # give back a list containing one algorithm
      $self->addToResponse({
			    type=>'e',
			    name=>"algorithm-list",
			    attrib=>{},
			    content=>[
				      {
				       type=>'e',
				       name=>"algorithm",
				       attrib=>{
						"algorithm-id"=>1,
						"algorithm-type"=>1,
						"algorithm-name"=>"Default algorithm"
					       },
				       content=>[
						 $self->{all_paradigms},
						 $self->{property_sheet}
						]
				      }
				     ]
			   });
    }
    #
    # client queries:
    #   THIS IS THE BEGINNING OF A QUERY STEP
    #   PUT CODE HERE TO INITIALISE THE QUERY
    #
    if(join("/",@{$self->{path}}) eq "mrml/query-step"){

      print "PREPARING RESULT PAGE\n";

      $self->{"result-size"}=$lRoot->{attrib}->{"result-size"}     || 0;
      $self->{"result-cutoff"}=$lRoot->{attrib}->{"result-cutoff"} || 0.0;
      $self->{"element-count"}=0; # to count the number of query images (counts also indifferent images)
      $self->{"query-images"}=[];
      $self->{'query-result-element-list'}={
					    type=>'e',
					    name=>"query-result-element-list",
					    attrib=>{},
					    content=>[]
					   };
      
    }
    #
    # client queries: the path must be
    #   mrml/query-step/user-relevance-element 
    #
    #   THIS IS THE BEGINNING OF A USER-RELEVANCE-ELEMENT 
    #
    #   put code here that concerns just
    #   one element image of the query 
    #
    #
    if(join("/",@{$self->{path}}) eq "mrml/query-step/user-relevance-element-list/user-relevance-element"){
      #
      # an example for extracting the image location
      # and the relevance attributed by the user
      #
      # these data are put into a list. This list is output onto the screen
      # when the query is finished
      push(@{$self->{"query-images"}},[$lRoot->{attrib}->{"image-location"},$lRoot->{attrib}->{"user-relevance"}]);
      $self->{"element-count"}++;
    }
    # client wants a list of available property-sheet
    if($lRoot->{name} eq "get-property-sheet"){
      # give back a list containing one algorithm
      $self->addToResponse($self->{property_sheet});
    }
  }
  return 1;# always recurse
}

=pod

=head2 end_visit()

End visiting an MRML element, i.e. this function is called
when moving back up to the root. The function receives the root of
an MRML subtree as input parameter. 

=cut

sub end_visit(){
  my $self=shift;
  my $lRoot=shift;
  
  if($lRoot->{type} eq 'e'){ #for tags that are not text tags
    if(join("/",@{$self->{path}}) eq "mrml/query-step"){
      #
      # THE QUERY SPECIFICATION IS FINISHED NOW:
      #
      my $i;
      if(!$self->{"element-count"}){
	print "Empty query: will deliver just a random selection of images!\n";
	#preparing random selection
	my $j;
	# never try to deliver more images than we have
 	if($self->{"result-size"} > scalar(@{$self->{images}})){
 	  $self->{"result-size"} = scalar(@{$self->{images}})
 	}

	#
	# trick: generate random permutation of images by doing a quicksort
        # with random instead of a comparison function
	#
	my(@l_sorted_references)=(sort {0.5 <=> rand} (@{$self->{images}}));

	for $j (@l_sorted_references[0..$self->{"result-size"}-1]){
	  my $lResultElement={
			      type=>'e',
			      name=>"query-result-element",
			      attrib=>{
				       "image-location"=>
				       $j,
				       "thumbnail-location"=>
				       $j,
				       "calculated-similarity"=>"1"
				      },
			      content=>[]
			     };
	  $self->addToQueryResultElementList($lResultElement);
	}
      }else{
	
	# first we print something on the screen
	foreach $i (@{$self->{"query-images"}}){
	  print "Query images: 
Score: $i->[1] 
URL:   $i->[0] \n";
	}
	print "The *marked* images will be sent back as pseudo query result\n";
	
	#
	# then we add something to the query result In this case, we
	# simply send back the marked images as result
	#
	
	#
	# PUT YOUR INTELLIGENT CODE HERE!
	#
	

	my(@lResult)=($self->do_query_by_images(@{$self->{"query-images"}}));
	foreach $i (@lResult) {
	  my $lResultElement={
			      type=>'e',
			      name=>"query-result-element",
			      attrib=>{
				       "image-location"=> $i->[0],
				       "thumbnail-location"=> $i->[0],
				       "calculated-similarity"=> (defined($i->[1]))?$i->[1]:0
				      },
			      content=>[]
			     };
	    $self->addToQueryResultElementList($lResultElement);
	}
      }

      
      #this corresponds to sending the result
      $self->addToResponse({
			      type=>'e',
			      name=>"query-result",
			      attrib=>{
				      },
			      content=>[
					$self->{'query-result-element-list'}
				       ]
			   }
			  );
    }
    
    #endif !defined
    pop @{$self->{path}};
  }
}


=pod

=head2 do_query_by_images( @in_list_of_pairs )

runs a query on a list of [url,relevance] pairs and 
gives back the result in form of a [url,score] list.

=cut
sub do_query_by_images( @ ){
    my $self=shift;

    my @l_result;
    my $i;
    foreach $i (@_) {
	if($i->[1]!=0){
	    push @l_result,$i;
	}
    }
    return (@l_result);
}


=pod

=head1 SEE

perlref, perlreftut, CXMLElementVisitor

=cut
