#!/usr/bin/perl use strict; use CGI qw(:standard); use Data::Dumper; use LWP::UserAgent; use RDF::Redland; use URI::Escape; use XML::Simple; my $endpoints = { 'query' => 'http://127.0.0.1:2020/service/mttl' , 'update' => 'http://127.0.0.1:2020/service/mttl-update' , }; my $uastring = "mttlbot-graphs/0.1 "; my $g = param('uri'); die "Bad URI" if $g =~ /[<>\s\r\n]/; print header("text/turtle; charset=utf-8"); my $r = _sparql('query', 'GET', "CONSTRUCT { ?s ?p ?o } WHERE { GRAPH <$g> { ?s ?p ?o } . }"); print $r->{'raw'}."\n"; sub _sparql { my ($endpoint_id, $method, $query, $graph) = @_; my $endpoint = $endpoints->{$endpoint_id}; my $queryparam = ($endpoint_id =~ /update/) ? 'request' : 'query'; my $params = { $queryparam => $query }; $params->{'default-graph-uri'} = $graph if defined $graph; my $paramstring = ''; foreach my $k (keys %$params) { $paramstring .= sprintf('&%s=%s', $k, uri_escape($params->{$k})); } $paramstring =~ s/^\&/\?/; my $ua = LWP::UserAgent->new('timeout'=>60, 'agent'=>"$uastring "); $ua->default_header('Accept'=>'text/turtle, application/turtle, application/x-turtle'); my $res = ($method eq 'POST') ? $ua->post($endpoint, $params) : $ua->get($endpoint . $paramstring); if (($res->code == 200) && ($res->header('content-type')=~/sparql.results/) && (length $res->content)) { my $rv = {}; $rv->{'raw'} = $res->content; $rv->{'tree'} = XMLin($rv->{'raw'}, 'ForceArray'=>[qw(variable binding result)], 'KeyAttr'=>[]); if (defined $rv->{'tree'}->{'boolean'}) { if ('false' eq lc $rv->{'tree'}->{'boolean'}) { $rv->{'boolean'} = 0; } elsif ('true' eq lc $rv->{'tree'}->{'boolean'}) { $rv->{'boolean'} = 1; } } elsif (defined $rv->{'tree'}->{'results'}) { foreach my $v (@{ $rv->{'tree'}->{'head'}->{'variable'} }) { push @{$rv->{'cols'}}, $v->{'name'}; } foreach my $r (@{ $rv->{'tree'}->{'results'}->{'result'} }) { my $x = {}; foreach my $b (@{ $r->{'binding'} }) { $x->{ $b->{'name'} } = { 'uri' => $b->{'uri'} , 'bnode' => $b->{'bnode'} , 'literal' => $b->{'literal'} , 'curie' => _curie($b->{'uri'}) , }; if ('HASH' eq ref $x->{ $b->{'name'} }->{'literal'}) { $x->{ $b->{'name'} }->{'datatype'} = $b->{'literal'}->{'datatype'}; $x->{ $b->{'name'} }->{'literal'} = $b->{'literal'}->{'content'}; $x->{ $b->{'name'} }->{'datacurie'} = _curie($b->{'literal'}->{'datatype'}); } } push @{$rv->{'results'}}, $x; } } $rv->{'ok'} = 1; return $rv; } elsif (($res->code == 200) && ($res->header('content-type')=~/rdf.xml/)) { return { 'ok' => 1, 'rdf' => 1, 'raw' => $res->content, # 'model' => _get_redland_model('http://invalid.invalid/', $res), }; } elsif ($res->code == 200) { # print "--> Unknown content: <content."\n"; # print "EOF\n"; return { 'ok' => 1 , 'raw' => $res->content, }; } else { return { 'error'=>sprintf('%s [%s]', $res->message, (120<(length $query) ? ((substr $query, 0, 110).'...') : $query)) }; } }