- #!/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 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;
|