summaryrefslogtreecommitdiff
path: root/bin/rdf2events
blob: a66b517985cde0a7abd8cebd8da7a9d1c5b6c996 (plain)
  1. #!/usr/bin/perl
  2. #
  3. # Copyright © 2013 Jonas Smedegaard <dr@jones.dk>
  4. # Description: render events 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::Trine 1.006; # we need proper IRI and punycode URI support
  27. use RDF::Query;
  28. use RDF::TrineX::Functions qw[curie model parse];
  29. use HTML::HTML5::Builder qw[:standard];
  30. use HTML::HTML5::Writer;
  31. # TODO: add options --verbose and --debug
  32. # TODO: add override options --from, --through and --theme
  33. #my $globalfrom = DateTimeX::Easy->new('now');
  34. # TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible words "current" and "present" (as alternatives to this)
  35. my $globalfrom = DateTimeX::Easy->new('first day of this month');
  36. # TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible these:
  37. # last day of month three months from now
  38. # last day of month in three months
  39. # last day of (the) month three months ahead
  40. # ... in the future
  41. # ... into the future
  42. # ... from now
  43. # ... later <- this last one for changing object, not create new
  44. #my $globalthrough = DateTimeX::Easy->new('last day of month in 3 months');
  45. my $globalthrough = DateTimeX::Easy->new($globalfrom);
  46. $globalthrough->add( months => 4 )->subtract( days => 1 );
  47. # TODO: add Getopt option --preset as shortcut to --category, --from and --through
  48. my $parser = RDF::Trine::Parser::Turtle->new;
  49. my $model = model();
  50. # TODO: throw sensible error if no (non-opt) args provided
  51. while (my $data = shift @ARGV) {
  52. try {
  53. parse($data, using => $parser, into => $model);
  54. } catch {
  55. say STDERR "Failed to parse file \"$data\": $_";
  56. die;
  57. }
  58. }
  59. # TODO: handle multi-site events-in-events (e.g. Orødagen)
  60. # compose query for hourspec data at least partly within a "window" of time
  61. # (yes, comparing global dates against opposite spec dates is deliberate)
  62. my $w3c = DateTime::Format::W3CDTF->new;
  63. my $globalfrom_w3c = $w3c->format_datetime($globalfrom);
  64. my $globalthrough_w3c = $w3c->format_datetime($globalthrough);
  65. # TODO: restructure SPARQL query to only need injecting each date once
  66. my $query = qurie( sprintf(<<'SPARQL', $globalfrom_w3c, $globalthrough_w3c, $globalfrom_w3c, $globalthrough_w3c ));
  67. SELECT *
  68. WHERE {
  69. ?event
  70. a schema:SocialEvent ;
  71. schema:name ?eventname ;
  72. schema:location ?place ;
  73. schema:startDate ?start .
  74. ?place
  75. a schema:Place ;
  76. gr:name|schema:name ?placename .
  77. OPTIONAL {
  78. ?event schema:endDate ?end .
  79. }
  80. OPTIONAL {
  81. ?event foaf:Homepage ?eventpage .
  82. }
  83. OPTIONAL {
  84. { ?organizer a schema:Organization }
  85. UNION
  86. { ?organizer a gr:BusinessEntity }
  87. ?organizer
  88. gr:name|schema:name ?organizername ;
  89. schema:event ?event .
  90. OPTIONAL {
  91. ?organizer foaf:Homepage ?organizerpage .
  92. }
  93. }
  94. OPTIONAL {
  95. { ?host a schema:Organization }
  96. UNION
  97. { ?host a gr:BusinessEntity }
  98. ?host
  99. gr:name|schema:name ?hostname ;
  100. schema:location ?place .
  101. OPTIONAL {
  102. ?host foaf:Homepage ?hostpage .
  103. }
  104. } .
  105. FILTER (
  106. ( ! bound(?end) && ?start >= "%s"^^xsd:dateTime && ?start <= "%s"^^xsd:dateTime )
  107. ||
  108. ( ?start < ?end && ?end > "%s"^^xsd:dateTime && ?start <= "%s"^^xsd:dateTime )
  109. )
  110. }
  111. ORDER BY ?start ?eventname ?placename
  112. SPARQL
  113. # FILTER ( ?start > "%s"^^xsd:dateTime && ?start <= "%s"^^xsd:dateTime )
  114. my $title = 'Begivenheder';
  115. my $intro = sprintf(
  116. 'Begivenheder på Orø i perioden %s.',
  117. daterangedescribe($globalfrom, $globalthrough),
  118. );
  119. # TODO: make simplified html (preferred for Scribus) optional
  120. #push my @content, "\n", h1($title), p($intro);
  121. push my @content, "\n", h1($title), $intro;
  122. my $iterator = $query->execute($model);
  123. while ( my $row = $iterator->next ) {
  124. # TODO: iterate over potentially plural entries
  125. # TODO: include also foaf:page, and support multiple pages
  126. # TODO: handle dcterms:audience (including lack thereof)
  127. push @content, "\n", h2($row->{eventname}->literal_value);
  128. push @content, thingdescribe( 'Begivenhed', daterangedescribe( $row->{start}->datetime, $row->{end} ? $row->{end}->datetime : '' ), node2uri($row->{eventpage}) );
  129. push @content, objectdescribe( 'Sted', $row->{placename}, $row->{placepage} );
  130. push @content, objectdescribe( 'Vært', $row->{hostname}, $row->{hostpage} );
  131. push @content, objectdescribe( 'Arrangør', $row->{organizername}, $row->{organizerpage} );
  132. }
  133. my $writer = HTML::HTML5::Writer->new;
  134. say $writer->document( html(
  135. -lang => 'da',
  136. head(
  137. title($title),
  138. Meta(-charset => 'utf-8'),
  139. ),
  140. body(
  141. @content
  142. ),
  143. ));
  144. # create query object from curied SPARQL string
  145. sub qurie {
  146. my $sparql = shift;
  147. $sparql =~ s/\b([a-z]+):([a-zA-Z]+)\b/curie("$1_$2")/eg;
  148. my $query = RDF::Query->new( $sparql );
  149. if (!$query) {
  150. say STDERR $sparql;
  151. say STDERR RDF::Query->error;
  152. croak "failed to prepare SPARQL query";
  153. }
  154. return $query;
  155. }
  156. sub daterangedescribe {
  157. my ($from, $through) = @_;
  158. return $from->format_cldr('d/M')
  159. unless ($through);
  160. return sprintf( '%s - %s',
  161. $from->format_cldr('d/M'),
  162. $through->format_cldr('d/M'),
  163. );
  164. }
  165. sub thingdescribe {
  166. my ($title, $thing, $uri) = @_;
  167. my $string;
  168. return undef unless ($thing);
  169. $string = ($uri)
  170. ? a('-href', $uri, $thing)
  171. : $thing;
  172. return "\n", br, div( "$title: ", $string );
  173. }
  174. sub objectdescribe {
  175. my ($title, $thing, $urinode) = @_;
  176. return undef unless ($thing);
  177. return thingdescribe( $title, $thing->literal_value, node2uri($urinode) );
  178. }
  179. sub node2uri {
  180. my $node = shift;
  181. return ($node) ? $node->uri_value : undef;
  182. }
  183. 1;