make-ical: fix setting offset
[lugs.git] / 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 }