#!/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 = "

Problem: 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 test.foafssl.org definitely do!

\n"; if (defined $auth && defined $auth->agent) { $errormsg .= "

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 this message for details.

\n"; } print $cgi->header("text/html; charset=utf-8"); print $group->apply_template("

Not Authenticated

\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 { ?label ; ?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 "

Unknown Cheese

\n

Could not find information on this cheese.

\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 { ?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 { ?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("

%s

\n" . "
\n" . "\t

Origin: %s

\n" . "\t\"Photograph\n" . "\t

More information: %s

\n" . "
\n" . "

People Who Like This Cheese

\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 ?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'}); my $count = 0; my $meLike = 0; while (! $results->finished) { $rv .= "
    {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("
  • %s
  • \n", escapeHTML($person), escapeHTML(uri_escape($person)), escapeHTML($name)); $meLike++ if $person eq $user->identity; $results->next_result; } if ($count) { $rv .= "
\n"; } else { $rv .= "

Nobody.

\n"; } if ($self->{'group'}->has_member($user)) { if ($meLike) { $rv = sprintf("

You've told us you like this cheese. Remove it from your favourites.

\n$rv", escapeHTML(uri_escape($self->{'identity'}))); } else { $rv = sprintf("

Do you like this cheese? Add it to your favourites.

\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 ; ?label ; ?page . OPTIONAL { ?resource ?depiction . } OPTIONAL { ?resource ?country . ?country ?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 "

Refresh Cheeses

\n

Successful.

\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 { ?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 "

Unknown Member

\n

Could not find information on this member.

\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 { ?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 { ?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 { ?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("

%s

\n" . "
\n" . (defined $page ? "\t

Homepage: $page

\n" : '') . (defined $mbox ? "\t

E-mail: $mbox

\n" : '') . "\t\"Photograph\n" . "
\n" . "

Favourite Cheeses

\n" , escapeHTML($self->{'identity'}) , escapeHTML($label) , escapeHTML($self->{'identity'}) , escapeHTML($depiction) , escapeHTML($label)); my $qs = "SELECT ?label ?cheese WHERE { ?cheese . ?cheese ?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 .= "
    {'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("
  • %s
  • \n", escapeHTML($cheese), escapeHTML(uri_escape($cheese)), escapeHTML($label)); $results->next_result; } if ($count) { $rv .= "
\n"; } else { $rv .= "

None.

\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 { . }"; $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 "

cheese.nt written.

" } } sub html { my $self = shift; my $rv = "

#swig Cheese Lovers' Club

\n"; $rv .= "
\n"; $rv .= "

Cheeses

\n
    \n"; my $qs = "SELECT ?resource ?label WHERE { ?resource a ; ?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("
  • %s
  • \n", escapeHTML(uri_escape($resource)), escapeHTML($label)); $results->next_result; } foreach my $r (sort keys %$items) { $rv .= $items->{$r}; } $rv .= "
\n"; $rv .= "
\n"; $rv .= "
\n"; $rv .= "

Members

\n
    \n"; my $qs = "SELECT ?resource ?label WHERE { ?resource . ?resource ?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("
  • %s
  • \n", escapeHTML($resource), escapeHTML(uri_escape($resource)), escapeHTML($label)); $results->next_result; } foreach my $r (sort keys %$items) { $rv .= $items->{$r}; } $rv .= "
\n"; $rv .= "
\n"; return $rv; } sub apply_template { my $self = shift; my $html = shift; my $user = shift; my $title = 'Untitled'; my $titleattr = ''; if ($html =~ m#]*)>(.+)#) { $titleattr = $1; $title = $2; $html =~ s#]*)>(.+)##; } # 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 () { $string .= $_; } close DATA; $string =~ s//$title/g; $string =~ s/#TITLEATTR#/$titleattr/g; $string =~ s//$html/g; $string =~ s//$menu/g; return $string; } sub make_menu { my $self = shift; my $user = shift; my $rv = "
    \n"; $rv .= "
  • Group Home
  • \n"; if ($self->has_member($user)) { $rv .= sprintf("
  • My Home
  • \n", escapeHTML(uri_escape($user->identity))); } elsif (defined $user) { $rv .= "
  • Join Club
  • \n"; } $rv .= "
\n"; return $rv; } 1;