Initial commit.

1 files changed, 213 insertions, 0 deletions

diff --git a/bin/rdf2events b/bin/rdf2events
new file mode 100755
index 0000000..865afe9
--- /dev/null
+++ b/bin/rdf2events
@@ -0,0 +1,213 @@
+#!/usr/bin/perl
+#
+# Copyright © 2013 Jonas Smedegaard <dr@jones.dk>
+# Description: render events webpage from RDF data
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use 5.010;
+use strictures 1;
+use utf8::all;
+#use DDP alias => 'Dumper';
+
+use DateTimeX::Easy;
+use DateTime::Format::W3CDTF;
+use Carp;
+use Try::Tiny;
+use URI;
+use RDF::Query;
+use RDF::TrineX::Functions qw[curie model parse];
+use HTML::HTML5::Builder qw[:standard];
+use HTML::HTML5::Writer;
+
+# TODO: add options --verbose and --debug
+
+# TODO: add override options --from, --through and --theme
+#my $globalfrom = DateTimeX::Easy->new('now');
+# TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible words "current" and "present" (as alternatives to this)
+my $globalfrom = DateTimeX::Easy->new('first day of this month');
+# TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible these:
+#  last day of month three months from now
+#  last day of month in three months
+#  last day of (the) month three months ahead
+#  ... in the future
+#  ... into the future
+#  ... from now
+#  ... later <- this last one for changing object, not create new
+#my $globalthrough = DateTimeX::Easy->new('last day of month in 3 months');
+my $globalthrough = DateTimeX::Easy->new($globalfrom);
+$globalthrough->add( months => 4 )->subtract( days => 1 );
+
+# TODO: add Getopt option --preset as shortcut to --category, --from and --through
+
+my $parser = RDF::Trine::Parser::Turtle->new;
+my $model = model();
+
+# TODO: throw sensible error if no (non-opt) args provided
+while (my $data = shift @ARGV) {
+	try {
+		parse($data, using => $parser, into => $model);
+	} catch {
+		say STDERR "Failed to parse file \"$data\": $_";
+		die;
+	}
+}
+
+# TODO: handle multi-site events-in-events (e.g. Orødagen)
+
+# compose query for hourspec data at least partly within a "window" of time
+# (yes, comparing global dates against opposite spec dates is deliberate)
+my $w3c = DateTime::Format::W3CDTF->new;
+my $globalfrom_w3c = $w3c->format_datetime($globalfrom);
+my $globalthrough_w3c = $w3c->format_datetime($globalthrough);
+# TODO: restructure SPARQL query to only need injecting each date once
+my $query = qurie( sprintf(<<'SPARQL', $globalfrom_w3c, $globalthrough_w3c, $globalfrom_w3c, $globalthrough_w3c ));
+SELECT *
+WHERE {
+	?event
+		a schema:SocialEvent ;
+		schema:name ?eventname ;
+		schema:location ?place ;
+		schema:startDate ?start .
+	?place
+		a schema:Place ;
+		gr:name|schema:name ?placename .
+	OPTIONAL {
+		?event schema:endDate ?end .
+	}
+	OPTIONAL {
+		?event foaf:Homepage ?eventpage .
+	}
+	OPTIONAL {
+		{ ?organizer a schema:Organization }
+		UNION
+		{ ?organizer a gr:BusinessEntity }
+		?organizer
+			gr:name|schema:name ?organizername ;
+			schema:event ?event .
+		OPTIONAL {
+			?organizer foaf:Homepage ?organizerpage .
+		}
+	}
+	OPTIONAL {
+		{ ?host a schema:Organization }
+		UNION
+		{ ?host a gr:BusinessEntity }
+		?host
+			gr:name|schema:name ?hostname ;
+			schema:location ?place .
+		OPTIONAL {
+			?host foaf:Homepage ?hostpage .
+		}
+	} .
+	FILTER (
+		( ! bound(?end) && ?start >= "%s"^^xsd:dateTime && ?start <= "%s"^^xsd:dateTime )
+	||
+		( ?start < ?end && ?end > "%s"^^xsd:dateTime && ?start <= "%s"^^xsd:dateTime )
+	)
+}
+ORDER BY ?start ?eventname ?placename
+SPARQL
+#	FILTER ( ?start > "%s"^^xsd:dateTime && ?start <= "%s"^^xsd:dateTime )
+
+my $title = 'Begivenheder';
+my $intro = sprintf(
+	'Begivenheder på Orø i perioden %s.',
+	daterangedescribe($globalfrom, $globalthrough),
+);
+
+# TODO: make simplified html (preferred for Scribus) optional
+#push my @content, "\n", h1($title), p($intro);
+push my @content, "\n", h1($title), $intro;
+
+my $iterator = $query->execute($model);
+while ( my $row = $iterator->next ) {
+
+	# TODO: iterate over potentially plural entries
+	# TODO: include also foaf:page, and support multiple pages
+	# TODO: handle dcterms:audience (including lack thereof)
+	push @content, "\n", h2($row->{eventname}->literal_value);
+	push @content, thingdescribe( 'Begivenhed', daterangedescribe( $row->{start}->datetime, $row->{end} ? $row->{end}->datetime : '' ), node2uri($row->{eventpage}) );
+	push @content, objectdescribe( 'Sted', $row->{placename}, $row->{placepage} );
+	push @content, objectdescribe( 'Vært', $row->{hostname}, $row->{hostpage} );
+	push @content, objectdescribe( 'Arrangør', $row->{organizername}, $row->{organizerpage} );
+}
+
+my $writer = HTML::HTML5::Writer->new;
+say $writer->document( html(
+	-lang => 'da',
+	head(
+		title($title),
+		Meta(-charset => 'utf-8'),
+	),
+	body(
+		@content
+	),
+));
+
+# create query object from curied SPARQL string
+sub qurie {
+	my $sparql = shift;
+	$sparql =~ s/\b([a-z]+):([a-zA-Z]+)\b/curie("$1_$2")/eg;
+	my $query = RDF::Query->new( $sparql );
+	if (!$query) {
+		say STDERR $sparql;
+		say STDERR RDF::Query->error;
+		croak "failed to prepare SPARQL query";
+	}
+	return $query;
+}
+
+sub daterangedescribe {
+	my ($from, $through) = @_;
+
+	return $from->format_cldr('d/M')
+		unless ($through);
+	return sprintf( '%s - %s',
+		$from->format_cldr('d/M'),
+		$through->format_cldr('d/M'),
+	);
+}
+
+sub thingdescribe {
+	my ($title, $thing, $uri) = @_;
+	my $string;
+
+	return undef unless ($thing);
+
+	$string = ($uri)
+		? a('-href', $uri, $thing)
+		: $thing;
+
+	return "\n", br, div( "$title: ", $string );
+}
+
+sub objectdescribe {
+	my ($title, $thing, $uri) = @_;
+
+	return undef unless ($thing);
+	return thingdescribe( $title, $thing->literal_value, undef )
+		unless ($uri);
+	return thingdescribe( $title, $thing->literal_value, node2uri($uri) );
+}
+
+# TODO: report as bug against RDF::Trine RDF::Trine::Node->uri_value not utf8
+#  i.e. choking on punycode if fed to HTML::HTML5::Builder
+sub node2uri {
+	my $node = shift;
+
+	return ($node) ? URI->new($node->uri_value)->as_string : undef;
+}
+
+1;