make-ical/make-ical.pl

   1 #!/usr/bin/perl
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  16 #
  17 # Author: Steven Schubiger <stsc@refcnt.org>
  18 # Last modified: Fri Apr 17 23:12:38 CEST 2015
  19
  20 use strict;
  21 use warnings;
  22 use lib qw(lib);
  23
  24 my $VERSION = '0.03';
  25
  26 my $Config = {
  27     base_url => 'http://www.lugs.ch/lugs/termine',
  28     input    => './termine.txt',
  29     ical_dir => 'ical',
  30     offset   => undef,
  31 };
  32
  33 {
  34     mkdir $Config->{ical_dir} unless -e $Config->{ical_dir};
  35
  36     my $ical = LUGS::Termine::ICal->new;
  37     $ical->process_events;
  38 }
  39
  40 package LUGS::Termine::ICal;
  41
  42 use constant true  => 1;
  43 use constant false => 0;
  44
  45 use Data::ICal ();
  46 use Data::ICal::Entry::Event ();
  47 use Date::ICal ();
  48 use Encode qw(encode);
  49 use File::Spec ();
  50 use HTML::Entities qw(decode_entities);
  51 use LUGS::Events::Parser ();
  52
  53 sub new
  54 {
  55     my $class = shift;
  56
  57     return bless {};
  58 }
  59
  60 sub process_events
  61 {
  62     my $self = shift;
  63
  64     my $parser = LUGS::Events::Parser->new($Config->{input}, {
  65         filter_html  => true,
  66         tag_handlers => {
  67             'a href' => [ {
  68                 rewrite => '$TEXT',
  69                 fields  => [ qw(location) ],
  70             }, {
  71                 rewrite => '$TEXT ($HREF)',
  72                 fields  => [ qw(more) ],
  73             } ],
  74         },
  75         strip_text => [ 'mailto:' ],
  76     });
  77
  78     while (my $event = $parser->next_event) {
  79         my $year  = $event->get_event_year;
  80         my $month = $event->get_event_month;
  81         my $day   = $event->get_event_day;
  82
  83         my %time;
  84
  85         if ($event->get_event_time =~ /^(\d+:\d+) (?:\s+ - \s+ (\d+:\d+))?$/x) {
  86             @time{qw(start_hour start_min)} = split /\:/, $1;
  87             if ($2) {
  88                 @time{qw(end_hour end_min)} = split /\:/, $2;
  89             }
  90             else {
  91                 @time{qw(end_hour end_min)} = @time{qw(start_hour start_min)};
  92             }
  93         }
  94         else {
  95             %time = map { $_ => 0 } qw(start_hour start_min end_hour end_min);
  96         }
  97
  98         $self->{calendar} = Data::ICal->new;
  99         my $ical_event    = Data::ICal::Entry::Event->new;
 100
 101         my $location = $event->get_event_location;
 102         my $summary  = $event->get_event_title;
 103         my $anchor   = $event->get_event_anchor;
 104         my $more     = $event->get_event_more;
 105
 106         $location =~ s/\(.+?\)//g;
 107         $more =~ s/<.+?>//g if defined $more;
 108
 109         sub { decode_entities($_) foreach @_      }->($location, $summary, defined $more ? $more : ());
 110         sub { $_ = encode('UTF-8', $_) foreach @_ }->($location, $summary, defined $more ? $more : ());
 111
 112         my $offset = $Config->{offset} ? $Config->{offset} : ((localtime)[8] ? '+0200' : '+0100');
 113
 114         $ical_event->add_properties(
 115             dtstamp => Date::ICal->new->ical,
 116             dtstart => Date::ICal->new(
 117                 year   => $year,
 118                 month  => $month,
 119                 day    => $day,
 120                 hour   => $time{start_hour},
 121                 min    => $time{start_min},
 122                 sec    => 00,
 123                 offset => $offset,
 124             )->ical,
 125             dtend => Date::ICal->new(
 126                 year   => $year,
 127                 month  => $month,
 128                 day    => $day,
 129                 hour   => $time{end_hour},
 130                 min    => $time{end_min},
 131                 sec    => 00,
 132                 offset => $offset,
 133             )->ical,
 134             location    => $location,
 135             summary     => $summary,
 136             defined $more ? (
 137             description => $more,
 138             ) : (),
 139             uid         => "${anchor}\@lugs.ch",
 140             url         => join '#', ($Config->{base_url}, $anchor),
 141         );
 142
 143         $self->{calendar}->add_entry($ical_event);
 144         $self->save_ical($anchor);
 145     }
 146 }
 147
 148 sub save_ical
 149 {
 150     my $self = shift;
 151     my ($file) = @_;
 152
 153     my $ics_file = $file . '.ics';
 154     my $ics_path = File::Spec->catfile($Config->{ical_dir}, $ics_file);
 155
 156     open(my $fh, '>', $ics_path) or die "Cannot write $ics_path: $!\n";
 157     print {$fh} do { local $_ = $self->{calendar}->as_string;
 158 #                     s/\n/\r\n/g;
 159                      $_ };
 160     close($fh);
 161 }