#!/usr/bin/perl

##############################################################################
#                                Radish 
##############################################################################
#  an interactive shell for searching, querying, and creating RDF
#
# Copyright (C) 2002-2004 Steve Pomeroy <steve@staticfree.info>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
#
##############################################################################

# The name?
#
# 10:19 < xavier> ok, important decision: I need a name.
# 10:24 <@dajobe> radish - rdf-ish shell
#

######################### 
# $Id: radish,v 1.9 2004/12/29 19:00:40 steve Exp $
#########################
# $Log: radish,v $
# Revision 1.9  2004/12/29 19:00:40  steve
# added GPL stuff
#
# Revision 1.8  2004/12/29 18:18:36  steve
# added basic on-board help
# added feature autodetection (less required dependencies)
# cleaned up for release
#
# Revision 1.7  2004/12/29 16:01:56  steve
# too many changes:
# * rename from "rdfdb" to "radish"
# * new RDQLabbv syntax for searches
# * colorifies the terminal
# * initial code for making "lang" work better
# * cleaned out old "history" system
# * loads queries from the RDF store
# * initial framework for new history system
#
# Revision 1.6  2004/09/12 04:43:41  steve
# lotsa changes, including new commands and a new command processing structure
#
# Revision 1.5  2004/09/02 15:08:45  steve
# mostly working smusher, though unoptomized
#
# Revision 1.4  2004/08/27 06:07:11  steve
# * added 'sync' command
# * added 'smush' command and basic smushing code
# * added 'define' command and basic RDQL queries
# * misc cleanups/fixes
#
# Revision 1.3  2004/08/17 02:23:17  steve
# reworked code
# added:
# * shell
# * more namespaces
# * Festival support
# * English predicate translations
#
# Revision 1.2  2004/08/12 12:37:28  steve
# added a verbose mode
# added English abbreviations
# added more known namespaces
#
# Revision 1.1  2004/08/12 05:52:09  steve
# added
#########################

use strict;
use Getopt::Std;
use Term::ReadLine;
use Term::ANSIColor;
use Data::Dumper;

use RDF::Redland;
use Radish::RDQLabbv;

### runtime-detected
# use Festival::Client

my ($version) = '$Revision: 1.9 $' =~ /Revision:\s*(.+)\$/;

our ( $opt_h, $opt_V, $opt_v );
getopts("hVv");

usage() if $opt_h;

die "$0 version: $version\n" if $opt_V;

usage() unless @ARGV;

my $verbose = $opt_v;

#### end init #####################################################

#### customizable stuff ###########################################

my $dir = "$ENV{HOME}/.radish";

# preferred languages in order of preference, most -> first.
# XXX not used yet
my @preferred_langs = ('en', 'fr', 'jbo', 'ja' );


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

my $storage = new RDF::Redland::Storage("hashes", "radish", 
					"dir='$dir',hash-type='bdb',contexts='yes'");
die "Failed to create RDF::Redland::Storage: $!\n" unless $storage;

my $model=new RDF::Redland::Model($storage, "");
die "Failed to create RDF::Redland::Model for storage\n" unless $model;

my %parsers = (
    'rdf+xml' => 
	new RDF::Redland::Parser("raptor", 
				 "application/rdf+xml"),
	'turtle' => 
	new RDF::Redland::Parser("turtle", 
				 "application/x-turtle"),
    );

my $any_parsers = 0;
# warn of non-existant parsers
foreach my $parser ( keys %parsers ){
    warn "no $parser parser found. Disabling.\n" unless $parsers{$parser};
    $any_parsers = 1 if $parsers{$parser};
}

die "Failed to find any parsers\n" unless $any_parsers;

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

my $OUT = \*STDOUT;

my $rdqlabbv = new Radish::RDQLabbv();

##### feature detection#################################################

my %features;

### Festival ###

# test to see if festival exists
if( eval "use Festival::Client; 1" ){

    $features{'tts'} = { provider => "Festival::Client", 
			 description => "Text-to-speech" };

}

# dump all features
foreach my $feature ( keys %features ){
    print $OUT $features{$feature}->{description}, " enabled: ". 
	$features{$feature}->{provider},  "\n";
}

my $festival;
my $outmode = "screen";

# do we run commands outright?
my $interactive = 0;

# all the RDQL queries
my %queries;


#######


my %ns = ( dc   => new RDF::Redland::URI("http://purl.org/dc/elements/1.1/"),
	   foaf => new RDF::Redland::URI("http://xmlns.com/foaf/0.1/"),
	   rdf  => new RDF::Redland::URI("http://www.w3.org/1999/02/22-rdf-syntax-ns#"),
	   rdfs => new RDF::Redland::URI("http://www.w3.org/2000/01/rdf-schema#"),
	   geo => new RDF::Redland::URI("http://www.w3.org/2003/01/geo/wgs84_pos#"),
	   mbta => new RDF::Redland::URI("http://staticfree.info/ns/mbta/0.1/syntax#"),
	   bio =>  new RDF::Redland::URI("http://purl.org/vocab/bio/0.1/"),
	   rss => new RDF::Redland::URI("http://purl.org/rss/1.0/"),
	   owl => new RDF::Redland::URI("http://www.w3.org/2002/07/owl#"),
	   trust => new RDF::Redland::URI("http://trust.mindswap.org/ont/trust.owl#"),
	   radishq => new RDF::Redland::URI("http://staticfree.info/ns/radish/query/"),
	   radish => new RDF::Redland::URI("http://staticfree.info/ns/radish/"),
 );

