#!/usr/bin/perl
use strict;
use warnings;
no warnings 'redefine';

use Cwd;
use Benchmark;
use Scalar::Util qw(blessed);
use Data::Dumper;
use RDF::Query;
use RDF::Query::Error qw(:try);
use RDF::Query::Util;
use Term::ReadLine;
use Term::ReadKey;
use LWP::Simple;
use LWP::MediaTypes qw(add_type);

################################################################################
# Log::Log4perl::init( \q[
# 	log4perl.category.rdf.query.plan				= DEBUG, Screen
# 	log4perl.appender.Screen						= Log::Log4perl::Appender::Screen
# 	log4perl.appender.Screen.stderr					= 0
# 	log4perl.appender.Screen.layout					= Log::Log4perl::Layout::SimpleLayout
# ] );
################################################################################

add_type( 'application/rdf+xml' => qw(rdf xrdf rdfx) );
add_type( 'text/turtle' => qw(ttl) );
add_type( 'text/plain' => qw(nt) );
add_type( 'text/x-nquads' => qw(nq) );
add_type( 'text/json' => qw(json) );
add_type( 'text/html' => qw(html xhtml htm) );

$|			= 1;
my $model;
if (scalar(@ARGV) and $ARGV[ $#ARGV ] =~ /.sqlite/) {
	my $file	= pop(@ARGV);
	my $dsn		= "DBI:SQLite:dbname=" . $file;
	my $store	= RDF::Trine::Store::DBI->new($model, $dsn, '', '');
	$model		= RDF::Trine::Model->new( $store );
} else {
	$model			= memory_model();
}
my %args	= &RDF::Query::Util::cli_parse_args();
unless (exists $args{update}) {
	$args{update}	= 1;
}
$args{ base }	= 'file://' . getcwd . '/';

my $NAMESPACES	= $RDF::Query::Util::PREFIXES;
my $vb_format	= 'table';
my $def_format	= 'ntriples';
my $serializer	= RDF::Trine::Serializer->new($def_format);
my %serializer	= ($def_format => $serializer);
my $class	= delete $args{ class } || 'RDF::Query';
my $term	= Term::ReadLine->new('rqsh', \*STDIN, \*STDOUT);

print "rqsh v1.0, RDF::Query v${RDF::Query::VERSION}\n\n";
while ( defined ($_ = $term->readline('rqsh> ')) ) {
	my $line	= $_;
	next unless (length($line));
	handle_cmd( $line );
}

sub handle_cmd {
	my $line	= shift;
	if ($line =~ /help/i) {
		help();
	} elsif ($line =~ /^set (prefix (\w+): <([^>]+)>)/i) {
		my $query	= RDF::Query->new( "$1                              SELECT * WHERE {}" );
		if ($query) {
			$NAMESPACES	.= "PREFIX $2: <$3>\n";
		} else {
			warn RDF::Query->error;
		}
	} elsif ($line =~ /^time (.*)/i) {
		timethis( 1, sub {
			handle_cmd( $1 );
		} );
	} elsif ($line =~ /^explain (.*)$/i) {
		explain($model, $term, $1);
	} elsif ($line =~ /^parse (.*)$/i) {
		parse($model, $term, $1);
	} elsif ($line =~ /^use (\w+)\s*;?\s*$/i) {
		my $name	= $1;
		my $nmodel	= model( $name );
		if ($nmodel) {
			$model	= $nmodel;
		}
	} elsif ($line =~ /init/i) {
		init( $model, $term, $line );
	} elsif ($line =~ m/^results (table|srx)$/i) {
		$vb_format	= lc($1);
	} elsif ($line =~ m/^serializer (\w+)$/i) {
		if (exists($serializer{ $1 })) {
			$serializer	= $serializer{ $1 };
		} else {
			my $ser;
			try {
				$ser	= RDF::Trine::Serializer->new( $1 );
			} catch RDF::Trine::Error::SerializationError with {};
			if ($ser) {
				$serializer{ $1 }	= $ser;
				$serializer			= $ser;
			} else {
				print "Unrecognized serializer name '$1'\n";
				print "Valid serializers are:\n";
				foreach my $name (RDF::Trine::Serializer->serializer_names) {
					print "    $name\n";
				}
				print "\n";
			}
		}
	} elsif ($line =~ /debug/i) {
		debug( $model, $term, $line );
	} elsif ($line =~ /^execute <([^>]+)>$/) {
		my $url		= URI->new_abs( $1, $args{ base } );
		my $query	= get( $url );
		query( $model, $term, $query );
	} else {
		query( $model, $term, $line );
	}
}

sub help {
	print <<"END";
Commands:
    help                   Show this help information.
    use [backend]          Switch the storage backend (e.g. "use mysql").
    init                   Initialize the storage backend (creating necessary indexes, etc.).
    set prefix [ns]: [uri] Set a namespace for use in subsequent queries.
    results (table|srx)    Set the serializer used for tabular variable binding results.
    serializer [format]    Set the serializer used for RDF results (e.g. "serializer turtle").
    debug                  Print all the quads in the storage backend.
    parse [sparql]         Print the parsed algebra for the SPARQL 1.1 query/update.
    explain [sparql]       Explain the execution plan for the SPARQL 1.1 query/update.
    time [command]         Time the execution of the command.
    execute <URI>          Execute the SPARQL update/query obtained by dereferencing URI.
    SELECT ...             Execute the SPARQL 1.1 query.
    ASK ...                Execute the SPARQL 1.1 query.
    CONSTRUCT ...          Execute the SPARQL 1.1 query.
    DESCRIBE ...           Execute the SPARQL 1.1 query.
    INSERT ...             Execute the SPARQL 1.1 update.
    DELETE ...             Execute the SPARQL 1.1 update.
    LOAD <uri>             Execute the SPARQL 1.1 update.
    CLEAR ...              Execute the SPARQL 1.1 update.
    COPY ...               Execute the SPARQL 1.1 update.
    MOVE ...               Execute the SPARQL 1.1 update.

END
}

sub init {
	my $model	= shift;
	my $term	= shift;
	my $line	= shift;
	if (my $store = $model->_store) {
		$store->init;
	}
}

sub model {
	my $name	= shift;
	my $sclass	= RDF::Trine::Store->class_by_name( $name );
	if ($sclass) {
		if ($sclass eq 'RDF::Trine::Store::Memory') {
			$model	= RDF::Trine::Model->new( RDF::Trine::Store::Memory->new );
			return;
		} else {
			if ($sclass->can('_config_meta')) {
				my $meta	= $sclass->_config_meta;
				my $keys	= $meta->{required_keys};
				my $config	= { storeclass => $sclass };
				foreach my $k (@$keys) {
					get_value( $term, $meta, $k, $config );
				}
				my $store	= eval { $sclass->new_with_config( $config ) };
				if ($store) {
					my $m		= RDF::Trine::Model->new( $store );
					if ($m) {
						return $m;
					}
				}
				print "Failed to construct '$name'-backed model. $@\n";
				return;
			} else {
				print "Cannot construct model from '$name' storage class.\n";
			}
		}
	} else {
		print "No storage class named '$name' found\n";
		return;
	}
}

sub explain {
	my $model	= shift;
	my $term	= shift;
	my $sparql	= shift;
	my $psparql	= join("\n", $NAMESPACES, $sparql);
	my $query	= $class->new( $psparql, \%args );
	unless ($query) {
		print "Error: " . RDF::Query->error . "\n";
		return;
	}
	my ($plan, $ctx)	= $query->prepare( $model );
	print $plan->explain('  ', 0);
}

sub parse {
	my $model	= shift;
	my $term	= shift;
	my $sparql	= shift;
	my $psparql	= join("\n", $NAMESPACES, $sparql);
	my $query	= $class->new( $psparql, \%args );
	unless ($query) {
		print "Error: " . RDF::Query->error . "\n";
		return;
	}
	my $pattern	= $query->pattern;
	print $pattern->sse . "\n";
}

sub query {
	my $model	= shift;
	my $term	= shift;
	my $sparql	= shift;
	
	my $psparql;
	if ($sparql =~ /^BASE <([^>]+)>/i) {
		$sparql	=~ s/^BASE <([^>]+)>/BASE <$1>\n$NAMESPACES/;
		$psparql	= $sparql;
	} else {
		$psparql	= join("\n", $NAMESPACES, $sparql);
	}
	
	my $query	= $class->new( $psparql, \%args );
	unless ($query) {
		print "Error: " . RDF::Query->error . "\n";
		return;
	}
	$term->addhistory($sparql);
	try {
		my ($plan, $ctx)	= $query->prepare($model);
		my $iter	= $query->execute_plan( $plan, $ctx );
		my $count	= -1;
		if (blessed($iter)) {
			if ($iter->isa('RDF::Trine::Iterator::Graph')) {
				$serializer->serialize_iterator_to_file( $term->OUT, $iter );
			} else {
				if ($vb_format eq 'srx') {
					print $iter->as_xml( 0 );
				} else {
					print $iter->as_string( 0, \$count );
				}
			}
		}
		if ($plan->is_update) {
			my $size	= $model->size;
			print "$size statements\n";
		} elsif ($count >= 0) {
			print "$count results\n";
		}
	} catch RDF::Query::Error with {
		my $e	= shift;
		print "Error: $e\n";
	} otherwise {
		warn "died: " . Dumper(\@_);
	};
}

sub debug {
	my $model	= shift;
	my $term	= shift;
	my $line	= shift;
	print "# model = $model\n";
	if (my $store = $model->_store) {
		print "# store = $store\n";
	}
	my $iter	= $model->get_statements( undef, undef, undef, undef );
	my @rows;
	my @names	= qw[subject predicate object context];
	while (my $row = $iter->next) {
		push(@rows, [map {$row->$_()->as_string} @names]);
	}
	my @rule			= qw(- +);
	my @headers			= (\q"| ");
	push(@headers, map { $_ => \q" | " } @names);
	pop	@headers;
	push @headers => (\q" |");
	my $table = Text::Table->new(@names);
	$table->rule(@rule);
	$table->body_rule(@rule);
	$table->load(@rows);
	print join('',
			$table->rule(@rule),
			$table->title,
			$table->rule(@rule),
			map({ $table->body($_) } 0 .. @rows),
			$table->rule(@rule)
		);
	my $size	= scalar(@rows);
	print "$size statements\n";
}

sub get_value {
	my $term	= shift;
	my $meta	= shift;
	my $k		= shift;
	my $config	= shift;
	if (my $v = $config->{$k}) {
		return;
	} elsif (defined($meta->{fields}{$k}{'value'})) {
		$config->{ $k }	= $meta->{fields}{$k}{'value'};
	} elsif (defined($meta->{fields}{$k}{'template'})) {
		my $template	= $meta->{fields}{$k}{'template'};
		my @subkeys	= ($template =~ m/\[%(\w+)%\]/g);
		foreach my $sk (@subkeys) {
			get_value( $term, $meta, $sk, $config );
		}
		while ($template =~ m/\[%(\w+)%\]/) {
			my $key	= $1;
			my $v	= $config->{$key};
			$template	=~ s/\[%$key%\]/$v/e;
		}
		$config->{ $k }	= $template;
	} else {
		my $desc	= $meta->{fields}{$k}{description};
		my $type	= $meta->{fields}{$k}{type};
		my $value;
		if ($type eq 'password') {
			print "$desc: ";
			ReadMode('noecho');
			$value	= ReadLine(0, $term->IN);
			chomp($value);
		} elsif ($type eq 'filename') {
			my $attribs	= $term->Attribs;
			local($attribs->{completion_entry_function})	= $attribs->{filename_completion_function};
			$value	= $term->readline("$desc: ");
		} else {
			$value = $term->readline("$desc: ")
		}
		$config->{ $k }	= $value;
	}
}

{ my $memory_model;
sub memory_model {
	if (defined($memory_model)) {
		return $memory_model;
	} else {
		my $model			= RDF::Trine::Model->temporary_model;
		$memory_model	= $model;
		return $model;
	}
}}

__END__

=head1 NAME

rqsh - SPARQL database shell

=head1 DESCRIPTION

rqsh provides a command-line interface to the SPARQL 1.1 implementation of
RDF::Query. It defaults to using an in-memory database, but can be configured
to use any database implemented as an L<RDF::Trine::Store>.

=head1 COMMANDS

=over 4

=item help

Show help information on available commands.

=item use [backend]

Switch the storage backend (e.g. "use mysql").
You will be prompted to enter any necessary connection/configuration data.

=item init

Initialize the storage backend (creating necessary indexes, etc.).

=item set prefix [ns]: [uri]

Set a namespace for use in subsequent queries.

=item results (table|srx)

Set the serializer used for tabular variable binding results.

=item serializer [format]

Set the serializer used for RDF results (e.g. "serializer turtle").

=item debug

Print all the quads in the storage backend.

=item parse [sparql]

Print the parsed algebra for the SPARQL 1.1 query/update.

=item explain [sparql]

Print the execution plan for the SPARQL 1.1 query/update.

=item time [command]

Time the execution of the command.

=item execute <URI>

Execute the SPARQL update/query obtained by dereferencing URI.

=item SELECT ...

=item ASK ...

=item CONSTRUCT ...

=item DESCRIBE ...

Execute the SPARQL 1.1 query.

=item INSERT ...

=item DELETE ...

=item LOAD <uri>

=item CLEAR ...

=item COPY ...

=item MOVE ...

Execute the SPARQL 1.1 update.

=back

=cut