summaryrefslogtreecommitdiff
path: root/bin/rdf2hours
blob: 32b2f86e0f15b64afda524c2e373addfb52662e0 (plain)
  1. #!/usr/bin/perl
  2. #
  3. # Copyright © 2013 Jonas Smedegaard <dr@jones.dk>
  4. # Description: render opening hours webpage from RDF data
  5. #
  6. # This program is free software; you can redistribute it and/or modify
  7. # it under the terms of the GNU General Public License as published by
  8. # the Free Software Foundation; either version 3, or (at your option)
  9. # any later version.
  10. #
  11. # This program is distributed in the hope that it will be useful, but
  12. # WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  14. # General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  18. use 5.010;
  19. use strictures 1;
  20. use utf8::all;
  21. #use DDP alias => 'Dumper';
  22. use DateTimeX::Easy;
  23. use DateTime::Format::W3CDTF;
  24. use Carp;
  25. use Try::Tiny;
  26. use RDF::Query;
  27. use RDF::TrineX::Functions qw[curie model parse];
  28. use HTML::HTML5::Builder qw[:standard];
  29. use HTML::HTML5::Writer;
  30. # TODO: add options --verbose and --debug
  31. # TODO: add override options --theme and (multivalued) --category
  32. my @category = <<LIST =~ m/(\S.*\S)/g;
  33. full-meal food
  34. non-meal food
  35. <http://schema.org/GroceryStore>
  36. non-grocery store
  37. park or museum
  38. art
  39. transport
  40. public service
  41. LIST
  42. # TODO: add override options --from, --through and --theme
  43. #my $globalfrom = DateTimeX::Easy->new('now');
  44. # TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible words "current" and "present" (as alternatives to this)
  45. my $globalfrom = DateTimeX::Easy->new('first day of this month');
  46. # TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible these:
  47. # last day of month three months from now
  48. # last day of month in three months
  49. # last day of (the) month three months ahead
  50. # ... in the future
  51. # ... into the future
  52. # ... from now
  53. # ... later <- this last one for changing object, not create new
  54. #my $globalthrough = DateTimeX::Easy->new('last day of month in 3 months');
  55. my $globalthrough = DateTimeX::Easy->new($globalfrom);
  56. $globalthrough->add( months => 4 )->subtract( days => 1 );
  57. # TODO: add Getopt option --preset as shortcut to --category, --from and --through
  58. my $parser = RDF::Trine::Parser::Turtle->new;
  59. my $model = model();
  60. # TODO: throw sensible error if no (non-opt) args provided
  61. while (my $data = shift @ARGV) {
  62. try {
  63. parse($data, using => $parser, into => $model);
  64. } catch {
  65. say STDERR "Failed to parse file \"$data\": $_";
  66. die;
  67. }
  68. }
  69. # compose query for hourspec data at least partly within a "window" of time
  70. # (yes, comparing global dates against opposite spec dates is deliberate)
  71. # TODO: support transit:Schedule (as alternative to gr:hasOpeningHourSpecification)
  72. my $w3c = DateTime::Format::W3CDTF->new;
  73. my $query = qurie( sprintf(<<'SPARQL', $w3c->format_datetime($globalthrough), $w3c->format_datetime($globalfrom) ));
  74. SELECT *
  75. WHERE {
  76. {
  77. ?location
  78. # a schema:Place ;
  79. gr:category ?category ;
  80. gr:name ?name ;
  81. gr:hasOpeningHourSpecification ?spec .
  82. ?spec
  83. gr:opens ?opens ;
  84. gr:closes ?closes ;
  85. rdfs:label ?speclabel ;
  86. gr:validFrom ?specfrom ;
  87. gr:validThrough ?specthrough .
  88. OPTIONAL { ?spec rdfs:comment ?speccomment } .
  89. OPTIONAL { ?location gr:description ?locationcomment } .
  90. FILTER ( ?specfrom <= "%s"^^xsd:dateTime ) .
  91. FILTER ( ?specthrough > "%s"^^xsd:dateTime )
  92. } UNION {
  93. ?location
  94. gr:category ?category ;
  95. gr:name ?name ;
  96. gr:hasOpeningHourSpecification ?spec .
  97. ?spec
  98. gr:opens ?opens ;
  99. gr:closes ?closes .
  100. OPTIONAL {
  101. ?spec
  102. rdfs:label ?speclabel ;
  103. gr:validFrom ?specfrom ;
  104. gr:validThrough ?specthrough .
  105. } .
  106. OPTIONAL { ?spec rdfs:comment ?speccomment } .
  107. OPTIONAL { ?location gr:description ?locationcomment } .
  108. FILTER (!bound(?specfrom)) .
  109. FILTER (!bound(?specthrough))
  110. }
  111. }
  112. SPARQL
  113. # TODO: sort using SPARQL instead of perl
  114. # ORDER BY ?category ?name ?specfrom ?specthrough ?opens ?closes
  115. my %data;
  116. my $iterator = $query->execute($model);
  117. while ( my $row = $iterator->next ) {
  118. my $category = $row->{category}->as_string;
  119. my $name = $row->{name}->literal_value;
  120. my $locationcomment = $row->{locationcomment} ? $row->{locationcomment}->literal_value : '';
  121. my $speclabel = $row->{speclabel} ? $row->{speclabel}->literal_value : '';
  122. # Strip surrounding quotes
  123. $category =~ s/^"(.*)"$/$1/;
  124. # merge identically named locations, tying varying descriptions to spec instead
  125. # my $name_key = titledescribe( $name, $locationcomment );
  126. # my $specbundle_key = $speclabel;
  127. my $name_key = $name;
  128. my $specbundle_key = titledescribe( $speclabel, $locationcomment );
  129. my $specfrom = $row->{specfrom} ? $row->{specfrom}->datetime : '';
  130. my $specthrough = $row->{specthrough} ? $row->{specthrough}->datetime : '';
  131. my $speccomment = $row->{speccomment} ? $row->{speccomment}->literal_value : '';
  132. # TODO: use DateTime objects instead.
  133. my $opens = $row->{opens}->literal_value;
  134. $opens =~ s/:\d\d$//;
  135. my $closes = $row->{closes}->literal_value;
  136. $closes =~ s/:\d\d$//;
  137. $closes =~ s/^23:59/24/;
  138. my @weekdays;
  139. my $iterator = $model->get_statements($row->{spec}, curie('gr_hasOpeningHoursDayOfWeek'), undef);
  140. while (my $statement = $iterator->next) {
  141. my $label = $statement->object;
  142. given ($label->as_string) {
  143. when (/Monday/) { push @weekdays, 1 };
  144. when (/Tuesday/) { push @weekdays, 2 };
  145. when (/Wednesday/) { push @weekdays, 3 };
  146. when (/Thursday/) { push @weekdays, 4 };
  147. when (/Friday/) { push @weekdays, 5 };
  148. when (/Saturday/) { push @weekdays, 6 };
  149. when (/Sunday/) { push @weekdays, 7 };
  150. when (/PublicHolidays/) { push @weekdays, 8 };
  151. default { die "failed to parse weekday: ", $label->as_string };
  152. }
  153. }
  154. my $weekdays = join ', ', sort @weekdays;
  155. $weekdays = 0 unless ($weekdays);
  156. my $weekdays_key = titledescribe( $weekdays, $speccomment );
  157. $data{$category}{$name_key}{name} = $name;
  158. $data{$category}{$name_key}{specbundle}{$specbundle_key}{locationcomment} = $locationcomment;
  159. $data{$category}{$name_key}{specbundle}{$specbundle_key}{speclabel} = $speclabel;
  160. $data{$category}{$name_key}{specbundle}{$specbundle_key}{specfrom} = $specfrom;
  161. $data{$category}{$name_key}{specbundle}{$specbundle_key}{specthrough} = $specthrough;
  162. $data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{weekdays} = $weekdays;
  163. # TODO: extend SPARQL to cover specs without opens/closes, or drop below check
  164. if ($opens and $closes) {
  165. my $hours_key = $opens;
  166. $hours_key =~ s/\b(\d)\b/0$1/g;
  167. my $hourrange = "$opens - $closes";
  168. $data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{hours}{$hours_key} = $hourrange;
  169. $data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{speccomment} = $speccomment;
  170. }
  171. }
  172. my $title = 'Åbningstider';
  173. my $intro = sprintf(
  174. 'Åbningstider på Orø indenfor udvalgte kategorier, dækkende perioden %s.',
  175. daterangedescribe($globalfrom, $globalthrough),
  176. );
  177. # TODO: make simplified html (preferred for Scribus) optional
  178. #push my @content, h1($title), "\n", p($intro);
  179. push my @content, h1($title), "\n", $intro;
  180. # TODO: optionally merge items appearing in multiple categories
  181. for my $category ( @category ) {
  182. push @content, "\n", h2( categorydescribe($category) ), "\n";
  183. for my $name ( sort keys %{ $data{$category} } ) {
  184. push @content, "\n", h3($name);
  185. my @bundle = keys %{ $data{$category}{$name}{specbundle} };
  186. # FIXME: respect locale when sorting (Galleri before Gaardstronomi)
  187. for my $specbundle ( sort {
  188. $data{$category}{$name}{specbundle}{$a}{specfrom}
  189. <=> $data{$category}{$name}{specbundle}{$b}{specfrom}
  190. || $a cmp $b
  191. } @bundle ) {
  192. # TODO: when global limits shown, show only speclabel plural spec bundles
  193. my $speclabel = speclabeldescribe(
  194. $data{$category}{$name}{specbundle}{$specbundle}{speclabel},
  195. $data{$category}{$name}{specbundle}{$specbundle}{locationcomment},
  196. $data{$category}{$name}{specbundle}{$specbundle}{specfrom},
  197. $data{$category}{$name}{specbundle}{$specbundle}{specthrough},
  198. scalar @bundle,
  199. );
  200. push @content, "\n", h4($speclabel) if ($speclabel);
  201. my @specbundle;
  202. for my $weekdays ( sort keys %{ $data{$category}{$name}{specbundle}{$specbundle}{spec} } ) {
  203. my $specdescription = specdescribe(
  204. $data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{weekdays},
  205. $data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{speccomment},
  206. );
  207. push @specbundle, br if (@specbundle);
  208. my @hours;
  209. for my $hours ( sort keys %{ $data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{hours} } ) {
  210. # TODO: make simplified html (preferred for Scribus) optional
  211. # push @hours, br, "\n" if (@hours);
  212. push @hours, br if (@hours);
  213. push @hours, "\t", span(
  214. $data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{hours}{$hours}
  215. );
  216. }
  217. push @specbundle, "\n", span(
  218. span($specdescription, ":"), @hours,
  219. );
  220. }
  221. # TODO: make simplified html (preferred for Scribus) optional
  222. # push @content, p("\n", @specbundle) if (@specbundle);
  223. push @content, @specbundle if (@specbundle);
  224. }
  225. }
  226. }
  227. #Dumper %data;
  228. #die;
  229. my $writer = HTML::HTML5::Writer->new;
  230. say $writer->document( html(
  231. -lang => 'da',
  232. head(
  233. title($title),
  234. Meta(-charset => 'utf-8'),
  235. ),
  236. body(
  237. "\n", @content
  238. ),
  239. ));
  240. # create query object from curied SPARQL string
  241. sub qurie {
  242. my $sparql = shift;
  243. $sparql =~ s/(?<=\s|\^)([a-z]+):([a-zA-Z]+)(?=\s)/curie("$1_$2")/eg;
  244. my $query = RDF::Query->new( $sparql );
  245. if (!$query) {
  246. say STDERR $sparql;
  247. say STDERR RDF::Query->error;
  248. croak "failed to prepare SPARQL query";
  249. }
  250. return $query;
  251. }
  252. sub daterangedescribe {
  253. my ($from, $through) = @_;
  254. return sprintf( '%s - %s',
  255. $from->format_cldr('d/M'),
  256. $through->format_cldr('d/M'),
  257. );
  258. }
  259. sub categorydescribe {
  260. my $cat = shift;
  261. $cat =~ s!full-meal food!spisesteder!;
  262. $cat =~ s!non-meal food!caféer, slikbutikker o.l.!;
  263. $cat =~ s!<http://schema.org/GroceryStore>!dagligvarebutikker!;
  264. $cat =~ s!non-grocery store!øvrige butikker!;
  265. $cat =~ s!park or museum!parker og museer!;
  266. $cat =~ s!art!kunstudstillinger og gallerier!;
  267. $cat =~ s!public service!offentlige services!;
  268. return ucfirst($cat);
  269. }
  270. sub titledescribe {
  271. my ($title, $comment) = @_;
  272. return ($comment) ? "$title ($comment)" : $title;
  273. }
  274. sub speclabeldescribe {
  275. my ($label, $comment, $from, $through, $size) = @_;
  276. # TODO: support optionally enabling descriptive label
  277. my $compact = 1;
  278. return '' if ( ($compact) and ( $size == 1 ) );
  279. my $daterange = daterangedescribe($from, $through);
  280. if (($from) and ($through)) {
  281. return titledescribe( $daterange, $comment )
  282. if ($compact);
  283. return $label, ' (', $daterange, ' - ', $comment, ')'
  284. if ($comment);
  285. return $label, ' (', $daterange, ')';
  286. }
  287. warn "gr:validFrom and gr:validThrough missing for label \"$label\"";
  288. return ($compact) ? '' : titledescribe( $label, $comment );
  289. }
  290. sub specdescribe {
  291. my ($weekdays, $comment) = @_;
  292. # TODO: translate properly
  293. $weekdays =~ s/1, 2, 3, 4, 5, 6, 7/alle ugedage/;
  294. $weekdays =~ s/1, 2, 3, 4, 5/mandag-fredag/;
  295. $weekdays =~ s/1, 2, 3, 4/mandag-torsdag/;
  296. $weekdays =~ s/2, 3, 4, 5, 6, 7/tirsdag-søndag/;
  297. $weekdays =~ s/3, 4, 5/onsdag-fredag/;
  298. $weekdays =~ s/^2, 3, 4(|, [^5].*)$/tirsdag-torsdag$1/;
  299. $weekdays =~ s/^(|.*?[\d^5], |.*?(?!fredag, ))6, 7(.*)$/$1weekend$2/;
  300. $weekdays =~ s/1/mandag/;
  301. $weekdays =~ s/2/tirsdag/;
  302. $weekdays =~ s/3/onsdag/;
  303. $weekdays =~ s/4/torsdag/;
  304. $weekdays =~ s/5/fredag/;
  305. $weekdays =~ s/6/lørdag/;
  306. $weekdays =~ s/7/søndag/;
  307. $weekdays =~ s/8/helligdage/;
  308. if ( $weekdays eq "0" and ($comment) ) {
  309. return $comment;
  310. }
  311. return titledescribe( $weekdays, $comment );
  312. }
  313. 1;