# make a turtle/n3 namespace prefix header
my $ttl_ns_prefix = join "\n",  
    map { "\@prefix $_: <".$ns{$_}->as_string."> ." } keys %ns;

# and a RDQL namespace prefix
my $rdql_ns_prefixes = join ", ",
    map { "$_ for <".$ns{$_}->as_string.">" } keys %ns;

my %uris = ( rdf_type => 
	     RDF::Redland::Node->new_from_uri( $ns{rdf}->as_string."type" ),
	     rdfs_seeAlso => 
	     RDF::Redland::Node->new_from_uri( $ns{rdfs}->as_string."seeAlso" ),
	     rdfs_label => 
	     RDF::Redland::Node->new_from_uri( $ns{rdfs}->as_string."label" ),

	     dc_title => 
	     RDF::Redland::Node->new_from_uri( $ns{dc}->as_string."title" ),
	     dc_description => 
	     RDF::Redland::Node->new_from_uri( $ns{dc}->as_string."description" ),
	     foaf_name => 
	     RDF::Redland::Node->new_from_uri( $ns{foaf}->as_string."name" ),
	     foaf_nick => 
	     RDF::Redland::Node->new_from_uri( $ns{foaf}->as_string."nick" ),

	     radish_question => 
	     RDF::Redland::Node->new_from_uri( $ns{radish}->as_string."question" ),

	     );

# IFPs that are language-neutral, but aren't an rdf:resource
# any of these will be stripped of their language information upon loading
my @lang_neutral = 
    ( 
      RDF::Redland::Node->new_from_uri( $ns{foaf}->as_string."mbox_sha1sum" ), 
      RDF::Redland::Node->new_from_uri( $ns{foaf}->as_string."aimChatID" ),
      RDF::Redland::Node->new_from_uri( $ns{foaf}->as_string."icqChatID" ),
      RDF::Redland::Node->new_from_uri( $ns{foaf}->as_string."jabberID" ),
      RDF::Redland::Node->new_from_uri( $ns{foaf}->as_string."msnChatID" ),
      );

my %commands = ( 
		 add        => \&add_command,
		 reload     => \&reload_command,
		 expand     => \&expand_command,
		 smush      => \&smush_command,
		 query      => \&query_command,
		 insert     => \&insert_command,
		 sync       => \&sync_command,
		 cleanlang  => \&clean_xml_command,
		 shell      => \&shell_command,
		 dumpqueries=> \&dump_queries_command,
		 define     => \&define_command,
		 write      => \&write_command,
		 contexts   => \&contexts_command,
		 search     => \&search_command,
		 s          => \&rdql_search_command,
		 ttsmode    => \&ttsmode_command,
		 verbose    => \&verbose_command,
		 help       => \&help_command,
		 		 
		 );

my %command_meta = (
		    add => { 
			description => 
			    "adds a URL to the model" },

		    reload => { 
			description => 
			    "reloads the given URL into the model" },
		    expand => {
			description => 
			    "given a search query, looks for rdfs:seeAlso to better describe a given subject" },
		    smush => { 
			description => 
			    "smushes the model. XXX corrupts database", },
		    query => {
			description => 
			    "runs an RDQL query on the model. NS are added in"}, 
		    insert => {
			description => 
			    "inserts turtle statements into the model" },
		    sync => {
			description => 
			    "synchronizes the model" },
		    cleanlang => {
			description => 
			    "removes xml:lang from all the statements in the model" },
		    shell => {
			description => 
			    "an interactive shell" },
		    define => {
			description => 
			    "defines an RDQL query to run with parameters", 
			usage => 
			['define personq WITH a, b SELECT ?a, ?c WHERE ( ?a foaf:name "$a") ( ?a $b ?c )']  },
		    write => {
			description => 
			    "writes out to a file" },
		    search => {
			description => 
			    "searches using an abbreviated turtle syntax",
			    usage => [
				      "search foaf:name steve",
				      "search foaf:name \"steve pomeroy\"; foaf:nick ?" 
				      ]
				  },
		    s => {
			description => 
			    "searches using the RDQLabbv syntax",
			    usage => [
				      "s foaf:name \"Steve Pomeroy\"",
				      "s <http://staticfree.info/steve/foaf.rdf#steve> foaf:name ?name",
				      "s foaf:weblog <http://staticfree.info/blog/>",
				      "s ?a foaf:knows ?c"
				      ]
			},
		    ttsmode => {
			description => 
			    "turns on text-to-speech output",
			},
		    verbose => {
			description => 
			    "toggles verbose output",
			}
		    );
		    
		
		
my $history;

load_queries( $model );

process_commands( $model, @ARGV );

print "syncing model\n";

$model->sync;

foreach my $parser (keys %parsers ){
    $parsers{$parser} = undef;
}

$storage = undef;
$model = undef;


print $OUT "done.\n";
exit;


#### helper subs ##########################################











sub rdql_search_command{

    my $model = shift;

    my $search = join " ", @_;

    rdql_abbv_search( $model, $search );
    
}


