#!/usr/bin/perl
use strict;
use warnings;
no warnings 'redefine';
use lib qw(../lib lib);
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 = memory_model();
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