path: root/bin/rdf2events

#!/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, $uri) = @_;

    return undef unless ($thing);
    return thingdescribe( $title, $thing->literal_value, undef )
        unless ($uri);
    return thingdescribe( $title, $thing->literal_value, node2uri($uri) );
}

sub node2uri {
    my $node = shift;

    return ($node) ? $node->uri_value : undef;
}

1;