sub add_command{
    my $model   = shift;

    my $uri = shift;

    usage() unless $uri;

    my $parser = "rdf+xml";

    if( $uri !~ /^ftp:|http:/ ){
	unless( -f $uri ){
	    warn "file \"$uri\" does not exist\n";
	    return;
	}
	$uri = "file:$uri";
    }

    # turtle!
    $parser = "turtle" if $uri =~ /\.ttl$/i;

    $uri = new RDF::Redland::URI($uri);

    print $OUT "parsing with $parser\n";
    add_uri( $model, $uri, $parsers{$parser} );

}


sub reload_command{
    my $model   = shift;

    my $uri_text = shift;

    my $new_data = temp_model();
    my $uri = new RDF::Redland::URI( $uri_text );

    $parsers{'rdf+xml'}->parse_into_model( $uri, undef, $new_data );
    print "Loaded ".$new_data->size." statements.\n";

    if( $new_data->size ){
	$model->remove_context_statements( $uri );
	$model->add_statements( $new_data->as_stream, $uri );
	print "reload complete.\n";
    }else{
	print "Given URI was empty or couldn't load URI... ignoring.\n";
    }

}

sub expand_command{
    my $model   = shift;

    my ($results, $srch) = turtle_search( $model, join " ", @_ );

    my $stmt2 = $srch->[1];
    my $predicate2 = resolve_rel_ns( $stmt2->predicate->uri ) if $stmt2;

    my %expanded = ();
    foreach my $statement (@$results){
	my @seeAlsos = $model->targets( $statement->subject, 
					$uris{rdfs_seeAlso} );
	if( @seeAlsos ){
	    foreach my $seeAlso (@seeAlsos){
		my $uri_text = $seeAlso->uri->as_string;

		next if $expanded{$uri_text};
		
		$expanded{$uri_text} = 1;

		add_uri( $model, $seeAlso->uri, $parsers{"rdf+xml"} );
	    }
	}else{
	    warn "no seeAlso found for subject\n";
	}
    }

}

sub smush_command{
    my $model   = shift;

    my $ifpq = new RDF::Redland::Statement( undef, 
					    $uris{rdf_type}, 
					    RDF::Redland::Node->new_from_uri($ns{owl}->as_string."InverseFunctionalProperty") );

    my @ifps = $model->find_statements( $ifpq );
    foreach my $ifp ( @ifps ){

	print "smushing on ".$ifp->subject->uri->as_string."\n";

	smush_ifp( $model, $ifp );
	
    }

    warn "no IFP found in model\n" unless @ifps;


}

sub query_command{
    my $model   = shift;

    my $query_string = join " ", @_;

    my $ns;
    if( $query_string =~ s/using\s+(\w+\s+for\s+\<[^\>]+?\>\s*)+$//i ){
	$ns = "$1, $rdql_ns_prefixes";
    }else{
	$ns = $rdql_ns_prefixes;
    }

    $query_string = "$query_string USING $ns";

    print $query_string, "\n" if $verbose;
    my $query = new RDF::Redland::Query($query_string );

    my $results = $model->query_execute($query);

    if( $results->finished ){
	print "no results\n";
    }else{
	print $results->count, " result(s):\n";
    }

    while(!$results->finished) {
	for (my $i=0; $i < $results->bindings_count(); $i++) {

	    my $name  = $results->binding_name($i);
	    my $value = $results->binding_value($i);
	    next unless $value;
	    # ... do something with the results
	    output_text( "$name: ". pretty_node( $model, $value->clone ) );
	}
# 	foreach my $binding_name ($results->binding_names ){
# 	    my $value = $results->binding_value_by_name( $binding_name );
# 	    print $binding_name, ": ", pretty_node( $model, $value), "\n";
# 	}

	$results->next_result;
	output_text("");
    }
}

sub insert_command {
    my $model   = shift;

    my $ttl = join " ", @_;

    $ttl = $ttl_ns_prefix . "\n\n".$ttl;

    unless( $parsers{'turtle'} ){
	warn "no turtle parser\n";
	return;
    }

    my $m = eval{
	my $m = temp_model();

	$parsers{'turtle'}->
	    parse_string_into_model( $ttl, 
				     new RDF::Redland::URI( "user:" ), 
				     $m );
	return $m;
    };
    unless( $m ){

	warn "Statement not added: $@\n";
	return;
    }
    
    print $OUT "Inserting ".$m->size." statements...\n";

    $model->add_statements( $m->as_stream );

    $m = undef;

}

sub sync_command {
    my $model   = shift;

	warn "syncing model\n";
	$model->sync;

}

sub clean_xml_command{
    my $model   = shift;
    
    warn "cleaning xml:lang from IFPs\n";
    clean_xml_lang( $model, \@lang_neutral );

}

sub shell_command{
    my $model   = shift;

    shell( $model );

}

sub dump_command{
    my $model   = shift;

    my $stream;

    warn "dumping DB:\n";
    $stream=$model->as_stream;
    while(!$stream->end) {
	print $OUT "Statement: ",$stream->current->as_string,"\n";
	$stream->next;
    }
    $stream=undef;

    warn "done\n";

}

sub dump_queries_command{
    my $model   = shift;

    print Dumper \%queries;

}

sub define_command{
    my $model   = shift;

    my $query_string = join " ", @_;

    my ($prl_query, $rdql) = $query_string =~ /^\s*(.+)\s+(select.+)$/i;

    print "perl query: $prl_query\n";

    my( $query_name, $params ) = $prl_query =~ /^(\w+)\s+(?:with\s+(.+))$/i;

    print "query name: $query_name\nparams: $params\n";

    $queries{$query_name} = { params => [split /\,\s*/, $params], 
			      query  => $rdql };


}

