make-html/make-html.pl

   1 #!/usr/bin/perl
   2 #
   3 # Konvertiert die LUGS-Terminliste (im ASCII Format) in ein HTML-File
   4 #
   5 # (c) 1996-1998                     Roland Alder
   6 # (c) 2007-2008, 2011-2015, 2017    Steven Schubiger
   7
   8 use strict;
   9 use warnings;
  10 use lib qw(lib);
  11
  12 my $VERSION = '0.07';
  13
  14 #-----------------------
  15 # Start of configuration
  16 #-----------------------
  17
  18 #
  19 # If you're looking for the template,
  20 # it is contained below __DATA__ at the end
  21 # of this script.
  22 #
  23
  24 my $Config = {
  25     data_source => './termine.txt',
  26     html_file   => './index.phtml',
  27     colors      => {
  28        fremd         => 'a2eeff',       # blau/gruen
  29        treff         => '99ccff',       # ex http://www.zuerich.ch/
  30        seeland       => 'ffffbb',       # gelb
  31        aargau        => 'ffbbff',       # violett
  32        bern          => 'a5f6bb',       # gruen
  33        spec          => 'ff8a80',       # rot
  34        winti         => 'd6d6ce',       # ex http://www.stadt-winterthur.ch/
  35        innerschweiz  => '8abed7',       # ex http://www.luzern.ch/
  36        kreuzlingen   => 'f9f9f9',       # ehemals aargau (ex http://www.ag.ch/)
  37        stgallen      => 'e2b1a5',       # wie heisst diese Farbe? :)
  38        gnupingu      => 'ffd133',       # von http://www.gnupingu.ch/
  39        debian        => 'ffa500',       # orange
  40        hackerfunk    => '99b2cd',       # blau/grau
  41        wilhelmtux    => 'ffffbf',       # from https://wilhelmtux.ch/
  42     },
  43     ical_dir    => 'ical',
  44 };
  45
  46 #---------------------
  47 # End of configuration
  48 #---------------------
  49
  50 #-------------------
  51 # Start of internals
  52 #-------------------
  53
  54 {
  55     my $termine = LUGS::Termine::Liste->new;
  56
  57     $termine->init;
  58
  59     my ($html_before, $html_after) = $termine->extract_html;
  60     $termine->parse_template;
  61
  62     my $fh = $termine->{fh}{out};
  63
  64     print {$fh} $html_before;
  65     $termine->process_events;
  66     print {$fh} $html_after;
  67
  68     $termine->cleanup;
  69
  70     $termine->finalize;
  71 }
  72
  73 package LUGS::Termine::Liste;
  74
  75 use constant true => 1;
  76
  77 use File::Copy qw(copy);
  78 use File::Temp qw(tempfile);
  79 use LUGS::Events::Parser ();
  80
  81 # Return a new instance of our class.
  82 sub new
  83 {
  84     my $class = shift;
  85
  86     return bless {};
  87 }
  88
  89 # Open files and retrieve the modification time.
  90 sub init
  91 {
  92     my $self = shift;
  93
  94     $self->{mtime} = scalar localtime +(stat($Config->{data_source}))[9];
  95
  96     open($self->{fh}{in}, '<', $Config->{html_file}) or die "Cannot open $Config->{html_file}: $!\n";
  97     ($self->{fh}{out}, $self->{tmp_file}) = tempfile(UNLINK => true);
  98 }
  99
 100 # Close file handles.
 101 sub cleanup
 102 {
 103     my $self = shift;
 104
 105     foreach my $handle (qw(in out)) {
 106         close($self->{fh}{$handle});
 107     }
 108 }
 109
 110 # Copy the temporary file to the HTML file's location.
 111 sub finalize
 112 {
 113     my $self = shift;
 114
 115     copy($self->{tmp_file}, $Config->{html_file})
 116       or die "Cannot copy $self->{tmp_file} to $Config->{html_file}: $!\n";
 117 }
 118
 119 # Extract chunks before and after where the events get populated in.
 120 sub extract_html
 121 {
 122     my $self = shift;
 123
 124     my $fh = $self->{fh}{in};
 125     my $html = do { local $/; <$fh> };
 126
 127     my @regexes = (
 128         qr/^ (.+? \n<!-- \s*? TERMINE_BEGIN \s*? --> \s*? \n)/sx,
 129         qr/      \n(<!-- \s*? TERMINE_ENDE  \s*? --> .*)    $/sx,
 130     );
 131
 132     my @chunks;
 133     foreach my $regex (@regexes) {
 134         push @chunks, $1 if $html =~ $regex;
 135     }
 136
 137     return @chunks;
 138 }
 139
 140 # Dump regular events formatted to the output handle.
 141 sub process_events
 142 {
 143     my $self = shift;
 144
 145     my $parser = LUGS::Events::Parser->new($Config->{data_source});
 146
 147     my $i;
 148     my %month_names = map { sprintf("%02d", ++$i) => $_ }
 149       qw(Januar Februar M&auml;rz April Mai Juni Juli
 150          August September Oktober November Dezember);
 151
 152     my $seen ||= '';
 153     my $print_month = sub
 154     {
 155         my ($event) = @_;
 156
 157         my $year  = $event->get_event_year;
 158         my $month = $event->get_event_month;
 159         my $day   = $event->get_event_day;
 160
 161         if ($month ne $seen) {
 162             $seen = $month;
 163             $self->print_template('jahreszeit',
 164             {
 165                 MONAT => $month_names{$month},
 166                 JAHR  => $year,
 167             });
 168         }
 169     };
 170
 171     $self->print_template('tabellenstart');
 172     $self->print_template('kopfdaten');
 173
 174     while (my $event = $parser->next_event) {
 175         $print_month->($event);
 176
 177         my $anchor = $event->get_event_anchor;
 178
 179         $self->print_template('farbe',
 180         {
 181             FARBE => $Config->{colors}->{$event->get_event_color}
 182         });
 183
 184         $self->print_template('anker/wann',
 185         {
 186             ANKER     => $anchor,
 187             WOCHENTAG => $event->get_event_weekday,
 188             TAG       => $event->get_event_day,
 189         });
 190
 191         $event->get_event_time
 192           ? $self->print_template('zeit',
 193             {
 194                 UHRZEIT => $event->get_event_time,
 195             })
 196           : $self->print_template('blank');
 197
 198         $event->get_event_responsible
 199           ? $self->print_template('verantwortlich',
 200             {
 201                 WER => $event->get_event_responsible,
 202             })
 203           : $self->print_template('blank');
 204
 205         $self->print_template('titel',
 206         {
 207             BEZEICHNUNG => $event->get_event_title,
 208         });
 209
 210         $event->get_event_location
 211           ? $self->print_template('standort',
 212             {
 213                 STANDORT => $event->get_event_location,
 214             })
 215           : ();
 216
 217         $event->get_event_more
 218           ? $self->print_template('infos',
 219             {
 220                 INFORMATIONEN => $event->get_event_more,
 221             })
 222           : ();
 223
 224         my $ics_file = "$anchor.ics";
 225         my $ics_link = join '/', ($Config->{ical_dir}, $ics_file);
 226
 227         $self->print_template('ical/anker',
 228         {
 229             LINK  => $ics_link,
 230             ANKER => $anchor,
 231         });
 232
 233         $self->print_raw_html('</tr>');
 234     }
 235
 236     $self->print_template('tabellenende');
 237     $self->print_template('fussnoten',
 238     {
 239         AENDERUNG => $self->{mtime},
 240     });
 241 }
 242
 243 # Parse the template as outlined below __DATA__ and create
 244 # a lookup map.
 245 sub parse_template
 246 {
 247     my $self = shift;
 248
 249     my $template = do { local $/; <DATA> };
 250
 251     $self->{template} = [ map { s/\n{2,}$/\n/; $_ }        #  # description
 252                           grep /\S/,                       #  -
 253                           split /\# \s+? .+? \s+? -\n/x,
 254                           $template ];
 255       my @descriptions;
 256     push @descriptions, $1 while $template =~ /\# \s+? (.+?) \s+? -\n/gx;
 257
 258     my $i;
 259     $self->{lookup} = { map { $_ => $i++ } @descriptions };
 260 }
 261
 262 # Look up the template item, substitute it with the data
 263 # given and print it to the output handle.
 264 sub print_template
 265 {
 266     my $self = shift;
 267     my ($keyword, $data) = @_;
 268
 269     return unless exists $self->{lookup}->{$keyword};
 270
 271     my $item = $self->{template}->[$self->{lookup}->{$keyword}];
 272
 273     my %markers = (
 274         begin => '[%',
 275         end   => '%]',
 276     );
 277     foreach my $marker ($markers{begin}, $markers{end}) {
 278         $marker = qr/\Q$marker\E/;
 279     }
 280
 281     foreach my $name (keys %$data) {
 282         $item =~ s/$markers{begin}
 283                      \s*?
 284                        $name
 285                      \s*?
 286                    $markers{end}
 287                   /$data->{$name}/gx;
 288     }
 289
 290     my $fh = $self->{fh}{out};
 291     print {$fh} $item;
 292 }
 293
 294 # Print raw HTML to the output handle.
 295 sub print_raw_html
 296 {
 297     my $self = shift;
 298     my ($html) = @_;
 299
 300     my $fh = $self->{fh}{out};
 301     print {$fh} $html, "\n";
 302 }
 303
 304 #-----------------
 305 # End of internals
 306 #-----------------
 307
 308 #
 309 # Do not change the data descriptions within '# <name>' without
 310 # adjusting the code accordingly; furthermore, the hyphen '-'
 311 # is required and two trailing newlines at the end of the
 312 # template item, too.
 313 #
 314
 315 __DATA__
 316
 317 # tabellenstart
 318 -
 319 <table border=0 cellpadding=1 cellspacing=2>
 320
 321 # kopfdaten
 322 -
 323 <tr><td>&nbsp;</td></tr>
 324 <tr><td colspan=4 align=left><h2>Definitive Daten</h2></td></tr>
 325 <tr><th align=left>Tag</th><th align=left>Zeit</th><th align=left>Verantwortlich</th><th align=left>Anlass, Thema</th></tr>
 326
 327 # jahreszeit
 328 -
 329 <tr><th align=left colspan=3><br><font size="+1">[% MONAT %] [% JAHR %]</font></th></tr>
 330
 331 # anker
 332 -
 333 <a name="[% WERT %]"></a>
 334
 335 # farbe
 336 -
 337 <tr bgcolor="#[% FARBE %]">
 338
 339 # anker/wann
 340 -
 341 <td valign=top><a name="[% ANKER %]"></a>[% WOCHENTAG %], [% TAG %].</td>
 342
 343 # zeit
 344 -
 345 <td valign=top>[% UHRZEIT %]</td>
 346
 347 # verantwortlich
 348 -
 349 <td valign=top>[% WER %]</td>
 350
 351 # titel
 352 -
 353 <td valign=top><b>[% BEZEICHNUNG %]</b>
 354
 355 # standort
 356 -
 357 <br><font size=-1>[% STANDORT %]</font>
 358
 359 # infos
 360 -
 361 <br>[% INFORMATIONEN %]
 362
 363 # ical/anker
 364 -
 365 <td valign=top><a href="[% LINK %]">iCal</a><br><a href="#[% ANKER %]">#</a></td>
 366
 367 # tabellenende
 368 -
 369 </table>
 370
 371 # fussnoten
 372 -
 373 <p>
 374 <font size="-1">Alle Angaben ohne Gew&auml;hr, letzte &Auml;nderung der Terminliste: [% AENDERUNG %]</font>
 375
 376 # blank
 377 -
 378 <td>&nbsp;</td>