#!/usr/bin/perl
use lib '/home/tai/src/perlmods/CGI-Auth-FOAF_SSL/lib/';
use CGI qw(:all);
use CGI::Auth::FOAF_SSL '0.11';
use CGI::Carp qw(fatalsToBrowser);
use URI::Escape;
use utf8;
my $cgi = CGI->new;
my $auth = CGI::Auth::FOAF_SSL->new_from_cgi($cgi);
my $group = Test::Group->new;
unless (defined $auth && defined $auth->agent && $auth->is_secure)
{
my $errormsg = "<p><strong>Problem:</strong> could not fully identify you using FOAF+SSL. "
. "The FOAL+SSL library used is still a very early (alpha) version, "
. "so perhaps not all certificates will work. The ones from <a "
. "href=\"http://test.foafssl.org/cert/\">test.foafssl.org</a> definitely do!</p>\n";
if (defined $auth && defined $auth->agent)
{
$errormsg .= "<p>In your case, you seem to have installed a FOAF+SSL certificate "
. "correctly, but you need to link to it from your FOAF file. See <a "
. "href=\"/help.cgi\">this message</a> for details.</p>\n";
}
print $cgi->header("text/html; charset=utf-8");
print $group->apply_template("<h1>Not Authenticated</h1>\n$errormsg", undef);
exit;
}
if ($cgi->param('action') eq 'refresh_cheese')
{
print $cgi->header("text/html; charset=utf-8");
print $group->apply_template(Test::Cheese::refresh_model($group), $auth->agent);
}
elsif ($cgi->param('action') eq 'join')
{
$group->add_member($auth->agent);
print $cgi->redirect('https://ophelia.g5n.co.uk:10443/cheese/?member='.uri_escape($auth->agent->identity));
}
elsif ($cgi->param('action') eq 'add')
{
my $cheese = Test::Cheese->new($cgi->param('cheese'), $group);
$cheese->add_fan($auth->agent);
print $cgi->redirect('https://ophelia.g5n.co.uk:10443/cheese/?cheese='.uri_escape($cheese->{'identity'}));
}
elsif ($cgi->param('action') eq 'remove')
{
my $cheese = Test::Cheese->new($cgi->param('cheese'), $group);
$cheese->remove_fan($auth->agent);
print $cgi->redirect('https://ophelia.g5n.co.uk:10443/cheese/?cheese='.uri_escape($cheese->{'identity'}));
}
elsif ($cgi->param('cheese'))
{
my $cheese = Test::Cheese->new($cgi->param('cheese'), $group);
print $cgi->header("text/html; charset=utf-8");
print $group->apply_template($cheese->html($auth->agent), $auth->agent);
}
elsif ($cgi->param('member'))
{
my $member = Test::Member->new($cgi->param('member'), $group);
print $cgi->header("text/html; charset=utf-8");
print $group->apply_template($member->html($auth->agent), $auth->agent);
}
else
{
print $cgi->header("text/html; charset=utf-8");
print $group->apply_template($group->html, $auth->agent);
}
$group->finish;
package Test::Cheese;
use CGI qw(escapeHTML);
use URI::Escape;
use JSON;
use LWP::Simple;
use Encode;
sub new
{
my $class = shift;
my $self = {};
$self->{'identity'} = shift;
$self->{'group'} = shift;
$self->{'data'} = $self->{'group'}->{'data'};
bless $self, $class;
}
sub html
{
my $self = shift;
my $user = shift;
my $qs = "SELECT ?label ?page
WHERE {
<!!> <http://www.w3.org/2000/01/rdf-schema#label> ?label ;
<http://xmlns.com/foaf/0.1/page> ?page .
}";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
return "<h1>Unknown Cheese</h1>\n<p>Could not find information on this cheese.</p>\n"
if ($results->finished);
my $label = $results->binding_value(0)->literal_value;
my $page = $results->binding_value(1)->uri->as_string;
my $depiction = 'missing-image.png';
my $source = 'Unknown';
# In an ideal world the following would be an OPTIONAL part of the previous
# query. However, RDF::Redland doesn't support the OPTIONAL keyword in
# SPARQL.
my $qs = "SELECT ?depiction WHERE { <!!> <http://xmlns.com/foaf/0.1/depiction> ?depiction . }";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
$depiction = $results->binding_value(0)->uri->as_string
unless ($results->finished);
my $qs = "SELECT ?source WHERE { <!!> <http://purl.org/dc/terms/source> ?source . }";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
$source = $results->binding_value(0)->literal_value
unless ($results->finished);
my $rv = sprintf("<h1 about=\"%s\" property=\"rdfs:label\" rev=\"foaf:primaryTopic\" rel=\"foaf:page\" resource=\"\">%s</h1>\n"
. "<div about=\"%s\">\n"
. "\t<p><b>Origin:</b> <span property=\"dc:source\">%s</span></p>\n"
. "\t<img rel=\"foaf:img\" src=\"%s\" alt=\"Photograph of some %s\">\n"
. "\t<p><b>More information:</b> <a rel=\"foaf:page\" href=\"%s\">%s</a></p>\n"
. "</div>\n"
. "<h2>People Who Like This Cheese</h2>\n"
, escapeHTML($self->{identity})
, escapeHTML($label)
, escapeHTML($self->{identity})
, escapeHTML($source)
, escapeHTML($depiction)
, escapeHTML($label)
, escapeHTML($page)
, escapeHTML($page)
);
my $qs = "SELECT ?name ?person
WHERE {
?person <http://xmlns.com/foaf/0.1/name> ?name ;
<http://xmlns.com/foaf/0.1/topic_interest> <!!> .
}";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
my $count = 0;
my $meLike = 0;
while (! $results->finished)
{
$rv .= "<ul about=\"".escapeHTML($self->{identity})."\" rev=\"foaf:topic_interest\">\n" unless $count;
$count++;
my $name = $results->binding_value(0)->literal_value;
my $person = $results->binding_value(1)->uri->as_string;
$rv .= sprintf(" <li typeof=\"foaf:Agent\" about=\"%s\"><a property=\"foaf:name\" rel=\"foaf:page\" href=\"?member=%s\">%s</a></li>\n",
escapeHTML($person),
escapeHTML(uri_escape($person)),
escapeHTML($name));
$meLike++ if $person eq $user->identity;
$results->next_result;
}
if ($count)
{ $rv .= "</ul>\n"; }
else
{ $rv .= "<p>Nobody.</p>\n"; }
if ($self->{'group'}->has_member($user))
{
if ($meLike)
{
$rv = sprintf("<p>You've told us you like this cheese. <a href=\"?cheese=%s&action=remove\">Remove it from your favourites</a>.</p>\n$rv",
escapeHTML(uri_escape($self->{'identity'})));
}
else
{
$rv = sprintf("<p>Do you like this cheese? <a href=\"?cheese=%s&action=add\">Add it to your favourites</a>.</p>\n$rv",
escapeHTML(uri_escape($self->{'identity'})));
}
}
return $rv;
}
sub refresh_model
{
my $group = shift;
my $params = {
'default-graph-uri' => 'http://dbpedia.org',
'query' =>
'SELECT DISTINCT ?resource ?label ?page ?depiction ?countrylabel
WHERE {
?resource
<http://dbpedia.org/property/wikiPageUsesTemplate>
<http://dbpedia.org/resource/Template:infobox_cheese> ;
<http://www.w3.org/2000/01/rdf-schema#label> ?label ;
<http://xmlns.com/foaf/0.1/page> ?page .
OPTIONAL {
?resource <http://xmlns.com/foaf/0.1/depiction> ?depiction .
}
OPTIONAL {
?resource <http://dbpedia.org/property/country> ?country .
?country <http://www.w3.org/2000/01/rdf-schema#label> ?countrylabel .
}
FILTER ( lang(?label) = "en" )
FILTER ( lang(?countrylabel) = "en" )
}',
'format' => 'application/json',
'debug' => 'on',
'should-sponge' => '',
};
my $uri = 'http://dbpedia.org/sparql?';
foreach my $k (sort keys %$params)
{
$uri .= uri_escape($k) . '=' . uri_escape($params->{$k}) . '&';
}
$uri =~ s/\&$//;
my $data = from_json((get $uri), {utf8 => 1});
$group->{'dirty'} = 1;
foreach my $cheese (@{ $data->{'results'}->{'bindings'} })
{
my $res = RDF::Redland::URINode->new($cheese->{'resource'}->{'value'});
my $label = $cheese->{'label'}->{'value'};
$label =~ s/\s+\(?cheese\)?$//i
unless $label eq 'Cream cheese';
$group->{'data'}->add_statement($res,
RDF::Redland::URINode->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'),
RDF::Redland::URINode->new('http://sw.opencyc.org/2008/06/10/concept/Mx4rwOD7mJwpEbGdrcN5Y29ycA'));
$group->{'data'}->add_statement($res,
RDF::Redland::URINode->new('http://www.w3.org/2000/01/rdf-schema#label'),
RDF::Redland::LiteralNode->new(encode('UTF-8', $label), undef, 'en'));
$group->{'data'}->add_statement($res,
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/page'),
RDF::Redland::URINode->new($cheese->{'page'}->{'value'}));
$group->{'data'}->add_statement($res,
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/depiction'),
RDF::Redland::URINode->new($cheese->{'depiction'}->{'value'}))
if $cheese->{'depiction'}->{'value'};
$group->{'data'}->add_statement($res,
RDF::Redland::URINode->new('http://purl.org/dc/terms/source'),
RDF::Redland::LiteralNode->new(encode('UTF-8', $cheese->{'countrylabel'}->{'value'})))
if $cheese->{'countrylabel'}->{'value'};
}
return "<h1>Refresh Cheeses</h1>\n<p>Successful.</p>\n";
}
sub add_fan
{
my $self = shift;
my $user = shift;
$self->{'group'}->{'dirty'} = 1;
$self->{'data'}->add_statement(
RDF::Redland::URINode->new($user->identity),
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/topic_interest'),
RDF::Redland::URINode->new($self->{'identity'}));
}
sub remove_fan
{
my $self = shift;
my $user = shift;
$self->{'group'}->{'dirty'} = 1;
$self->{'data'}->remove_statement(
RDF::Redland::URINode->new($user->identity),
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/topic_interest'),
RDF::Redland::URINode->new($self->{'identity'}));
}
1;
package Test::Member;
use CGI qw(escapeHTML);
use URI::Escape;
use JSON;
use LWP::Simple;
use Encode;
sub new
{
my $class = shift;
my $self = {};
$self->{'identity'} = shift;
$self->{'group'} = shift;
$self->{'data'} = $self->{'group'}->{'data'};
bless $self, $class;
}
sub html
{
my $self = shift;
my $qs = "SELECT ?name
WHERE {
<!!> <http://xmlns.com/foaf/0.1/name> ?name .
}";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
return "<h1>Unknown Member</h1>\n<p>Could not find information on this member.</p>\n"
if ($results->finished);
my $label = $results->binding_value(0)->literal_value;
my $page = undef;
my $depiction = 'missing-image.png';
my $mbox = undef;
$label = $self->{'identity'} unless $label =~ /[a-z0-9]/i;
# In an ideal world the following would be an OPTIONAL part of the previous
# query. However, RDF::Redland doesn't support the OPTIONAL keyword in
# SPARQL.
my $qs = "SELECT ?page WHERE { <!!> <http://xmlns.com/foaf/0.1/homepage> ?page . }";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
$page = $results->binding_value(0)->uri->as_string
unless ($results->finished);
my $qs = "SELECT ?depiction WHERE { <!!> <http://xmlns.com/foaf/0.1/img> ?depiction . }";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
$depiction = $results->binding_value(0)->uri->as_string
unless ($results->finished);
my $qs = "SELECT ?mbox WHERE { <!!> <http://xmlns.com/foaf/0.1/mbox> ?mbox . }";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
$mbox = $results->binding_value(0)->uri->as_string
unless ($results->finished);
my $rv = sprintf("<h1 about=\"%s\" property=\"foaf:name\" rev=\"foaf:primaryTopic\" rel=\"foaf:page\" resource=\"\">%s</h1>\n"
. "<div about=\"%s\" typeof=\"foaf:Agent\">\n"
. (defined $page ? "\t<p><b>Homepage:</b> <a rel=\"foaf:homepage\" href=\"$page\">$page</a></p>\n" : '')
. (defined $mbox ? "\t<p><b>E-mail:</b> <a rel=\"foaf:mbox\" href=\"$mbox\">$mbox</a></p>\n" : '')
. "\t<img rel=\"foaf:img\" src=\"%s\" alt=\"Photograph of %s\">\n"
. "</div>\n"
. "<h2>Favourite Cheeses</h2>\n"
, escapeHTML($self->{'identity'})
, escapeHTML($label)
, escapeHTML($self->{'identity'})
, escapeHTML($depiction)
, escapeHTML($label));
my $qs = "SELECT ?label ?cheese
WHERE {
<!!> <http://xmlns.com/foaf/0.1/topic_interest> ?cheese .
?cheese <http://www.w3.org/2000/01/rdf-schema#label> ?label .
}";
$qs =~ s/!!/$self->{identity}/g;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
my $count = 0;
while (! $results->finished)
{
$rv .= "<ul about=\"".escapeHTML($self->{'identity'})."\" rel=\"foaf:topic_interest\">\n" unless $count;
$count++;
my $label = $results->binding_value(0)->literal_value;
my $cheese = $results->binding_value(1)->uri->as_string;
$rv .= sprintf(" <li about=\"%s\"><a property=\"rdfs:label\" rel=\"foaf:page\" href=\"?cheese=%s\">%s</a></li>\n",
escapeHTML($cheese),
escapeHTML(uri_escape($cheese)),
escapeHTML($label));
$results->next_result;
}
if ($count)
{ $rv .= "</ul>\n"; }
else
{ $rv .= "<p>None.</p>\n"; }
return $rv;
}
1;
package Test::Group;
use RDF::Redland;
use CGI qw(escapeHTML);
use URI::Escape;
use Encode;
sub new
{
my $class = shift;
my $self = {};
my $storage = RDF::Redland::Storage->new("hashes", "test", "new='yes',hash-type='memory'");
my $model = RDF::Redland::Model->new($storage, "");
my $parser = RDF::Redland::Parser->new("ntriples");
$parser->parse_into_model(
RDF::Redland::URI->new('file:///home/tai/public_html/vhosts/FOAFSSL_TEST/cheese/cheese.nt'),
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
$model);
$self->{'dirty'} = 0;
$self->{'data'} = $model;
bless $self, $class;
}
sub has_member
{
my $self = shift;
my $person = shift;
return 0 unless defined $person;
my $qs = "ASK WHERE { <https://ophelia.g5n.co.uk:10443/cheese/#group> <http://xmlns.com/foaf/0.1/member> <!!> . }";
$qs =~ s/!!/$person->identity/eg;
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
return 1 if ($results->is_boolean && $results->get_boolean);
return 0;
}
sub add_member
{
my $self = shift;
my $person = shift;
return 0 unless defined $person;
$self->{'dirty'} = 1;
my $res = RDF::Redland::URINode->new($person->identity);
$self->{'data'}->add_statement(
RDF::Redland::URINode->new('https://ophelia.g5n.co.uk:10443/cheese/#group'),
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/member'),
$res);
$self->{'data'}->add_statement(
$res,
RDF::Redland::URINode->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'),
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/Agent'));
$self->{'data'}->add_statement(
$res,
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/name'),
RDF::Redland::LiteralNode->new(encode('UTF-8', $person->name) || 'No Name'));
$self->{'data'}->add_statement(
$res,
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/homepage'),
RDF::Redland::URINode->new($person->homepage))
if length $person->homepage;
$self->{'data'}->add_statement(
$res,
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/mbox'),
RDF::Redland::URINode->new($person->mbox))
if length $person->mbox;
$self->{'data'}->add_statement(
$res,
RDF::Redland::URINode->new('http://xmlns.com/foaf/0.1/img'),
RDF::Redland::URINode->new($person->img))
if length $person->img;
return 1;
}
sub finish
{
my $self = shift;
if ($self->{'dirty'})
{
my $s = RDF::Redland::Serializer->new("ntriples");
$s->serialize_model_to_file(
"cheese.nt",
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
$self->{'data'});
print "<p><small><tt>cheese.nt</tt> written.</small></p>"
}
}
sub html
{
my $self = shift;
my $rv = "<h1 about=\"#group\" typeof=\"foaf:Group\" property=\"foaf:name\" rel=\"foaf:homepage\" rev=\"foaf:primaryTopic\" resource=\"\">#swig Cheese Lovers' Club</h1>\n";
$rv .= "<div style=\"width:40%;float:left;\">\n";
$rv .= "<h2>Cheeses</h2>\n<ul>\n";
my $qs = "SELECT ?resource ?label
WHERE {
?resource a <http://sw.opencyc.org/2008/06/10/concept/Mx4rwOD7mJwpEbGdrcN5Y29ycA> ;
<http://www.w3.org/2000/01/rdf-schema#label> ?label .
}";
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
my $items = {};
while (!$results->finished)
{
my $resource = $results->binding_value(0)->uri->as_string;
my $label = $results->binding_value(1)->literal_value;
$items->{$label} = sprintf(" <li><a href=\"?cheese=%s\">%s</a></li>\n",
escapeHTML(uri_escape($resource)),
escapeHTML($label));
$results->next_result;
}
foreach my $r (sort keys %$items)
{ $rv .= $items->{$r}; }
$rv .= "</ul>\n";
$rv .= "</div>\n";
$rv .= "<div style=\"width:30%;float:left;\">\n";
$rv .= "<h2>Members</h2>\n<ul about=\"#group\" rel=\"foaf:member\">\n";
my $qs = "SELECT ?resource ?label
WHERE {
<https://ophelia.g5n.co.uk:10443/cheese/#group> <http://xmlns.com/foaf/0.1/member> ?resource .
?resource <http://xmlns.com/foaf/0.1/name> ?label .
}";
my $query = RDF::Redland::Query->new($qs,
RDF::Redland::URI->new('https://ophelia.g5n.co.uk:10443/cheese/'),
undef,
'sparql');
my $results = $query->execute($self->{'data'});
my $items = {};
while (!$results->finished)
{
my $resource = $results->binding_value(0)->uri->as_string;
my $label = $results->binding_value(1)->literal_value;
$label = $resource unless $label =~ /[a-z0-9]/i;
$items->{$label.$resource} .= sprintf(" <li typeof=\"foaf:Agent\" about=\"%s\"><a property=\"foaf:name\" rel=\"foaf:page\" href=\"?member=%s\">%s</a></li>\n",
escapeHTML($resource),
escapeHTML(uri_escape($resource)),
escapeHTML($label));
$results->next_result;
}
foreach my $r (sort keys %$items)
{ $rv .= $items->{$r}; }
$rv .= "</ul>\n";
$rv .= "</div>\n";
return $rv;
}
sub apply_template
{
my $self = shift;
my $html = shift;
my $user = shift;
my $title = 'Untitled';
my $titleattr = '';
if ($html =~ m#<h1(\s*[^>]*)>(.+)</h1>#)
{
$titleattr = $1;
$title = $2;
$html =~ s#<h1(\s*[^>]*)>(.+)</h1>##;
}
# Some kind of weird bug somewhere. This fixes it.
$html =~ s/0\.000000/%2f/g;
my $menu = $self->make_menu($user);
my $string;
open DATA, "<:encoding(UTF-8)", 'template.html';
while (<DATA>) { $string .= $_; }
close DATA;
$string =~ s/<!--#TITLE#-->/$title/g;
$string =~ s/#TITLEATTR#/$titleattr/g;
$string =~ s/<!--#CONTENT#-->/$html/g;
$string =~ s/<!--#MENU#-->/$menu/g;
return $string;
}
sub make_menu
{
my $self = shift;
my $user = shift;
my $rv = "<ul>\n";
$rv .= " <li><a href=\"./\">Group Home</a></li>\n";
if ($self->has_member($user))
{
$rv .= sprintf(" <li><a href=\"?member=%s\">My Home</a></li>\n",
escapeHTML(uri_escape($user->identity)));
}
elsif (defined $user)
{
$rv .= " <li><a href=\"?action=join\">Join Club</a></li>\n";
}
$rv .= "</ul>\n";
return $rv;
}
1;