sub write_command{
    my $model   = shift;

    my $filename = shift;

    write_out( $model, $filename );


}

sub contexts_command{
    my $model   = shift;

    foreach my $context ($model->contexts){
	print $OUT $context->as_string, "\n";
    }

}

sub search_command{
    my $model   = shift;

    my ($results, $srch) = turtle_search( $model, join " ", @_ );

    my $stmt2 = $srch->[1];
    my $predicate2 = resolve_rel_ns( $stmt2->predicate->uri ) if $stmt2;

    my $last_stmt;
    my %seen_subject;
    my @search_history;
    foreach my $statement ( @$results ){
	my $subject = $statement->subject;
	next if exists $seen_subject{ $subject->as_string };
	
	print_subject( $model, $subject, $predicate2 );

	$seen_subject{ $subject->as_string } = 1;
 	push @search_history, $statement;
    }
    add_history( \@search_history );

}

sub ttsmode_command{
    my $model   = shift;

    if( $features{'tts'} && $features{'tts'}->{provider} 
	eq "Festival::Client" ){

	$festival = new Festival::Client("localhost");
	$outmode = "speech";
	print $OUT "festival output enabled\n" if $festival;

    }

    if( $outmode ne "speech" ){
	print $OUT "no suitable text-to-speech could be found\n";
    }
}

sub verbose_command{
    my $model   = shift;


    if( @_ ){
	my $state = shift;
	$verbose = $state =~ /on|yes/i;
    }
    print $OUT "verbose is ".( $verbose ? "on" : "off" )."\n";


}

sub help_command{
    my $model   = shift;

    my $cmd = shift;

    my @listcommands = ( $cmd );

    if( !$cmd ){
	@listcommands = sort keys %commands;

	print $OUT "available commands: \n";
    }

    foreach my $command ( @listcommands ){
	my $desc;
	my $usage;

	if( exists $command_meta{ $command } ){

	    $desc = $command_meta{ $command }->{description};

	    if( exists $command_meta{ $command }->{usage} ){
		$usage = "\n\tusage: \n\t\t".
		    join "\n\t\t", @{$command_meta{ $command }->{usage}};
	    }
	}
	print $OUT "$command\t$desc$usage\n";

    }
}





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

sub process_query{
    my $command = shift;
    my $model   = shift;

    my $query_string = $queries{ $command }->{query};

    foreach my $param (@{$queries{ $command }->{params}}){
	my $param_val = shift;

	$query_string =~ s/(?<![\\])\$$param\b/$param_val/g;
    }

    my $ns;
    if( $query_string =~ s/using\s+(\w+\s+for\s+\<[^\>]+?\>\s*)+$//i ){
	$ns = "$1, $rdql_ns_prefixes";
    }else{
	$ns = $rdql_ns_prefixes;
    }

    $query_string = "$query_string using $ns";


    print "query: $query_string\n" if $verbose;
    my $query = new RDF::Redland::Query($query_string);
    my $results = $model->query_execute($query);
    print $results->count(), " result(s):\n";

    while(!$results->finished) {
	for (my $i=0; $i < $results->bindings_count(); $i++) {

	    my $name  = $results->binding_name($i);
	    my $value = $results->binding_value($i);
	    warn "$name has no value" unless $value;
	    next unless $value;
	    # ... do something with the results
	    output_text( "$name: ". pretty_node( $model, $value ) );
	}

	$results->next_result;
	output_text("--");
	output_text("");
    }
}

sub load_queries{
    my $model = shift;

    print "loading queries\n" if $verbose;
    my $q = new RDF::Redland::Statement( undef, 
					 $uris{'rdf_type'}, 
					 $ns{radishq}->as_string."Query" );

    for( my $s = $model->find_statements( $q ); !$s->end; $s->next ){

	print "found a query...\n" if $verbose;
	my $name = $model->target( $s->current->subject, 
				   new_from_uri RDF::Redland::Node( $ns{radishq}->
							   as_string."name" ) );
	warn "query is missing a name" unless $name;
	next unless $name;
	$name = $name->literal_value;

	$queries{$name} = {};

	my $rdql = $model->target( $s->current->subject, 
				   new_from_uri RDF::Redland::Node( $ns{radishq}->
							   as_string."rdql" ) );
	warn "query is missing an rdql" unless $rdql;
	next unless $rdql;
	$rdql = $rdql->literal_value;

	# load it all into the query hash for caching
	$queries{$name}->{query} = $rdql;
	@{$queries{$name}->{params}} = ();

	for( my $params = 
	     $model->
	     targets_iterator( $s->current->subject, 
			      new_from_uri 
			      RDF::Redland::Node( $ns{radishq}->
						  as_string."parameter" ) );
	     !$params->end;
	     $params->next ){
	    
	    push @{$queries{$name}->{params}}, $params->current->literal_value;
	}

	output_text( "$name is $rdql" );
    }


}

sub process_commands{
    my $model = shift;
    my $command = shift;

    if( exists $commands{ $command } ){
	&{$commands{ $command }}( $model, @_ );

    }elsif( exists $queries{ $command } ){
	process_query( $command, $model, @_ );
    }else{

	if( $interactive ){
	    warn "unknown command: $command\n" if $command;
	}else{
	    usage();
	}

    }
}

