diff options
Diffstat (limited to 'bin/rdf2hours')
| -rwxr-xr-x | bin/rdf2hours | 336 |
1 files changed, 336 insertions, 0 deletions
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; |