#!/usr/bin/perl -l

use strict;
use warnings;
use File::Spec;
use Data::Dumper;
use RDF::Redland;

our @REDLAND_STORAGE	= ("mysql", 'db1', qq(host='localhost',database='greg',user='greg','password='password'));

=head1 NAME

rls - Utility to list nodes and statements in a Redland RDF store

=head1 SYNOPSYS

 rls URI
 rls '[URI]'
 rls '(bnode id)'
 rls '"literal"'
 
 rls --with-pred=PREDICATE NODE

=head1 DESCRIPTION

In it's simplest form, rls takes an RDF node as an argument, and returns all
the statements in the RDF store that contain the node. For example:

 # rls http://kasei.us/
 
 {[http://kasei.us/], [http://purl.org/rss/1.0/title], "Life on Mars"}
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/weblog], [http://kasei.us/]}

Here, we find two statements that contain the resource C<http://kasei.us/>. To
find statements about a bnode, give the bnode ID in parenthesis:

 # rls '(r1102811826r1)'
 {(r1102811826r1), [http://www.w3.org/1999/02/22-rdf-syntax-ns#type], [http://xmlns.com/foaf/0.1/Person]}
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/page], [http://kasei.us/people/Gregory_Todd_Williams/]}
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/mbox_sha1sum], "f80a0f19d2a0897b89f48647b2fb5ca1f0bc1cb8"}
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/nick], "kasei"}
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/homepage], [http://kasei.us/]}
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/name], "Gregory Todd Williams"}
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/weblog], [http://kasei.us/]}

Likewise, string literals are given in double quotes:

 # rls '"Gregory Todd Williams"'
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/name], "Gregory Todd Williams"}

To only list one node of each statement, you may use the -subj, -pred, and
-obj flags:

 # rls -subj '"Gregory Todd Williams"'
 (r1102811826r1)

When using the -subj or -obj flags, you may restrict the nodes to a
particular node type using -bnode, -resource and -literal.


To restrict the statements to only those with a particular predicate, use
--with-pred:

 # rls --with-pred=http://xmlns.com/foaf/0.1/nick '(r1102811826r1)'
 {(r1102811826r1), [http://xmlns.com/foaf/0.1/nick], "kasei"}

If the argument is a resource or a bnode, and you would like to find only
statements with the node either the subject or object position, use -fwd
or -back. For example, to find a thumbnail of an image:

 # rls -fwd --with-pred=http://xmlns.com/foaf/0.1/thumbnail http://kasei.us/archives/pf-motion.png
 {[http://kasei.us/archives/pf-motion.png], [http://xmlns.com/foaf/0.1/thumbnail], [http://kasei.us/archives/pf-motion-thumb.png]}

versus finding the original of a thumbnail:

 # rls -back --with-pred=http://xmlns.com/foaf/0.1/thumbnail http://kasei.us/archives/pf-motion-thumb.png
 {[http://kasei.us/archives/pf-motion.png], [http://xmlns.com/foaf/0.1/thumbnail], [http://kasei.us/archives/pf-motion-thumb.png]}

rls can optionally take node names as a list of newline seperated on STDIN.
This allows rls, or any other program to pipe data to and from rls. For
example, to list the names of all people:

 # rls -back -subj --with-pred=http://www.w3.org/1999/02/22-rdf-syntax-ns#type http://xmlns.com/foaf/0.1/Person | rls --with-pred=http://xmlns.com/foaf/0.1/name

Or, to count all people:

 # rls -back -subj --with-pred=http://www.w3.org/1999/02/22-rdf-syntax-ns#type http://xmlns.com/foaf/0.1/Person | wc -l

More extensive scripting is possible using the full suite of UNIX command line
tools such as L<perl|perl>, L<sed|sed>, L<uniq|uniq>, and L<cut|cut>.

=cut

my $model	= model();

my %flags;
while (scalar(@ARGV) and $ARGV[0] =~ /^(-[^=]+)(?:=(.*))?$/) {
	$flags{ $1 }	= $2 || 1;
	shift(@ARGV);
}
$flags{'--with_pred'}	= delete $flags{'--with-pred'} if (exists $flags{'--with-pred'});

my $filter	= sub { return () };
if (exists($flags{'-bnode'}) or exists($flags{'-resource'}) or exists($flags{'-literal'})) {
	if (exists($flags{'-bnode'})) {
		$filter	= sub { return $_[0] if $_[0]->is_blank; };
	} elsif (exists($flags{'-resource'})) {
		$filter	= sub { return $_[0] if $_[0]->is_resource; };
	} elsif (exists($flags{'-literal'})) {
		$filter	= sub { return $_[0] if $_[0]->is_literal; };
	}
} else {
	$filter	= sub { return $_[0]; };
}

my $stream	= scalar(@ARGV) ? sub { return shift(@ARGV) } : sub { my $id = scalar(<>); return undef unless ($id); chomp($id); return $id };
while (my $text = $stream->()) {
	my $node	= parse_node( $text ) || RDF::Redland::Node->new_from_uri( $text );
	my $pred	= $flags{'--with_pred'} ? RDF::Redland::Node->new_from_uri($flags{'--with_pred'}) : undef;
	my @s		= (
				RDF::Redland::Statement->new( $node, $pred, undef ),
				RDF::Redland::Statement->new( undef, $node, undef ),
				RDF::Redland::Statement->new( undef, $pred, $node )
			);
	pop(@s) if ($flags{'-fwd'});
	shift(@s) if ($flags{'-back'});
	
	foreach my $stmt (@s) {
		my $stmts	= $model->find_statements( $stmt );
		
		while($stmts && !$stmts->end) {
			my $st	= $stmts->current;
#		foreach my $st (@stmts) {
			if (exists($flags{'-subj'}) or exists($flags{'-pred'}) or exists($flags{'-obj'})) {
				my @nodes;
				if (exists($flags{'-subj'})) {
					push(@nodes, $filter->($st->subject));
				}
				if (exists($flags{'-pred'})) {
					push(@nodes, $filter->($st->predicate));
				}
				if (exists($flags{'-obj'})) {
					push(@nodes, $filter->($st->object));
				}
				print join(", ", map { $_->as_string } @nodes) if (@nodes);
			} else {
				print $st->as_string;
			}
		}
		continue {
			$stmts->next;
		}
	}
}

sub model {
	my @args		= @REDLAND_STORAGE;
	my $storage		= new RDF::Redland::Storage(@args);
	my $model		= new RDF::Redland::Model($storage, "");
	return $model;
}

sub parse_statement {
	my $line		= shift;
	chomp($line);
	my ($stuff)		= $line =~ m(^{(.*)}$);
	my (@triple)	= split(/, /, $stuff, 3);
	my @st;
	foreach (@triple) {
		my $node	= parse_node( $_ ) || return undef;
		push(@st, $node);
	}
	
	my $st	= RDF::Redland::Statement->new( @st );
	return $st;
}

sub parse_node {
	$_	= shift;
	if (/^\[(.*)\]$/) {
		return RDF::Redland::Node->new_from_uri( $1 );
	} elsif (/^\((.*)\)$/) {
		return RDF::Redland::Node->new_from_blank_identifier( $1 );
	} elsif (/^"(.*)"$/ or /^'(.*)'$/) {
		return RDF::Redland::Node->new( $1 );
	} else {
		return undef;
	}
	
}

__END__

=head1 AUTHOR

 Gregory Todd Williams <greg@evilfunhouse.com>

=cut
