".$ex->toString."\n"; if ($sessionId) { print "
Session-id: $sessionId
\n"; } print "\n"; } else { print "Status: 500\n\n"; print "died with $@"; if ($sessionId) { print "Session-id: $sessionId
\n"; } } } ##### # rdfQuery - present form to call and interpret rdf results # sub new { my ($proto, $read) = @_; my $class = ref $proto || $proto; my $self = $class->SUPER::new($read, {-parmMapping => \%ParmMapping}); $self->{SHORT_TITLE} => 'annotate'; $self->{STATEMENTS_COL_0_WIDTH} = $STATEMENTS_COL_0_WIDTH; return $self; } sub importCGIParms { my ($self) = @_; # load a properties file if available eval { $self->{-properties} = new W3C::Util::Properties('algaeCGI.prop'); # 'rdf.prop', $self->_checkQueryLanguage($self->{-properties}); $self->{SELF_URI} = $self->{READ}->uriFromProperties($self->{-properties}, 'script.home.uri'); }; if ($@) {if (my $ex = &catch('W3C::Util::FileNotFoundException')) { $self->{-properties} = new W3C::Util::Properties(); $self->{SELF_URI} = $self->{READ}->url; } else {&throw()}} $self->SUPER::importCGIParms; } sub _checkQueryLanguage { my ($self, $props) = @_; if (my $langName = $self->{-properties}->getI('query.language')) { my $queryLangNames = {'Algae' => $QL_ALGAE, 'RDQL' => $QL_RDQL, 'SPARQL' => $QL_SPARQL, 'RXQuery' => $QL_RXQuery, 'SeRQL' => $QL_SeRQL}; if (!exists $queryLangNames->{$langName}) { &throw(new W3C::Util::Exception(-message => "unknown query language \"$langName\"")); } $self->{QLANG} = $queryLangNames->{$langName}; } } sub execute { my ($self) = @_; $self->{PRESENTER} = $self->makePresenter({-htmlPresenter => 'W3C::Rdf::cgibin::AlgaeScript::AlgaeHTMLPresenter'}, {'r', $RDF_SCHEMA_URI}); # send a 401 if the client has requested an auth prompt. stop when identity changes. return $self->endMessage($self->requireAuth('W3Csearcg', 'rdf')) if (0); my $title = 'Query RDF'; if ($self->{RDF_QUERY}) { $title .= ' for: '.CGI::escapeHTML($self->{RDF_QUERY}); } if ($self->{STATEMENTS}) { $title .= ' Statements: '.CGI::escapeHTML($self->{STATEMENTS}); } if ($self->{ATTRIBUTIONS}) { $title .= ' Attributions: '.CGI::escapeHTML($self->{ATTRIBUTIONS}); } $self->{PRESENTER}->printHead($self->{PRE_MESSAGES}, $title); # , $self->{READ}->getSessionId); if ($self->{RDF_INPUT}) { my @inputs = split (/\s+/, $self->{RDF_INPUT}); foreach my $input (@inputs) { my $inputSource = &W3C::Rdf::RdfApp::getInputSource($input); $self->{-context}->parse($inputSource->getByteStream(), $inputSource->getPublicId(), 'RDFXML', $self->{-queryHandler}); } } if ($self->{RDF_QUERY}) { my $auth = undef; my $attrib = $self->{-atomDictionary}-> getGroundFactAttribution($self->{-atomDictionary}->getUri($self->{BASE_URI}), undef, $auth, undef); my $queryObject = new W3C::Rdf::CGIApp::QueryObject($self->{-atomDictionary}, $attrib, $self->{RDF_DB}); eval { my ($results, $selects, $messages, $proofs) = $self->{-queryHandler}->interpret($self->{RDF_QUERY}, undef, $self->{QLANG}, 0x00); # $self->{-queryHandler}->clear(); if (!defined $self->{FORCE_PRESENTATION} || $self->{FORCE_PRESENTATION} eq 'NONE') { if (my $mt = $self->{-queryHandler}->getResultSet()->getPresentationMimetype()) { $self->{FORCE_PRESENTATION} = $mt; $self->{PRESENTER} = $self->makePresenter({-htmlPresenter => 'W3C::Rdf::cgibin::AlgaeScript::AlgaeHTMLPresenter'}, {'r', $RDF_SCHEMA_URI}); $proofs = [$self->{-queryHandler}->getTemplateDB()]; } } if (@$proofs) { $queryObject->showQueryResults($self->{-context}->getRdfDB, $results, $selects, $messages, $proofs, $self->{PRESENTER}, 'SPARQL query', $self->{RDF_QUERY}); } else { my $encQuery = CGI::escapeHTML($self->{RDF_QUERY}); $self->{PRESENTER}->printEmptyQuery("found no query results on \"$encQuery\".", $self->{RDF_QUERY}); } }; if ($@) {if (my $ex = &catch('W3C::Util::Exception')) { $self->{PRESENTER}->printError($ex->toString); } else { $self->{PRESENTER}->printError("died with $@"); }} } if ($self->{STATEMENTS}) { $self->showStatementsBy('id', $self->{STATEMENTS}); } if ($self->{ATTRIBUTIONS}) { $self->showStatementsBy('a', $self->{ATTRIBUTIONS}); } eval {$self->{PRESENTER}->printFoot;}; # it works or it doesn't, can't do much now. return $self->{PRESENTER}; } sub showStatementsBy { my ($self, $byField, $listStr) = @_; my @ranges = split(/\s*\,\s*/, $listStr); eval { my @ids; foreach my $range (@ranges) { my ($min, $max) = split (/\s*\-\s*/, $range); if (!defined $max) { $max = $min; } foreach my $id ($min..$max) { push (@ids, $id); } } eval { my @statements = $self->{RDF_DB}->getStatementsById($byField, [@ids]); $self->{PRESENTER}->printStatements($self->{RDF_DB}, \@statements); }; if ($@) {if (my $ex = &catch('W3C::Database::DropRowException')) { $self->{PRESENTER}->printError($ex->toString); } else {&throw()}} }; if ($@) {if (my $ex = &catch('W3C::Util::Exception')) { $self->{PRESENTER}->printError($ex->toString); } else { $self->{PRESENTER}->printError("died with $@"); }} } sub endMessage { my ($self, $message) = @_; print $message; } sub arrayHasDiffs { my ($a, $b) = @_; return 1 if ($#$a != $#$b); my (%a, %b); map {$a{$_} = undef} @$a; map {return 1 if (!exists $a{$_})} @$b; return 0; } sub unknownException { my ($self, $exception) = @_; my $redirResponse = <$exception
EOF
;
return $redirResponse;
}
sub requireAuth {
my ($self, $realm, $needed) = @_;
my $resource = join(' ', @{$self->{RESOURCE_LIST}});
my $authResponse = <
EOF
;
return $authResponse;
}
sub confFileMissing999 {
my ($self, $filename) = @_;
my $confResponse = < rdfQuery needs the file \"$filename\" to opperate.
rdfQuery presents the the current
ACLs for a resource and creates forms to manipulate them.
rdfQuery then handles
the output from the forms. Both are layered on top of
W3C::Database::DBIInterface.pm.
RDF parsing facilities are handled by a stack of parser:
<brought to you by W3C::Util::ShowSource.pm>.
EOF
;
#####
# Print source
my $showSource = W3C::Util::ShowSource->new(\@sources, \%paths, $query);
$showSource->present($useColor, $funcLinks, $funcList);
print $query->end_html;
}
package Presenter999;
use W3C::Util::Exception;
sub new999 {
my ($proto, $engine, $renderer) = @_;
my $class = ref($proto) || $proto;
my $self = {ENGINE => $engine, RENDERER => $renderer};
bless ($self, $class);
return $self;
}
sub showRdf999 {
my ($self, $statements, $colspan) = @_;
my $result;
my $publicId = $self->{ENGINE}{RDF_RESOURCE}; # &W3C::XML::FileInputSource::makePublicId('http://www.w3.org/fake/publicId');
use W3C::XML::HandlerBase;
use W3C::XML::XmlSerializer;
my $namespaceHandler = new W3C::XML::OldNamespaceHandler ();
my $rdfNS = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
$namespaceHandler->addNamespace('r', $rdfNS, $self->{RDF_RESOURCE});
my $serializer = new W3C::XML::UriXmlSerializer(-prettyPrint => 1,
-namespaceElementSweep => 5,
-namespaceElementTrip => 2,
-namespaceForce => [$rdfNS],
-namespaceCreativity => 0);
my $iterator = $self->{ENGINE}{RDF_DB}->makeSerializerIterator($statements, $self->{ENGINE}{-queryHandler},
-scheme => 'guess',
-neededNamespaces =>[qw(r)],
-noRdfTag => 0,
-ignoreReifications => 1,
-allowAnonymousRefs => 1,
-ignoreAnonymousReifications => 1,
# -exceptionHandler =>
# new W3C::Rdf::RdfDB::Serializer::ExceptionIgnorer
);
my $bgcolor = '#c7c7ff';
eval {
$iterator->iterate($serializer);
}; if ($@) {
if (my $ex = &catch('W3C::Util::Exception')) {
$result = $ex->toString;
} else {
$result = "died with $@";
}
$bgcolor = 'red';
}
return ($bgcolor, $result);
}
package RdfPresenter;
use W3C::Util::Exception;
sub newNUKE {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
bless ($self, $class);
return $self;
}
sub printHead {
my ($self, $title, $versionId) = @_;
print $self->{RENDERER}->header({-type=>'text/xml', 'Version-Id' => $versionId});
}
sub printStatements {
my ($self, $rdfDB, $statements) = @_;
my $statementCount = scalar(@$statements);
$self->showRdf($rdfDB, $statements, 1);
}
sub showRdfNUKE {
my ($self, $statements, $colspan) = @_;
push (@{$self->{STATEMENTS}}, @$statements);
$self->{COLSPAN} = $colspan;
}
sub printFootNUKE {
my ($self) = @_;
my ($bgcolor, $result) = $self->SUPER::showRdf($self->{STATEMENTS}, $self->{COLSPAN});
print $result;
}
package W3C::Rdf::cgibin::AlgaeScript::AlgaeHTMLPresenter;
use W3C::Util::Exception;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
bless ($self, $class);
$self->{SERIALIZER}->flush();
$self->{SERIALIZED_TOP} = $self->{SERIALIZED_STRING};
$self->{SERIALIZED_STRING} = ''; # !!! clear out XML decl
return $self;
}
sub printHead {
my ($self, $preMessages, $title) = @_;
$self->SUPER::printHead($preMessages, $title);
$self->printOK(' \n HTML options:
Enter a SPARQL query:Authorization Required
You need $needed access to $resource to perform the requested opperation.Rdf Editor Sources
W3C::Rdf::RdfParser
|
W3C::XML::XmlParser
The W3C::XML::XmlParser is an
implementation of a SAX interface ported to perl. It uses:
');
if ($self->{ENGINE}{-properties}->getI('render.rdf') &&
grep {$_ eq 'RDF/XML'} $self->{ENGINE}{READ}->param('render')) {
$self->printOK($self->{SERIALIZED_TOP});
}
$self->printOK('');
}
sub showQueryResults {
my ($self, $rdfDB, $nodes, $selects, $messages, $proofs, $presenter, $title, $description) = @_;
if (@$messages &&
$self->{ENGINE}{-properties}->getI('render.messages') &&
grep {$_ eq 'messages'} $self->{ENGINE}{READ}->param('render')) {
$self->printOK("Messages:
\n\n");
$self->printOK(join ('', map {"
\n\n");
}
my $nodeCount = scalar(@$nodes);
$self->printOK(@$nodes > 1 ? "$_
$nodeCount results:
\n" : "result:
\n");
$self->printOK("
\n");
}
sub printStatements {
my ($self, $rdfDB, $statements) = @_;
my $statementCount = scalar(@$statements);
$self->printOK(@$statements > 1 ? "".join (' ', @$selects)."
\n/gs;
$string = "";
} else {
$string = "";
}}
push (@rowElements, $string);
}
$self->printOK("$i ".join (' ', @rowElements)."
$statementCount results:\n" : ' -> ');
$self->printOK("
\n");
}
sub _selfRef {
my ($self, @parms) = @_;
my @attrValues;
foreach my $parm (@parms) {
my ($attr, $value) = @$parm;
push (@attrValues, join ('=', $attr, CGI::escape($value)));
}
# return join ('?', 'algae', join ('&', @attrValues));
return '?'.join ('&', @attrValues);
}
sub showRdf {
my ($self, $rdfDB, $statements, $colspan) = @_;
my $width = $self->{ENGINE}{STATEMENTS_COL_0_WIDTH};
my $statementsAndAttrs;
{
my (@links, @statementIds, %attributionIds);
foreach my $statement (@$statements) {
#my $ob = $statement->getSubclass($self->{ENGINE}{RDF_DB});
push (@statementIds, $self->{ENGINE}{RDF_DB}->getStatementId($statement)); # $ob->getPrimaryKey);
my $attributionList = $statement->getAttributionList();
foreach my $attribution (@$attributionList) {
$attributionIds{$self->{ENGINE}{RDF_DB}->getAttributionId($attribution)} = $attribution;
}
}
my $statementList = join (',', @statementIds);
my $statementListTitle = $statementList;
if ((length($statementListTitle)) > $width) {
$statementListTitle = substr($statementListTitle, 0, $width - 3).'...';
}
my $url = $self->{RENDERER}->escapeHTML($self->_selfRef(['statements', $statementList]));
push (@links, "$statementListTitle");
foreach my $attributionId (sort keys %attributionIds) {
my $attributionUri = $attributionIds{$attributionId}->getSource->getUri;
my $url = $self->{RENDERER}->escapeHTML($self->_selfRef(['attributions', $attributionId]));
my $link = "a $attributionId";
push (@links, $link);
}
$statementsAndAttrs = join ("statements
\n ", @links);
}
my $style = 'annotation';
my $string;
eval {
# ($bgcolor, $string) = $self->SUPER::showRdf($statements, $colspan);
$self->serialize($rdfDB, [@$statements]);
# This presenter presents multiple serializations, each starting over after the last.
$string = $self->{SERIALIZED_STRING};
$self->{SERIALIZED_STRING} = '';
# $string = $self->{RENDERER}->escapeHTML($string);
}; if ($@) {
$style = 'warning';
if (my $ex = &catch('W3C::Util::Exception')) {
$string = $self->{RENDERER}->escapeHTML($ex->toString);
$string =~ s/\n/
\n/gs;
} else {
$string = "$@";
}
}
$self->printOK("$statementsAndAttrs
".$string."
\n";
}
return undef;
}
sub printFoot {
my ($self) = @_;
$self->endRdf;
$self->printOK('');
if ($self->{ENGINE}{-properties}->getI('render.rdf') &&
grep {$_ eq 'RDF/XML'} $self->{ENGINE}{READ}->param('render')) {
$self->printOK($self->{SERIALIZED_STRING});
}
$self->printOK("\n");
#print $self->{RENDERER}->startform('GET', $self->{RENDERER}->url, 'application/x-www-form-urlencoded');
# my $selfUri = 'algae'; # $query->self_url;
my $selfUri = $self->{ENGINE}->getSelfUri;
my $displayQuery = $self->{RENDERER}->escapeHTML($self->{ENGINE}->{RDF_QUERY} ?
$self->{ENGINE}->{RDF_QUERY} :
"SELECT * WHERE { ?s ?p ?o }");
my $displayInput = $self->{RENDERER}->escapeHTML($self->{ENGINE}->{RDF_INPUT} ?
$self->{ENGINE}->{RDF_INPUT} :
"");
my %checked_force = ($self->{ENGINE}{FORCE_PRESENTATION} => 'checked="y" ');
my $htmlRenderOpts = '';
$htmlRenderOpts .= $self->_checkOpt('render.messages', 'messages', 'processing messages');
$htmlRenderOpts .= $self->_checkOpt('render.proofs', 'proofs', 'supporting statements');
$htmlRenderOpts .= $self->_checkOpt('render.rdf', 'RDF/XML', 'supporting statements in RDF/XML');
if ($htmlRenderOpts) {
$htmlRenderOpts = "
\n$htmlRenderOpts\n
RDF data resources (list of URLs with whitespace between them):
";
}
my $tmp = <
EOF
;
$self->printOK($tmp);
# done - clean up
$self->printOK($self->{RENDERER}->end_html."\n");
}
package rdfQuery;