summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorJonas Smedegaard <dr@jones.dk>2013-05-20 23:37:32 +0200
committerJonas Smedegaard <dr@jones.dk>2013-05-20 23:37:32 +0200
commitc2f6227e773263be2aeaf65057c01aac9d1b101b (patch)
treeb0f72764b5b29c5760a41e4a05bf4040acc0ef1e /bin
Initial commit.
Diffstat (limited to 'bin')
-rwxr-xr-xbin/rdf2events213
-rwxr-xr-xbin/rdf2hours336
2 files changed, 549 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;
diff --git a/bin/rdf2hours b/bin/rdf2hours
new file mode 100755
index 0000000..dea675a
--- /dev/null
+++ b/bin/rdf2hours
@@ -0,0 +1,336 @@
+#!/usr/bin/perl
+#
+# Copyright © 2013 Jonas Smedegaard <dr@jones.dk>
+# Description: render opening hours 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::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 --theme and (multivalued) --category
+my @category = <<LIST =~ m/(\S.*\S)/g;
+ restaurant
+ groceries
+ attraction
+ transport
+ public service
+LIST
+
+# 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;
+ }
+}
+
+# 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 $query = qurie( sprintf(<<'SPARQL', $w3c->format_datetime($globalthrough), $w3c->format_datetime($globalfrom) ));
+SELECT *
+WHERE {
+ {
+ ?location
+ a schema:Place ;
+ gr:category ?category ;
+ gr:name ?name ;
+ gr:hasOpeningHourSpecification ?spec .
+ ?spec
+ gr:opens ?opens ;
+ gr:closes ?closes ;
+ rdfs:label ?speclabel ;
+ gr:validFrom ?specfrom ;
+ gr:validThrough ?specthrough .
+ OPTIONAL { ?spec rdfs:comment ?speccomment } .
+ OPTIONAL { ?location gr:description ?locationcomment } .
+ FILTER ( ?specfrom <= "%s"^^xsd:dateTime ) .
+ FILTER ( ?specthrough > "%s"^^xsd:dateTime )
+ } UNION {
+ ?location
+ gr:category ?category ;
+ gr:name ?name ;
+ gr:hasOpeningHourSpecification ?spec .
+ ?spec
+ gr:opens ?opens ;
+ gr:closes ?closes .
+ OPTIONAL {
+ ?spec
+ rdfs:label ?speclabel ;
+ gr:validFrom ?specfrom ;
+ gr:validThrough ?specthrough .
+ } .
+ OPTIONAL { ?spec rdfs:comment ?speccomment } .
+ OPTIONAL { ?location gr:description ?locationcomment } .
+ FILTER (!bound(?specfrom)) .
+ FILTER (!bound(?specthrough))
+ }
+}
+SPARQL
+# TODO: sort using SPARQL instead of perl
+# ORDER BY ?category ?name ?specfrom ?specthrough ?opens ?closes
+
+my %data;
+my $iterator = $query->execute($model);
+while ( my $row = $iterator->next ) {
+ my $category = $row->{category}->literal_value;
+ my $name = $row->{name}->literal_value;
+ my $locationcomment = $row->{locationcomment} ? $row->{locationcomment}->literal_value : '';
+
+ my $speclabel = $row->{speclabel} ? $row->{speclabel}->literal_value : '';
+
+ # merge identically named locations, tying varying descriptions to spec instead
+# my $name_key = titledescribe( $name, $locationcomment );
+# my $specbundle_key = $speclabel;
+ my $name_key = $name;
+ my $specbundle_key = titledescribe( $speclabel, $locationcomment );
+
+ my $specfrom = $row->{specfrom} ? $row->{specfrom}->datetime : '';
+ my $specthrough = $row->{specthrough} ? $row->{specthrough}->datetime : '';
+
+ my $speccomment = $row->{speccomment} ? $row->{speccomment}->literal_value : '';
+
+ # TODO: use DateTime objects instead.
+ my $opens = $row->{opens}->literal_value;
+ $opens =~ s/:\d\d$//;
+ my $closes = $row->{closes}->literal_value;
+ $closes =~ s/:\d\d$//;
+ $closes =~ s/^23:59/24/;
+
+ my @weekdays;
+ my $iterator = $model->get_statements($row->{spec}, curie('gr_hasOpeningHoursDayOfWeek'), undef);
+ while (my $statement = $iterator->next) {
+ my $label = $statement->object;
+
+ given ($label->as_string) {
+ when (/Monday/) { push @weekdays, 1 };
+ when (/Tuesday/) { push @weekdays, 2 };
+ when (/Wednesday/) { push @weekdays, 3 };
+ when (/Thursday/) { push @weekdays, 4 };
+ when (/Friday/) { push @weekdays, 5 };
+ when (/Saturday/) { push @weekdays, 6 };
+ when (/Sunday/) { push @weekdays, 7 };
+ when (/PublicHolidays/) { push @weekdays, 8 };
+ default { die "failed to parse weekday: ", $label->as_string };
+ }
+ }
+ my $weekdays = join ', ', sort @weekdays;
+ $weekdays = 0 unless ($weekdays);
+ my $weekdays_key = titledescribe( $weekdays, $speccomment );
+
+# FIXME: support multiple specbundles on same days (e.g. Gaardstronomi sommer siesta)
+# $weekdays_key .= daterangedescribe($specfrom, $specthrough)
+# if ( ($specfrom) and ($specthrough) );
+
+ $data{$category}{$name_key}{name} = $name;
+ $data{$category}{$name_key}{specbundle}{$specbundle_key}{locationcomment} = $locationcomment;
+ $data{$category}{$name_key}{specbundle}{$specbundle_key}{speclabel} = $speclabel;
+ $data{$category}{$name_key}{specbundle}{$specbundle_key}{specfrom} = $specfrom;
+ $data{$category}{$name_key}{specbundle}{$specbundle_key}{specthrough} = $specthrough;
+ $data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{weekdays} = $weekdays;
+ # TODO: extend SPARQL to cover specs without opens/closes, or drop below check
+ if ($opens and $closes) {
+ $data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{spec} = "$opens - $closes";
+ $data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{speccomment} = $speccomment;
+ }
+}
+
+my $title = 'Åbningstider';
+my $intro = sprintf(
+ 'Åbningstider på Orø indenfor udvalgte kategorier, dækkende perioden %s.',
+ daterangedescribe($globalfrom, $globalthrough),
+);
+
+# TODO: make simplified html (preferred for Scribus) optional
+#push my @content, h1($title), "\n", p($intro);
+push my @content, h1($title), "\n", $intro;
+
+for my $category ( @category ) {
+ push @content, "\n", h2( categorydescribe($category) ), "\n";
+ for my $name ( sort keys %{ $data{$category} } ) {
+ push @content, "\n", h3($name);
+ my @bundle = keys %{ $data{$category}{$name}{specbundle} };
+ # FIXME: respect locale when sorting (Galleri before Gaardstronomi)
+ for my $specbundle ( sort {
+ $data{$category}{$name}{specbundle}{$a}{specfrom}
+ <=> $data{$category}{$name}{specbundle}{$b}{specfrom}
+ || $a cmp $b
+ } @bundle ) {
+ # TODO: when global limits shown, show only speclabel plural spec bundles
+ my $speclabel = speclabeldescribe(
+ $data{$category}{$name}{specbundle}{$specbundle}{speclabel},
+ $data{$category}{$name}{specbundle}{$specbundle}{locationcomment},
+ $data{$category}{$name}{specbundle}{$specbundle}{specfrom},
+ $data{$category}{$name}{specbundle}{$specbundle}{specthrough},
+ scalar @bundle,
+ );
+ push @content, "\n", h4($speclabel) if ($speclabel);
+ my @specbundle;
+ for my $weekdays ( sort keys %{ $data{$category}{$name}{specbundle}{$specbundle}{spec} } ) {
+ my $specdescription = specdescribe(
+ $data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{weekdays},
+ $data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{speccomment},
+ );
+ push @specbundle, br if (@specbundle);
+ push @specbundle, "\n", span(
+ span($specdescription, ":"),
+ "\t",
+ span($data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{spec}),
+ );
+ }
+ # TODO: make simplified html (preferred for Scribus) optional
+# push @content, p("\n", @specbundle) if (@specbundle);
+ push @content, @specbundle if (@specbundle);
+ }
+ }
+}
+
+#Dumper %data;
+#die;
+
+my $writer = HTML::HTML5::Writer->new;
+say $writer->document( html(
+ -lang => 'da',
+ head(
+ title($title),
+ Meta(-charset => 'utf-8'),
+ ),
+ body(
+ "\n", @content
+ ),
+));
+
+# create query object from curied SPARQL string
+sub qurie {
+ my $sparql = shift;
+ $sparql =~ s/(?<=\s|\^)([a-z]+):([a-zA-Z]+)(?=\s)/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 sprintf( '%s - %s',
+ $from->format_cldr('d/M'),
+ $through->format_cldr('d/M'),
+ );
+}
+
+sub categorydescribe {
+ my $cat = shift;
+
+ $cat =~ s/restaurant/spisesteder/;
+ $cat =~ s/groceries/dagligvarer/;
+ $cat =~ s/attraction/attraktioner og museer/;
+ $cat =~ s/public service/offentlige services/;
+
+ return ucfirst($cat);
+}
+
+sub titledescribe {
+ my ($title, $comment) = @_;
+
+ return ($comment) ? "$title ($comment)" : $title;
+}
+
+sub speclabeldescribe {
+ my ($label, $comment, $from, $through, $size) = @_;
+
+ # TODO: support optionally enabling descriptive label
+ my $compact = 1;
+
+ return '' if ( ($compact) and ( $size == 1 ) );
+
+ my $daterange = daterangedescribe($from, $through);
+ if (($from) and ($through)) {
+ return titledescribe( $daterange, $comment )
+ if ($compact);
+ return $label, ' (', $daterange, ' - ', $comment, ')'
+ if ($comment);
+ return $label, ' (', $daterange, ')';
+ }
+ warn "gr:validFrom and gr:validThrough missing for label \"$label\"";
+ return ($compact) ? '' : titledescribe( $label, $comment );
+}
+
+sub specdescribe {
+ my ($weekdays, $comment) = @_;
+
+ # TODO: translate properly
+ $weekdays =~ s/1, 2, 3, 4, 5, 6, 7/alle ugedage/;
+ $weekdays =~ s/1, 2, 3, 4, 5/mandag-fredag/;
+ $weekdays =~ s/1, 2, 3, 4/mandag-torsdag/;
+ $weekdays =~ s/2, 3, 4, 5, 6, 7/tirsdag-søndag/;
+ $weekdays =~ s/3, 4, 5/onsdag-fredag/;
+ $weekdays =~ s/^2, 3, 4(|, [^5].*)$/tirsdag-torsdag$1/;
+ $weekdays =~ s/^(|.*?[\d^5], |.*?(?!fredag, ))6, 7(.*)$/$1weekend$2/;
+ $weekdays =~ s/1/mandag/;
+ $weekdays =~ s/2/tirsdag/;
+ $weekdays =~ s/3/onsdag/;
+ $weekdays =~ s/4/torsdag/;
+ $weekdays =~ s/5/fredag/;
+ $weekdays =~ s/6/lørdag/;
+ $weekdays =~ s/7/søndag/;
+ $weekdays =~ s/8/helligdage/;
+
+ if ( $weekdays eq "0" and ($comment) ) {
+ return $comment;
+ }
+ return titledescribe( $weekdays, $comment );
+}
+
+1;