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: Wed 09 Jun 2021 10:05:08 PM CEST
  19
  20 use strict;
  21 use warnings;
  22 use lib qw(lib);
  23
  24 my $VERSION = '0.06';
  25
  26 my $Config = {
  27     base_url => 'https://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 DateTime ();
  49 use File::Spec ();
  50 use LUGS::Events::Parser ();
  51
  52 sub new
  53 {
  54     my $class = shift;
  55
  56     return bless {};
  57 }
  58
  59 sub process_events
  60 {
  61     my $self = shift;
  62
  63     my $parser = LUGS::Events::Parser->new($Config->{input}, {
  64         filter_html  => true,
  65         tag_handlers => {
  66             'a href' => [ {
  67                 rewrite => '$TEXT',
  68                 fields  => [ qw(location) ],
  69             }, {
  70                 rewrite => '$TEXT ($HREF)',
  71                 fields  => [ qw(more) ],
  72             } ],
  73         },
  74         strip_text => [ 'mailto:' ],
  75     });
  76
  77     while (my $event = $parser->next_event) {
  78         my $year  = $event->get_event_year;
  79         my $month = $event->get_event_month;
  80         my $day   = $event->get_event_day;
  81
  82         my %time;
  83
  84         if ($event->get_event_time =~ /^(\d+:\d+) (?:\s+ - \s+ (\d+:\d+))?$/x) {
  85             @time{qw(start_hour start_min)} = split /\:/, $1;
  86             if ($2) {
  87                 @time{qw(end_hour end_min)} = split /\:/, $2;
  88             }
  89             else {
  90                 @time{qw(end_hour end_min)} = @time{qw(start_hour start_min)};
  91             }
  92         }
  93         else {
  94             %time = map { $_ => 0 } qw(start_hour start_min end_hour end_min);
  95         }
  96
  97         $self->{calendar} = Data::ICal->new;
  98         my $ical_event    = Data::ICal::Entry::Event->new;
  99
 100         my $location = $event->get_event_location;
 101         my $summary  = $event->get_event_title;
 102         my $anchor   = $event->get_event_anchor;
 103         my $more     = $event->get_event_more;
 104
 105         $location =~ s/\(.+?\)//g;
 106         $more =~ s/<.+?>//g if defined $more;
 107
 108         my $get_offset = sub
 109         {
 110             my ($hour, $minute) = @_;
 111             return $Config->{offset} if $Config->{offset};
 112             my $dt = DateTime->new(
 113                 year      => $year,
 114                 month     => $month,
 115                 day       => $day,
 116                 hour      => $hour,
 117                 minute    => $minute,
 118                 time_zone => 'Europe/Zurich',
 119             );
 120             return $dt->is_dst() ? '+0200' : '+0100';
 121         };
 122         $ical_event->add_properties(
 123             dtstamp => Date::ICal->new->ical,
 124             dtstart => Date::ICal->new(
 125                 year   => $year,
 126                 month  => $month,
 127                 day    => $day,
 128                 hour   => $time{start_hour},
 129                 min    => $time{start_min},
 130                 sec    => 00,
 131                 offset => $get_offset->(@time{qw(start_hour start_min)}),
 132             )->ical,
 133             dtend => Date::ICal->new(
 134                 year   => $year,
 135                 month  => $month,
 136                 day    => $day,
 137                 hour   => $time{end_hour},
 138                 min    => $time{end_min},
 139                 sec    => 00,
 140                 offset => $get_offset->(@time{qw(end_hour end_min)}),
 141             )->ical,
 142             location    => $location,
 143             summary     => $summary,
 144             defined $more ? (
 145             description => $more,
 146             ) : (),
 147             uid         => "${anchor}\@lugs.ch",
 148             url         => join '#', ($Config->{base_url}, $anchor),
 149         );
 150
 151         $self->{calendar}->add_entry($ical_event);
 152         $self->save_ical($anchor);
 153     }
 154 }
 155
 156 sub save_ical
 157 {
 158     my $self = shift;
 159     my ($file) = @_;
 160
 161     my $ics_file = $file . '.ics';
 162     my $ics_path = File::Spec->catfile($Config->{ical_dir}, $ics_file);
 163
 164     open(my $fh, '>', $ics_path) or die "Cannot write $ics_path: $!\n";
 165     print {$fh} do { local $_ = $self->{calendar}->as_string;
 166 #                     s/\n/\r\n/g;
 167                      $_ };
 168     close($fh);
 169 }