sub add_history{
    my ($node) = @_;


    $history = [] unless $history;
    push @$history, $node;

    pop @$history if @$history >= 10;
}

# returns the statement stored in the history,
# input values are offsets - command followed by results
sub get_history{
    my ( $num1, $num2 ) = @_;
    my $retval;

    # a nice default
    my $num1 = 0 unless $num1;
    my $num2 = 0 unless $num2;

    $retval = $history->[$#$history - $num1];
    $retval = $retval->[$#$retval - $num2] if ref $retval eq "ARRAY";

    return $retval;
}

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


# makes a temporary model object
sub temp_model{

   # temporary model...
    my $s = new RDF::Redland::Storage( "hashes", "temp", 
				       "new='yes',contexts='yes',hash-type='memory'" );
    my $m = new RDF::Redland::Model ($s);

    return $m;
}

# input: uri object
sub add_uri{
    my ($model, $uri, $parser) = @_;

    my $m = temp_model();
 
    warn "Loading from URI \"".$uri->as_string."\"...\n";

    $parser->parse_into_model( $uri, undef, $m );

    print $OUT "Loaded ", $m->size, " statements into model.\n";

    if( $m->size > 0 ){

# 	warn "cleaning xml language tags on IFPs\n";
# 	clean_xml_lang( $m, \@lang_neutral );

	clean_xml_lang( $m );

	warn "cleaning out old statements\n";
	$model->remove_context_statements( $uri );
	warn "adding new statements\n";
	$model->add_statements( $m->as_stream, $uri );
	
    }else{
	warn "didn't load anything, not adding\n";
    }
    $m = undef;
}

sub dedupe_ifp{
    my( $model, $ifp ) = @_;

    # this is going to be the one that everything is put under
    my $canonical;
    my $canonical_context;

    my $duplicates = 0;

    # removals of the IFPs it finds
    my $dupe_ifp_removals = temp_model();

    # duplicate query
    my $dupeq = new RDF::Redland::Statement( undef, 
					     $ifp->predicate->clone,
					     $ifp->object->clone );

    # go through each item in the model that has the given IFP. 
    # rip out their content and put it under the canonical's subject, 
    # just preserving the context of the query
    for( my $stream = $model->find_statements( $dupeq );
	 $stream && !$stream->end; 
	 $stream->next ){
	my $dupe = $stream->current;

	unless( $canonical ){
	    $canonical = $dupe;
	    next;
	}

	next if $canonical->equals( $dupe );

# 	print $dupe->subject->as_string . " -> " . 
# 	    $canonical->subject->as_string . "\n";

	my $additions = temp_model();
	my $removals  = temp_model();

	my $dupe_stmtq = new RDF::Redland::Statement( $dupe->subject, 
						      undef, undef );

	for( my $stream2 = $model->find_statements( $dupe_stmtq );
	     $stream2 && !$stream2->end; 
	     $stream2->next ){

	    my $stmt = $stream2->current;

	    my $new_stmt = new 
		RDF::Redland::Statement( $canonical->subject->clone, 
					 $stmt->predicate->clone,
					 $stmt->object->clone );

	    $additions->add_statement( $new_stmt, $stream2->context )
 		unless ($stmt->predicate->equals($dupe->predicate) &&
 			$stmt->object->equals($dupe->object));
#		unless $additions->contains_statement( $new_stmt );

	    $removals->add_statement( $stmt, $stream2->context );
	}

	# now clean up links to the duplicate
	$dupe_stmtq = new RDF::Redland::Statement( undef, 
						   undef, 
						   $dupe->subject );

	for( my $stream2 = $model->find_statements( $dupe_stmtq );
	     $stream2 && !$stream2->end; 
	     $stream2->next ){

	    my $stmt = $stream2->current;

	    $additions->add( $stmt->subject->clone,
			     $stmt->predicate->clone,
			     $canonical->subject->clone,
			     $stream2->context );

	    # add for removal
	    $removals->add_statement( $stmt, $stream2->context );
	}

 	print $OUT "there were ".$additions->size." additions and ".$removals->size." removals.\n";
# 	# perform the additions and removals
	$model->add_statements( $additions->as_stream );

	my $stream2 = $additions->as_stream;
	while( $stream2 && !$stream2->end ){
	    print "adding ".$stream2->current->as_string."...\n";
	    $stream2->next;
	}

# 	# now go about deleting the duplicates...
	for( my $stream2 = $removals->as_stream; 
	     $stream2 && !$stream2->end;
	     $stream2->next ){
	    print "removing ".$stream2->current->as_string."...\n";
	    $model->remove_statement($stream2->current, $stream2->context);
	}

	$dupe_ifp_removals->add_statement( $dupe, $stream->context );

	$duplicates++;
    }

    for( my $stream2 = $dupe_ifp_removals->as_stream; 
	 $stream2 && !$stream2->end;
	 $stream2->next ){
	print "removing ".$stream2->current->as_string."...\n";
	$model->remove_statement($stream2->current, $stream2->context);
    }

    return $duplicates;
}

=head2 smush_ifp($model,$ifp)

Smushes the data on the given inverse function property (IFP).

=cut
sub smush_ifp{
    my( $model, $ifp ) = @_;

    my $test = 0;

    my $ifpq = new RDF::Redland::Statement( undef, $ifp->subject, undef );

    my $any_dupes;
    do{
	$any_dupes = 0;

	for( my $stream = $model->find_statements( $ifpq );
	     $stream && !$stream->end; 
	     $stream->next ){

	    if( dedupe_ifp( $model, $stream->current ) ){
		$any_dupes = 1;

		# you do this, so it starts out clean after every smush
		print $OUT "there were duplicates. restarting.\n";
		last;
	    }
	}
    }while( $any_dupes );
}

# removes XML language information from IFPs that aren't an rdf:resource
sub clean_xml_lang{
    my( $model, $preds ) = @_;

    # clean all of them if no predicate is specified
    $preds = ["all"] unless $preds;

    if( @$preds[0] eq "all" ){
	print $OUT "cleaning all XML lang\n";
    }else{
	print $OUT "cleaning XML lang on IFPs\n";
    }
    # preds is a list of predicates that should be stripped
    foreach my $predicate ( @$preds ){

	my $removals = temp_model();
	my $additions = temp_model();

	# let all of them be cleaned
	$predicate = undef if $predicate == "all";

	my $srch_stmt = new RDF::Redland::Statement( undef, 
						     $predicate,
						     undef );
	print $OUT $predicate->as_string if $predicate;
	for( my $stream = $model->find_statements( $srch_stmt );
	     $stream && !$stream->end; 
	     $stream->next ){

	    my $statement = $stream->current;
	    # ignore non-literals
	    next unless $statement->object->is_literal;
	    # ignore cleaned ones
	    next unless $statement->object->literal_value_language;

	    # strip the XML language
	    my $stripped_obj = RDF::Redland::Node->new_literal( $statement->
						       object->literal_value );

	    my $new_stmt = new RDF::Redland::Statement( $statement->subject, 
							$statement->predicate,
							$stripped_obj );
#	    print "adding: ".$new_stmt->as_string."\n";
	    # put the new statement in
	    $additions->add_statement( $new_stmt, $stream->context );

	    # add for deletion
	    $removals->add_statement( $statement->clone, $stream->context );
	    print $OUT ".";
	}
	print $OUT "\n";

	for( my $stream = $additions->as_stream;
	     $stream && !$stream->end; 
	     $stream->next ){
	    print "add: ", $stream->current->as_string(), "\n" if $verbose;
	}

	for( my $stream = $removals->as_stream;
	     $stream && !$stream->end; 
	     $stream->next ){
	    print "remove: ", $stream->current->as_string(), "\n" if $verbose;
	}

	$model->add_statements( $additions->as_stream );
	# remove statements...
	my $stream = $removals->as_stream;
	while( $stream && !$stream->end ){
	    $model->remove_statement( $stream->current, $stream->context );
	    $stream->next;
	}
	$stream = undef;
    }
}


sub shell{
    my( $model ) = @_;

    $interactive = 1;
    my $term = new Term::ReadLine 'RDF database';
    my $attribs = $term->Attribs;
    $attribs->{completion_entry_function} =
	$attribs->{list_completion_function};
    $attribs->{completion_word} =
	[map { $_ = $_ . ":" } keys %ns];
    my $prompt = "radish> ";
    $OUT = $term->OUT || \*STDOUT;

    while ( defined ($_ = $term->readline($prompt)) ) {
	my @args = split /\s/;
	print "\n";
	process_commands( $model, @args );


	$term->addhistory($_) if /\S/;
    }
}

sub turtle_preprocessor{

    my( $command ) = @_;

    unless(exists $parsers{'turtle'}){
	warn "need a turtle parser for argument parsing\n";
	return;
    }
    if( $command =~ /(?:^|(?<=\s))\!(?:(\d+)(?:,(\d+))?)?/ ){
	my $hist_stmt = get_history($1,$2);
	$hist_stmt = $hist_stmt->subject->as_string if ref $hist_stmt;
	$command =~ s/(?:^|(?<=\s))\!(?:(\d+)(?:,(\d+))?)?/$hist_stmt/;
    }

    my $q = $uris{radish_question}->uri->as_string;
    $command =~ s/(?:^|(?<=\s))\?(?:(?=[;,\.\s])|$)/<$q>/g;

    # put quotes around anything that looks like a literal
    if( $command !~ /\".+\"/ ){
	$command =~ s/(?:^|(?<=\s))(?<!:)(\w+)(?!:)(?:(?=[;,\.\s])|$)/"$1"/g;
    }
    $command = "[$command]." unless $command =~ /\[[^\]]+\]/;

    $command = $ttl_ns_prefix . "\n\n".$command;

    print "turtle query: ".$command, "\n" if $verbose;
    my $retval = eval{
	return $parsers{'turtle'}->parse_string_as_stream( $command, 
							   new RDF::Redland::URI( "user:" ));
    };
    if($retval){
	return $retval;
    }else{
	warn "Parse error: $@\n";
	return;
    }
}


sub get_name{
    my( $model, $subject ) = @_;

    my $n;

    $n = $model->target( $subject, $uris{foaf_name});
    $n = $n->literal_value if $n;

    unless( $n ){
	$n = $model->target( $subject, $uris{foaf_nick});
	$n = $n->literal_value if $n;
    }

    unless( $n ){
	$n = $model->target( $subject, $uris{dc_title});
	$n = $n->literal_value if $n;
    }

    unless( $n ){
	$n = $model->target( $subject, $uris{rdfs_label});
	$n = $n->literal_value if $n;
    }

    $n = $subject->as_string unless $n;

    $n .= " \"".$subject->as_string."\"" if $verbose;
    return $n; 
}

sub rdql_abbv_search{
    my( $model, $search_stmt ) = @_;

    my $rdql = $rdqlabbv->parse( $search_stmt )." USING ".$rdql_ns_prefixes;

    print "$rdql\n" if $verbose;

    my $query = new RDF::Redland::Query( $rdql );
    my $results = $model->query_execute( $query );


    if( $results->finished ){
	print "no results\n";
    }else{
	print $results->count, " result(s):\n";
    }

    while(!$results->finished) {
	for (my $i=0; $i < $results->bindings_count(); $i++) {

	    my $name  = $results->binding_name($i);
	    my $value = $results->binding_value($i);
	    next unless $value;
	    # ... do something with the results
	    output_text( "$name: ". pretty_node( $model, $value->clone ) );
	}
# 	foreach my $binding_name ($results->binding_names ){
# 	    my $value = $results->binding_value_by_name( $binding_name );
# 	    print $binding_name, ": ", pretty_node( $model, $value), "\n";
# 	}

	$results->next_result;
	output_text("");
    }
}



# given one or more search statements, performs a search and returns
# an array ref to the results, and an array ref of the parsed input
# statements
#
# retval: ( \@results, \@statements )
sub turtle_search{
    my( $model, $search_stmt ) = @_;

    my $s = turtle_preprocessor( $search_stmt );
    unless($s){
	warn "unable to perform search\n";
	return;
    }
    warn "no parameters specified for expand\n" if !$s or $s->end;

    my @statements;
    for( ; !$s->end; $s->next ){
	push @statements, $s->current;
    }

    @statements = reverse @statements;

    my $stmt = $statements[0];

    # make a new search query statement. the questions are replaced with
    # undefs

    my $object = ( $stmt->object->is_resource &&
		   $stmt->object->uri->equals( $uris{radish_question}->uri )
		   ? undef : $stmt->object);

    my $predicate = ( $stmt->predicate->is_resource &&
		   $stmt->predicate->uri->equals( $uris{radish_question}->uri )
		   ? undef : $stmt->predicate);

    my $stmt = new RDF::Redland::Statement( undef, 
					    $predicate, 
					    $object );
    # clear contexts
#     $contexts = undef unless $stmt->subject;

    my $stmt2  = $statements[1];

    print "search stmt1: ".$stmt->as_string."\n" if $stmt;
    print "search stmt2: ".$stmt2->as_string."\n" if $stmt2;

    my @results;
    my $contexts;
    push @$contexts, $stmt unless $contexts;

    foreach my $context ( @$contexts ){
	if( !$context->object || $context->object->is_literal ){
	    push @results, regexp_search( $model, $context );
	}elsif( $context->object->is_resource ){
	    push @results, resource_search( $model, $context );
	}
    }

    $contexts = [];

    return \@results, \@statements;
}

sub regexp_search{ 
    my( $model, $search_stmt ) = @_;

    my $s_pred = $search_stmt->predicate->uri if $search_stmt->predicate;
    $search_stmt->predicate(RDF::Redland::Node->new_from_uri(resolve_rel_ns( $s_pred )));

    my @results;

#    print "searching...\n";

    # clear it for the search
    my $objtext = $search_stmt->object->literal_value
	if $search_stmt->object;

    my $search = new RDF::Redland::Statement( $search_stmt->subject, 
					      $search_stmt->predicate, undef );

#    print "looking for \"$objtext\" in ".$search->as_string."\n";

    my $stream = $model->find_statements( $search );

    while(!$stream->end) {
	my $statement2 = $stream->current;

	if( !$objtext || ( $statement2->object->is_literal 
		       && $statement2->object->literal_value =~ /$objtext/i ) ){

# 		my $subject = $statement2->subject;

	    push @results, $statement2;
	}
	$stream->next;

    }
    $stream = undef;
    $search_stmt = undef;

    return @results;
}

sub resource_search{ 
    my( $model, $search_stmt ) = @_;

    my $s_pred = $search_stmt->predicate->uri if $search_stmt->predicate;
    $search_stmt->predicate(RDF::Redland::Node->new_from_uri(resolve_rel_ns( $s_pred )));

    my @results;

#    print "searching...\n";

    # clear it for the search
#     my $objtext = $search_stmt->object->literal_value
# 	if $search_stmt->object;

    my $search = new RDF::Redland::Statement( $search_stmt->subject, 
					      $search_stmt->predicate, 
					      $search_stmt->object );

#    print "looking for \"$objtext\" in ".$search->as_string."\n";

    my $stream = $model->find_statements( $search );

    while(!$stream->end) {
	my $statement2 = $stream->current;

# 	if( !$objtext || ( $statement2->object->is_literal 
# 		       && $statement2->object->literal_value =~ /$objtext/i ) ){

# 		my $subject = $statement2->subject;

	    push @results, $statement2;
# 	}
	$stream->next;

    }
    $stream = undef;
    $search_stmt = undef;

    return @results;
}


# returns a URI given an abbreviated namespace
sub resolve_rel_ns{
    my( $rel ) = @_;

    if( ref $rel eq "RDF::Redland::URI" ){
	$rel = $rel->as_string;
    }
    my $uri;
    if( my ($prefix, $suffix) = $rel =~ /^(\w+):(\w+)$/ ){
	unless( exists $ns{$prefix}){
	    warn "unknown prefix \"$prefix\"\n";
	}

	$uri = new RDF::Redland::URI($ns{$prefix}->as_string.$suffix);

    }elsif( !$rel || $rel eq '*' ){
	$uri = undef;
    }else{
	$uri = new RDF::Redland::URI($rel);
    }

    return $uri;
}

sub pretty_node{
    my( $model, $node ) = @_;

    if( $node->is_resource ){
	return english_uri( $model, $node->uri );

    }elsif( $node->is_literal ){
	return $node->literal_value;

    }else{
	return $node->as_string;
    }
}

sub english_uri{
    my( $model, $uri ) = @_;

    return $uri->as_string if $verbose;

    my $urieng;

    $urieng = $model->target( RDF::Redland::Node->new_from_uri($uri), 
			      $uris{rdfs_label} );

    if( $urieng ) {
	$urieng = $urieng->literal_value;
    }else{
	$urieng = $uri->as_string;
    }

    return $urieng;

}

sub output_statement{
    my( $model, $statement, $context ) = @_;
    
    my $out;
    if( $outmode eq "screen" ){
	if( $statement->object->is_literal ){
	    $out = english_uri($model, $statement->predicate->uri). 
		": ". $statement->object->literal_value;

	}elsif( $statement->object->is_resource ){
	    $out = english_uri($model, $statement->predicate->uri).
		": <". $statement->object->uri->as_string. ">";

	}elsif( $statement->object->is_blank ){
	    $out = english_uri( $model, $statement->predicate->uri).
		": ".get_name($model, $statement->object);
	}else{

	}
	$out .= " (".$context->as_string.")" if ($verbose && $context);

	output_text($out);
    }elsif( $outmode eq "speech" && $festival ){
	if( $statement->object->is_literal ){
	    output_text( english_uri($model, $statement->predicate->uri) ." is ". 
			    $statement->object->literal_value );

	}elsif( $statement->object->is_resource ){
#	    output_text( english_uri($model, $statement->predicate->uri) ." is a URI.");

#	    print $OUT english_uri($model, $statement->predicate->uri),
#	    ": <", $statement->object->uri->as_string, ">\n";

	}else{
# 	    print $OUT $statement->predicate->as_string, 
# 	    ": ", $statement->object->as_string, "\n";
	}
	
    }else{
	warn "unknown output mode: \"$outmode\"\n";
    }
}

sub output_text{
    my( $text )  = @_;

    if( $outmode eq "screen" ){

	print $OUT $text, "\n";

    }elsif( $outmode eq "speech" ){

	$festival->say( $text."\n" );
    }
}

sub print_subject{
    my ( $model, $subject, $predicate ) = @_;

    my $search = new RDF::Redland::Statement($subject, $predicate, undef);
    my $stream = $model->find_statements($search);

    my $found = temp_model();
    for(; !$stream->end; $stream->next) {
	my $statement2 = $stream->current;
	my $subject2 = $statement2->subject;

	    next if !$verbose 
		&& ($statement2->predicate->uri->equals($uris{rdf_type}->uri)
		    ||
		    $statement2->predicate->uri->equals($uris{dc_title}->uri)
		    );
	$found->add_statement( $statement2, $stream->context );
	#push @found, $statement2;
    }
    $stream = undef;
    $search = undef;

    if( $found->size ){
	my $name = get_name( $model, $subject );

	my @types = $model->targets( $subject, 
				   $uris{rdf_type} );

	if( @types ){
	    output_text( colored( "$name is a ". join(" and a ", 
					   map {english_uri($model, $_->uri)} @types).":", "bold"));
	    @types = undef;
	}else{
	    print $OUT colored( "$name:\n", "bold");
	}

	print $OUT "-" x 20, "\n";

	for( my $stream = $found->as_stream; !$stream->end;
	     $stream->next){
	    output_statement( $model, $stream->current, $stream->context );
	}
	
	print $OUT ( '#' x 50 )."\n\n";
    }
}

sub write_out{
    my( $model, $filename ) = @_;

    # Use any rdf/xml parser that is available
    my $serializer = new RDF::Redland::Serializer("rdfxml");
    die "Failed to find serializer\n" if !$serializer;

    $serializer->serialize_model_to_file($filename, undef, $model);
    $serializer = undef;

}


sub usage(){
    die <<USAGE;
usage: $0 [options] command [command options]
 
commands:
    shell       an interactive shell for the below commands
    add URI     adds the given URI or filename to the database
    search P [L [P2]]
                searches for predicate P with a literal value that matches
		regexp L and displays associated information
    dump        dumps out the database as text
    write FILE  writes database to FILE

predicate namespace abbvs:
    dc          dublin core
    foaf        friend-of-a-friend
    rdf         RDF
    rdfs        RDF Schema
    geo         lat/lon geo

options:
    -h          this help
    -v          more verbose output
    -V          print version information

Copyright(C) 2004 Steve Pomeroy <steve\@staticfree.info>
Licensed under the GNU GPL. See documentation for complete details.
USAGE

}

__END__