summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xmake-ical/make-ical.pl159
1 files changed, 159 insertions, 0 deletions
diff --git a/make-ical/make-ical.pl b/make-ical/make-ical.pl
new file mode 100755
index 0000000..2510d09
--- /dev/null
+++ b/make-ical/make-ical.pl
@@ -0,0 +1,159 @@
+#!/usr/bin/perl
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+#
+# Author: Steven Schubiger <stsc@refcnt.org>
+# Last modified: Sun Jul 21 22:23:31 CEST 2013
+
+use strict;
+use warnings;
+use lib qw(lib);
+
+my $VERSION = '0.02';
+
+my $Config = {
+ base_url => 'http://www.lugs.ch/lugs/termine',
+ input => './termine.txt',
+ ical_dir => 'ical',
+ offset => undef,
+};
+
+{
+ mkdir $Config->{ical_dir} unless -e $Config->{ical_dir};
+
+ my $ical = LUGS::Termine::ICal->new;
+ $ical->process_events;
+}
+
+package LUGS::Termine::ICal;
+
+use constant true => 1;
+use constant false => 0;
+
+use Data::ICal ();
+use Data::ICal::Entry::Event ();
+use Date::ICal ();
+use Encode qw(encode);
+use File::Spec ();
+use HTML::Entities qw(decode_entities);
+use LUGS::Events::Parser ();
+
+sub new
+{
+ my $class = shift;
+
+ return bless {};
+}
+
+sub process_events
+{
+ my $self = shift;
+
+ my $parser = LUGS::Events::Parser->new($Config->{input}, {
+ filter_html => true,
+ tag_handlers => {
+ 'a href' => [ {
+ rewrite => '$TEXT',
+ fields => [ qw(location) ],
+ }, {
+ rewrite => '$TEXT ($HREF)',
+ fields => [ qw(more) ],
+ } ],
+ },
+ strip_text => [ 'mailto:' ],
+ });
+
+ while (my $event = $parser->next_event) {
+ my $year = $event->get_event_year;
+ my $month = $event->get_event_month;
+ my $day = $event->get_event_day;
+
+ my %time;
+
+ if ($event->get_event_time =~ /^(\d+:\d+) (?:\s+ - \s+ (\d+:\d+))?$/x) {
+ @time{qw(start_hour start_min)} = split /\:/, $1;
+ if ($2) {
+ @time{qw(end_hour end_min)} = split /\:/, $2;
+ }
+ else {
+ @time{qw(end_hour end_min)} = @time{qw(start_hour start_min)};
+ }
+ }
+ else {
+ %time = map { $_ => 0 } qw(start_hour start_min end_hour end_min);
+ }
+
+ $self->{calendar} = Data::ICal->new;
+ my $ical_event = Data::ICal::Entry::Event->new;
+
+ my $location = $event->get_event_location;
+ my $summary = $event->get_event_title;
+ my $anchor = $event->get_event_anchor;
+ my $more = $event->get_event_more;
+
+ $location =~ s/\(.+?\)//g;
+ $more =~ s/<.+?>//g if defined $more;
+
+ sub { decode_entities($_) foreach @_ }->($location, $summary, defined $more ? $more : ());
+ sub { $_ = encode('UTF-8', $_) foreach @_ }->($location, $summary, defined $more ? $more : ());
+
+ my $offset = $Config->{offset} ? $Config->{offset} : ((localtime)[8] ? '+0200' : '+0100');
+
+ $ical_event->add_properties(
+ dtstamp => Date::ICal->new->ical,
+ dtstart => Date::ICal->new(
+ year => $year,
+ month => $month,
+ day => $day,
+ hour => $time{start_hour},
+ min => $time{start_min},
+ sec => 00,
+ )->ical(offset => $offset),
+ dtend => Date::ICal->new(
+ year => $year,
+ month => $month,
+ day => $day,
+ hour => $time{end_hour},
+ min => $time{end_min},
+ sec => 00,
+ )->ical(offset => $offset),
+ location => $location,
+ summary => $summary,
+ defined $more ? (
+ description => $more,
+ ) : (),
+ uid => "${anchor}\@lugs.ch",
+ url => join '#', ($Config->{base_url}, $anchor),
+ );
+
+ $self->{calendar}->add_entry($ical_event);
+ $self->save_ical($anchor);
+ }
+}
+
+sub save_ical
+{
+ my $self = shift;
+ my ($file) = @_;
+
+ my $ics_file = $file . '.ics';
+ my $ics_path = File::Spec->catfile($Config->{ical_dir}, $ics_file);
+
+ open(my $fh, '>', $ics_path) or die "Cannot write $ics_path: $!\n";
+ print {$fh} do { local $_ = $self->{calendar}->as_string;
+# s/\n/\r\n/g;
+ $_ };
+ close($fh);
+}