#!/bin/perl

# Tests for RDF database and AggregateDS functionality
# author: danbri@rdfweb.org

use strict;
use Test;

BEGIN { plan tests => 15; }
BEGIN { unshift@INC,('../','../../');}

## Load commandline args in form --arg=value
##
my %cmd;
while ($_ = shift()) {
  next unless ($_ =~ s/^--//);
  my($lhs,$rhs)=split(/=/,$_,2);
  $lhs=lc($lhs);
  chomp $rhs;
  $cmd{$lhs}=$rhs if ($rhs);
}

my $TMP= "./tmp/"; # where our rdf databases live
my $verbose=$cmd{'verbose'};

print STDERR "Using/storing rdf data in: $TMP\n" if $verbose;


package RDF::Tester;
 
use strict;
use Test;

my $USED_OK=0;
eval {
require RDF::API::Database;
require RDF::RDFWeb::Node;
require RDF::RDFWeb::AggregateDS;
$USED_OK=1;
};

ok( $USED_OK ,'1', "Tests require various Perl modules." );


############################################################################
#  RDF Namespace URIs
############################################################################
my $FOAF = 'http://xmlns.com/foaf/0.1/';
my $INFO = 'http://xmlns.example.com/info/0.1/';
my $DC = 'http://purl.org/dc/elements/1.1/';
my $RSS = 'http://purl.org/rss/1.0/';
my $SMUSH = 'http://xmlns.com/example/sm1#';
my $RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
my $SM1 = 'http://xmlns.com/example/sm1#';

############################################################################


my ($db1,$db2,$db3);

## get our 1st database

eval {
  $db1 = new RDF::API::Database; # connect to database
  $db1->set('module'=>'RDF::RDFdb'); # set backend module to use
  $db1->set('rw'=>'1'); # rw
  $db1->set('datastore'=> $TMP.'default');
  $db1->open(); # open database
} ;
if ($@) {
  print STDERR "Failed to open rdfdb default in $TMP.default\n";
} else {
  print "Got default db: $db1\n" if $verbose;
}



## get a 2nd database
eval {
  $db2 = new RDF::API::Database; # connect to database
  $db2->set('module'=>'RDF::RDFdb'); # set backend module to use
  $db2->set('rw'=>'1'); # rw
  $db2->set('datastore'=> $TMP.'webdata2');
  $db2->open(); # open database
} ;
if ($@) {
  print STDERR "Failed to open rdfdb default in $TMP.default\n";
} else {
  print "Got default db: $db1\n" if $verbose;
}

my $LOCALDB_CONNECTED = 1 if ($db2 && $db1) ;

ok ($LOCALDB_CONNECTED, 1,  "Need to connect to local databases $db1 and $db2 ");


my $GOT_AGGREGATE = 1 if $db3 = new RDF::RDFWeb::AggregateDS; # database wrapper

ok ( $GOT_AGGREGATE, 1, "Connection to 3rd (aggregate) datasource");

print "Got wrapper database: $db3 using AggregateDS \n" if $verbose;

my $ADDDS_WORKED=0;
eval {
$db3->addDS($db1);	
$db3->addDS($db2);
$ADDDS_WORKED=1;
};
ok( $ADDDS_WORKED, 1, "Adding 2 datasources inside aggregate. $@" );


##############################################################################
#
# Tell db3 about some namespaces

ns $db3 'FOAF', $FOAF;
ns $db3 'INFO', $INFO;
ns $db3 'DC', $DC;
ns $db3 'RSS', $RSS;
ns $db3 'RDF', $RDF;
ns $db3 'SM1', $SM1;
##############################################################################

eval {
 $db1->assert($FOAF.'livesIn','mailto:danbri@rdfweb.org','http://bristol.example.com');
 $db1->assert($FOAF.'nick','mailto:danbri@rdfweb.org','danbri');
 $db1->assert($FOAF.'nick','mailto:danbri@rdfweb.org','DanBri');
 $db1->assert($FOAF.'livesIn','mailto:libby.miller@bristol.ac.uk','http://bristol.example.com');
 $db1->assert($FOAF.'worksFor','mailto:danbri@rdfweb.org','http://ilrt.org/');
 $db1->assert($FOAF.'age','mailto:danbri@rdfweb.org','28');
 $db1->assert($FOAF.'project','mailto:danbri@rdfweb.org','[genid-1000]');
 $db1->assert($DC.'title','[genid-1000]','"rdfweb testbed"');
 $db1->assert($FOAF.'homepage','[genid-1000]','http://rdfweb.org/');
 $db2->assert($INFO.'population','http://bristol.example.com','666,000');
 $db2->assert($INFO.'basedIn','http://ilrt.org/','http://bristol.example.com');

 $db1->assert($FOAF.'name','urn:foo:dan','Dan Brickley'); 
 $db1->assert($FOAF.'age','urn:foo:dan','29'); 
 $db1->assert($FOAF.'nick','urn:foo:dan','danbri'); 
 $db1->assert($FOAF.'workHomepage','urn:foo:dan','http://ilrt.org/'); 
};

ok($@,'', "Nothing should go wrong when asserting into db1 and db2. ".join
	(/\n/,$@) );


#$db1->{'DEBUG'}=1;
eval {
$db1->assert(undef,'foo',undef);
};
ok( $@, 'm/./', "Should get an error when asserting gappy triples: ".join(' ',$@));



databaseBugWorkaround(); ## @@todo: fix this! (see function below)

my ($brispop, $danlives); # somewhere to store results
# @@todo: make a test case for inner datasources
# $brispop = $db2->GetTarget('bristol','population');
# $danlives = $db1->GetTarget('dan','livesIn');


# test aggregate
$brispop = $db3->GetTarget('http://bristol.example.com', $INFO.'population');
$danlives = $db3->GetTarget('mailto:danbri@rdfweb.org', $FOAF.'livesIn');

ok ( $brispop, '/\d+/', "Database should return bristol population");
ok ( $danlives, '/./', "Database should return livesIn for query danbri");


######################################  webdata tests ####################
# Note:
#
# these tests use the files a.rdf b.rdf c.rdf from the 
# smush.html writeup of rdf aggregation issues.
# they use EricP's W3C RDF parser
# and require anonymous node name mapping to exploit fully
# simple tests first:

my %mapper;
my $k;

my @c = $db3->GetSources('http://megacorp.example.com/',
 					$SM1.'corporateHomepage');

if ($verbose) {
  foreach my $c (@c) {
    print " company id = ". $c ."\n";
    my @ct = $db3->GetTargets('http://megacorp.example.com/',
 					$RDF.'type');
    print "\t types= ".join(' ', @ct);
    print "\n";
  } 
}
# output will be something like...
#   company id = file:/./tests/c.rdf#genid1
#   company id = file:/./tests/a.rdf#genid1
# ie. the same company mentioned in two different files
# @@todo: normalise genids somehow? ../../ etc :(

$db3->namemap('file:/./tests/a.rdf#genid1','uuid:12345'); # posthoc name/uri discovery
$db3->namemap('file:/./tests/c.rdf#genid1','uuid:12345'); #


%mapper = %{ $db3->{'NAMEMGR'} }; ##@@todo: make a function to do this
if ($verbose) {
  print "Dumping name-mapper for company...\n";
  foreach $k (keys %mapper) { print "name $k  --> ".$mapper{$k} ."\n";}
}


my $GOT_NAMEMAP = 1 if ( %mapper ) ;

ok( $GOT_NAMEMAP, 1, 
  "Should be able to get the name-manager lookup hash from the aggregate db.");


###################################### name mapping ####################
# Note:
# the main use of namemap is the queryAndReturn method of 
# our AggregateDS class.
# issues still open: when do we return multiple hits?

print "\n----------- NAME MAPPER TESTS ---- \n" if $verbose;
 
## Each aggregate datasource maintains a (transient) name-mapping service

$db3->namemap('[genid-1000]','urn:ahem:rdfweb'); # posthoc name/uri discovery
$db3->namemap('[genid-1001]','urn:ahem:rdfweb2'); # 
$db3->namemap('[genid-1003]','urn:ahem:rdfweb3'); # 

# there is an (anonymous) resource with sometitle ...
$db1->assert('title','[genid-1000]','"rdfweb testbed"');


# view NAMEMGR info
%mapper = %{ $db3->{'NAMEMGR'} };
foreach $k (keys %mapper) { 
  print "\t $k :> ". $mapper{ $k } ."\n" if $verbose;
}

# now we ask for the title of the project, previously known only by the
# generated id but now we know its 'proper' uri

print "Asking for title of [genid-1000]\n" if $verbose;
my $anontitle = $db3->GetTarget('[genid-1000]','title');

print "Asking for title of urn:ahem:rdfweb\n" if $verbose;
my $urititle = $db3->GetTarget('urn:ahem:rdfweb','title');

# we should retrieve the title as urititle if mapper is working:

print "Testing namemap service: anontitle=$anontitle ; urititle=$urititle\n"
	if $verbose;


###################################### node-based api ####################

## Let's try this node-centrically instead

print "\n\nTesting node-centric autoload api\n" if $verbose;

# An RDF node is (transiently) associated with just one rdfdb, which
# may of course be an aggregate or other fancy contraption...
# eg:
my $bristol = new RDF::RDFWeb::Node('http://bristol.example.com', $db3);

print "Asking bristol node+context for 'info:population': ". 
 		$bristol->info_population(). "\n" if $verbose;

# sometimes in node-centric APIs you wish a property were
# named inversely. This hack allows that... (but not <-, sadly!)

print "bristol reverse livesIn singular: ". 
           $bristol -> INV_foaf_livesIn(). "\n" if $verbose;

##########################################################################
#
##  RDFWeb Tests
#
################ worked example from http://rdfweb.org/ ##################

print "aggtest: RDFWeb tests against $db3 " if $verbose;

my $mb = new RDF::RDFWeb::Node('mailto:mega@megacorp.example.com' , $db3 );
my $hb = new RDF::RDFWeb::Node('http://megacorp.example.com/~mega', $db3);
my $f  = new RDF::RDFWeb::Node('50', $db3 );

print "mbox owner: " . $mb -> INV_SM1_personalMailbox() ."\n" if $verbose;

# got a mailbox node ok
my $GOT_MAILBOX = 1 if $mb;
ok ($GOT_MAILBOX, 1, "Should be able to create an rdf node representing a mailbox");


print "aggtest: RDFWeb INV tests against $db3 \n" if $verbose;
my  $who_test = $mb->INV_SM1_personalMailbox();

my $p1;
if ($mb->INV_SM1_personalMailbox()) { 
  $p1 = new RDF::RDFWeb::Node( $who_test, $db3);
print "\n\naggtest: RDFWeb: p1 context check: ", $p1->{'CONTEXT'},"\n" if $verbose;

} else { 
  print "Didn't get p1 by inverse mailbox lookup.\n";
}
my $FOUND_PERSONID = 1 if $p1;

ok( $FOUND_PERSONID, 1, "Should be able to use mailbox id to find person id: $p1");


print "aggtest: RDFWeb LOOKUP tests against $db3 \n" if $verbose;

if ($FOUND_PERSONID && $verbose) {
print "Looking up tech interests of $p1 using db ".$p1->{'CONTEXT'}." db3=$db3\n";
  print "\tThe tech interests of the mailbox owner are: \n",
		join (" , ", $p1->sm1__technologyInterest ) ."\n" ;
  print "\tpersonal homepage at ". $p1->sm1_personalHomepage ."\n";
} 

my $FOUND_MBOX = 1 if ($p1 && $p1->sm1_personalMailbox  ) ;
ok( $FOUND_MBOX, 1, "Test of node-centric API, finding mailbox from person id");


###########################################################################
## Sanity check behaviour of property method implementation
## try to use a non-existent namespace prefix on a node; should throw 
## an exception. 
###########################################################################

my $GULLIBLE_NODECLASS=0;
eval { 
  print STDERR $p1->foo_bar(); # call fictional ns on a working node 
};
$GULLIBLE_NODECLASS = 1 if (!$@);
ok ( $GULLIBLE_NODECLASS, 0, 
     "Gullible Node class: should complain about bogus ns prefix");



############################################################################
#
# RDF Site Summary (RSS) 1.0 Tests
#
############################################################################
# test 11: RSS 1.0 
# 
# see also http://www.redland.opensource.ac.uk/docs/pod/RDF/RSS.html
#      and http://www-uk.hpl.hp.com/people/bwm/rdf/jena/rssinjenahtm
#          http://purl.org/rss/1.0/
#
# note, we're using a different style for calling perl methods, rather than "$ob->method()"

$db3->{'xmlns:RSS'}=($RSS); # make sure RSS namespace registered
				#todo: add a method to do this... addNS()

my @channels = $db3->GetSources( $RSS.'channel', $RDF.'type' );

print "RSS:channel - found: ".@channels. "\n" if $verbose;


foreach my $chanuri (@channels) {

   print "Channel uri = $chanuri \n" if $verbose;

   my $channel = new RDF::RDFWeb::Node( $chanuri, $db3 ); 

   my $url 	= rss_link $channel ;
   my $title 	= rss_title $channel ;
   my $desc 	= rss_description $channel ;
   my $img 	= rss_image $channel ;


   print  "Channel: $url $title description: $desc IMG=$img\n\n" if $verbose;
 
   my $i;
   if (rss_image $channel) {
     $i = new RDF::RDFWeb::Node( $channel->rss_image, $db3 );
   }
   
   if ($i && $verbose) { 
     print "Got image node: ".$i." and context is ".$i->{'CONTEXT'}. "\n" if $verbose;
     print "\tImage [uri] is ". 	value $i 		."\n";
     print "\tImage link: ".   		rss_link $i 		. "\n";
     print "\tImage title: ".  		rss_title $i 		. "\n";
     print "\tImage description: ".    	rss_description $i 	. "\n";
     print "\tImage url: ". $i->rss_url. "\n";
   }


# issue: how to do inverse properties?
# my $X = new Node(); 
# my @employees = $X->foaf__worksFor( 'http://ilrt.org/' );
# or a class method? or INV_ or operator overloading or ...
# ???


# (todo: if we change to return nodes not strings, alter this)
#
my $itemseq = new RDF::RDFWeb::Node( rss_items $channel, $db3 );
my @t = rdf_type $itemseq;

## Now we want to emumerate the _1 _2 _3 etc properties of itemseq

my $n=1;
my @seq;
my $item;

while (my $m = $db3->GetTarget( $itemseq->value, $RDF. "_$n" ) ) {

  $item = new RDF::RDFWeb::Node($m, $db3 );

  if ($verbose) {
    print "\t Item: ". $item->rss_title ."\n";
    print "\t Link: ". $item->rss_link ."\n";

    # we really want to print either not both; and fix a convention
    # (I suspect xmlhack should ship rss:description...)
    # ...or we could use this as a subproperty test case?

    my $blurb = $item->rss_description . $item->dc_description ;
    $blurb =~ s/\n/ /g;
    print "\t details:  $blurb \n\n\n";
  } # print out RSS item details for verbose debugging

  $n++;
}

##########################################################################
## Test 12: _n in Node API (TODO: this currently fails)
##########################################################################

my $t_12 = rdf__1 $itemseq;
print "Testing API for Seq members: _1: $t_12 \n" if $verbose;
skip (!$item, $t_12, 'm/./', "Should find first member of RSS item seq via node API");
 
}

#######################################################################

#$db1->assert($FOAF.'nick','mailto:danbri@rdfweb.org','DanBri');
my $dan = new RDF::RDFWeb::Node 'mailto:danbri@rdfweb.org', $db3;
print "Testing list context API \n" if $verbose;
my @test_listcontext = foaf_nick $dan;
ok (scalar @test_listcontext, 2, 
	"should be two nicks for mailto:danbri\@rdfweb.org if list context api works: length of  test is... ".
	scalar @test_listcontext. "\n" );
 

#######################################################################

print "\nEnd tests.\n" if $verbose;




#######################################################################
#######################################################################
#######################################################################

sub  othertest {
use overload '=>' => \&myfunc;
no strict;
print "channel image, return node:  ".$channel=>rss_image . "\n";
}

 
sub myfunc {
  my ($l,$r)=@_;
  print "Overloading $l to $r using l->NODE_r\n\n" if $verbose;
  return eval('$l->NODE_$r');
}

sub databaseBugWorkaround {
## @@todo: Bug: should be no need for this.
## problem is database not creating backend... 
  $db1->index();
  $db2->index();
  $db1->close();
  $db2->close();
  $db1->open();
  $db2->open();
}


# notes from rdfweb example:

# :technologyInterest http://www.w3.org/XML/
# :technologyInterest web:resource="http://www.w3.org/RDF/
# :technologyInterest web:resource="http://www.mozilla.org/
# :corporateHomepage http://megacorp.example.com/
# :ethicalPolicy {
#  :PolicyStatement http://dotherightthing.example.org/policy.xhtml
#  :title """Ethical Business Shared Guidelines 1.1"""
# }


# api notes:

  # note: this doesn't work (precedence etc?)
  #  print  $item->rss_description || $item->dc_description ."\n";