# $Id: RDFStore.pm,v 1.9 2004/11/16 04:33:33 asc Exp $
use strict;
package Apache::XPointer::RDQL::RDFStore;
use base qw (Apache::XPointer::RDQL);
$Apache::XPointer::RDQL::RDFStore::VERSION = '1.1';
=head1 NAME
Apache::XPointer::RDQL::RDFStore - mod_perl handler to address XML fragments using the RDF Data Query Language.
=head1 SYNOPSIS
SetHandler perl-script
PerlHandler Apache::XPointer::RDQL::RDFStore
PerlSetVar XPointerSendRangeAs "XML"
#
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new(GET => "http://example.com/foo/bar/baz.rdf");
$req->header("Range" => qq(SELECT ?title, ?link
WHERE
(?item, , ),
(?item, , ?title),
(?item, , ?link)
USING
rdf for ,
rss for ));
$req->header("Accept" => "application/rdf+xml");
my $res = $ua->request($req);
=head1 DESCRIPTION
Apache::XPointer::RDQL::RDFStore is a mod_perl handler to address XML fragments
using the HTTP 1.1 I and I headers and the XPath scheme,
as described in the paper : I.
Additionally, the handler may also be configured to recognize a conventional
CGI parameter as a valid range identifier.
If no 'range' property is found, then the original document is
sent unaltered.
If an I header is specified with no corresponding match, then the
server will return (406) HTTP_NOT_ACCEPTABLE.
Successful queries will return (206) HTTP_PARTIAL_CONTENT.
=head1 OPTIONS
=head2 XPointerSendRangeAs
Return matches as one of the following content-types :
=over 4
=item * B
--match
Content-type: text/xml; charset=UTF-8
The Daily Cartoon for November 15
http://feeds.feedburner.com/BenHammersleysDangerousPrecedent?m=1
--match
Content-type: text/xml; charset=UTF-8
Releasing RadioPod
http://feeds.feedburner.com/BenHammersleysDangerousPrecedent?m=178
--match--
=item * B
The Daily Cartoon for November 15
http://feeds.feedburner.com/BenHammersleysDangerousPrecedent?m=1
Releasing RadioPod
http://feeds.feedburner.com/BenHammersleysDangerousPrecedent?m=178
=back
I
=head2 XPointerAllowCGI
If set to B then the handler will check for CGI parameters as well
as HTTP headers. CGI parameters are checked only if no matching HTTP
header is present.
Case insensitive.
=head2 XPointerCGIRangeParam
The name of the CGI parameter to check for an RDQL range.
Default is B
=head2 XPointerCGIAcceptParam
The name of the CGI parameter to list one or more acceptable
content types for a response.
Default is B
=head1 MOD_PERL COMPATIBILITY
This handler will work with both mod_perl 1.x and mod_perl 2.x.
=cut
use DBI;
use RDFStore::Model;
use RDFStore::NodeFactory;
sub send_as {
my $pkg = shift;
my $as = shift;
if ($as eq "multipart/mixed") {
return "send_multipart";
}
elsif ($as eq "application/rdf+xml") {
return "send_xml";
}
else {
return undef;
}
}
sub query {
my $pkg = shift;
my $apache = shift;
my $query = shift;
my $bind = $pkg->bind($query);
my $dbh = undef;
my $sth = undef;
eval {
$dbh = DBI->connect("DBI:RDFStore:");
};
if ($@) {
return $pkg->_fatal($apache,
"failed to create DB connection, $@");
}
eval {
$sth = $dbh->prepare($query);
};
if ($@) {
return $pkg->_fatal($apache,
"failed to prepare query statement, $@");
}
$sth->execute();
if ($dbh->err()) {
return $pkg->_fatal($apache,
$dbh->errstr());
}
$sth->bind_columns(map { \$_->{value} } @$bind);
#
return {success => 1,
bind => $bind,
result => $sth};
}
sub send_multipart {
my $pkg = shift;
my $apache = shift;
my $res = shift;
my $factory = RDFStore::NodeFactory->new();
while ($res->{'result'}->fetch()) {
my $model = RDFStore::Model->new();
my $subject = $factory->createUniqueResource();
map {
my $property = $factory->createResource($_->{namespaceuri},$_->{localname});
my $object = $_->{value};
$model->add($factory->createStatement($subject,$property,$object));
} @{$res->{'bind'}};
$apache->print(qq(--match\n));
$apache->print(sprintf("Content-type: text/xml; charset=%s\n\n","UTF-8"));
$apache->print(sprintf("%s\n",$model->serialize()));
}
$apache->print(qq(--match--\n));
return 1;
}
sub send_xml {
my $pkg = shift;
my $apache = shift;
my $res = shift;
#
my $ns_rdf = "http://www.w3.org/1999/02/22-rdf-syntax-ns#";
my $ns_xp = "x-urn:cpan:ascope:apache-xpointer-rdql:";
my $factory = RDFStore::NodeFactory->new();
my $model = RDFStore::Model->new();
my $range = $factory->createResource($ns_xp,"range");
my $type = $factory->createResource($ns_rdf,"type");
my $sequence = $factory->createResource($ns_rdf,"Seq");
my $li = $factory->createResource($ns_rdf,"li");
my $seq = $factory->createUniqueResource();
$model->add($factory->createStatement($seq,$type,$range));
$model->add($factory->createStatement($seq,$type,$sequence));
for (my $i = 0; $res->{'result'}->fetch(); $i++) {
my $result = $factory->createOrdinal($i+1);
map {
my $property = $factory->createResource($_->{namespaceuri} . $_->{localname});
my $object = $_->{value};
$model->add($factory->createStatement($result,$property,$object));
} @{$res->{'bind'}};
$model->add($factory->createStatement($seq,$li,$result));
}
$apache->print($model->serialize());
return 1;
}
sub _fatal {
my $pkg = shift;
my $apache = shift;
my $err = shift;
$apache->log()->error($err);
return {success => 0,
response => $pkg->_server_error()};
}
=head1 VERSION
1.1
=head1 DATE
$Date: 2004/11/16 04:33:33 $
=head1 AUTHOR
Aaron Straup Cope Eascope@cpan.orgE
=head1 SEE ALSO
L
=head1 LICENSE
Copyright (c) 2004 Aaron Straup Cope. All rights reserved.
This is free software, you may use it and distribute it under
the same terms as Perl itself.
=cut
return 1;