#!/usr/bin/perl # # Copyright © 2013 Jonas Smedegaard # 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 . 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 RDF::Trine 1.006; # we need proper IRI and punycode URI support 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, $urinode) = @_; return undef unless ($thing); return thingdescribe( $title, $thing->literal_value, node2uri($urinode) ); } sub node2uri { my $node = shift; return ($node) ? $node->uri_value : undef; } 1;