diff options
Diffstat (limited to 'bin/events2md.pl')
| -rwxr-xr-x | bin/events2md.pl | 262 |
1 files changed, 262 insertions, 0 deletions
diff --git a/bin/events2md.pl b/bin/events2md.pl new file mode 100755 index 0000000..c694d9a --- /dev/null +++ b/bin/events2md.pl @@ -0,0 +1,262 @@ +#!/usr/bin/perl + +use v5.14; +use utf8; +use open qw(:std :encoding(UTF-8)); +use strictures; +use autodie; + +use POSIX qw(locale_h); +use locale; +use Encode qw(decode_utf8); # TODO: modernize CalDAV access instead +use Net::Netrc; +use List::Util qw(first); + +use IO::Interactive::Tiny; +use Log::Any qw($log); +use Log::Any::Adapter; + +use URI; +use IO::Prompter; +use Cal::DAV; +use Data::ICal; +use iCal::Parser; +use DateTime; +use Try::Tiny; +use Path::Tiny; + +if ( IO::Interactive::Tiny::is_interactive() ) { + Log::Any::Adapter->set( 'Screen', default_level => 'info' ); +} + +# set defaults and parse command-line options +my ( $BASE_URI, $CALENDAR_URI, $OUTPUT_FILE ); +$BASE_URI = $ENV{CAL_DAV_URL_BASE}; +$CALENDAR_URI = $ENV{CAL_DAV_URL_CALENDAR}; +$BASE_URI ||= shift @ARGV + if @ARGV; +$CALENDAR_URI ||= shift @ARGV + if @ARGV; +$OUTPUT_FILE = shift @ARGV + if @ARGV; + +# use system locale to format DateTime objects parsed from iCal data +DateTime->DefaultLocale( setlocale(LC_TIME) ); + +# resolve calendar URIs +my ( $base_uri, $calendar_uri, $calendar ); +$base_uri = URI->new($BASE_URI) + if ($BASE_URI); +$base_uri + or $log->fatal('required base URI not provided') && exit 2; +$base_uri->scheme + or $base_uri->scheme('file'); +if ( $base_uri->scheme eq 'http' or $base_uri->scheme eq 'https' ) { + $log->infof( 'will use base URI %s', $base_uri ); + $calendar_uri = URI->new( $CALENDAR_URI || $base_uri ); + $calendar_uri and $calendar_uri->authority + or $log->fatal('bad calendar URI: must be an internet URI') && exit 2; + $base_uri->eq($calendar_uri) and $calendar_uri = undef + or $log->infof( 'will use calendar URI %s', $calendar_uri ); + + # resolve credentials + $log->debug('resolve credentials...'); + my ( $mach, $user, $pass ); + ( $user, $pass ) = split ':', $base_uri->userinfo + if $base_uri->userinfo; + $user ||= $ENV{CAL_DAV_USER}; + $pass ||= $ENV{CAL_DAV_PASS}; + $mach = Net::Netrc->lookup( $base_uri->host, $user ) + if !$user or !$pass; + if ($mach) { + $user ||= $mach->login; + $pass ||= $mach->password; + $log->infof( 'will use .netrc provided credentials for user %s', $user ); + } + elsif ( IO::Interactive::Tiny::is_interactive() ) { + $log->warn('will ask for missing info - this will fail in headless mode'); + $user ||= prompt 'Enter your username'; + $pass ||= prompt 'Enter your password', -echo => '*'; + } + $log->debugf( 'resolved credentials for user %s', $user ); + + # fetch and parse CalDAV calendar data + $log->debug('fetch and parse CalDAV calendar data...'); + $calendar = Cal::DAV->new( + user => $user, + pass => $pass, + url => $base_uri, + ); + $calendar->get($calendar_uri) + if $calendar_uri; +} +elsif ( $base_uri->scheme eq 'file' ) { + defined $base_uri->file + or $log->fatal('bad base URI: cannot open file') && exit 2; + $log->infof( 'will use base URI %s', $base_uri ); + + # parse local calendar data + $log->debug('parse local calendar data...'); + my $path = path( $base_uri->file ); + if ( $path->is_file ) { + $calendar = Data::ICal->new( data => $path->slurp_raw ); + } + else { + my $data; + $path->visit( sub { $data .= $_->slurp_raw if $_->is_file } ); + $calendar = Data::ICal->new( data => $data ); + } +} +if ( $log->is_trace ) { + use DDP; + p $calendar; +} + +# index calendar entries +$log->debug('index calendar entries...'); +my %calendar_entries; +for ( @{ $calendar->entries } ) { + if ( 'VEVENT' eq $_->ical_entry_type ) { + my $uid = try { $_->property('uid')->[0]->value }; + $uid ||= Data::ICal::Entry::Event->new()->property('uid')->[0]->value; + $calendar_entries{VEVENT}{$uid} = $_; + } + else { + # TODO + next; + } +} +if ( $log->is_trace ) { + use DDP; + p %calendar_entries; +} + +# TODO: if list is empty and no calendar uri was explicitly supplied, +# warn on stdout with list of abailable collections using this sequence: +# 1. PROPFIND on base-URL for {DAV:}current-user-principal +# 2. PROPFIND for calendar-home-set property in caldav namespace +# 3. PROPFIND with depth: 1 +# as documented at <https://stackoverflow.com/a/11673483> + +# serialize calendar events +$log->debug('serialize calendar events...'); +my $start = DateTime->now; +my $end = $start->clone->add( months => 1 ); +my $parser = iCal::Parser->new( start => $start, end => $end ); +my $events = $parser->parse_strings( $calendar->as_string ); +if ( $log->is_trace ) { + use DDP; + p $events; +} +my $output_path; +if ($OUTPUT_FILE) { + $output_path = path($OUTPUT_FILE); + $output_path->parent->mkpath; + $output_path->remove; +} +for my $year ( + map { $events->{events}{$_} } + sort { $a <=> $b } keys %{ $events->{events} } + ) +{ + for my $month ( + map { $year->{$_} } + sort { $a <=> $b } keys %$year + ) + { + for my $day ( + map { $month->{$_} } + sort { $a <=> $b } keys %$month + ) + { + my @events = sort { + DateTime->compare( $a->[1], $b->[1] ) + || DateTime->compare( $a->[2], $b->[2] ) + || get_property_string( $a->[0], 'summary' ) + cmp get_property_string( $b->[0], 'summary' ) + } map { + [ $calendar_entries{VEVENT}{$_}, + $day->{$_}{DTSTART}, $day->{$_}{DTEND} + ] + } keys %$day; + for (@events) { + print_event( $_->[0], $_->[1], $_->[2], $output_path, ); + } + } + } +} + +sub print_event +{ + my ( $entry, $start, $end, $path ) = @_; + + if ( $log->is_trace ) { + use DDP; + p $entry; + p $start; + p $end; + p $path; + } + my $summary = get_property_string( $entry, 'summary' ); + my $description = get_property_string( $entry, 'description' ); + $description =~ s/\n\n[Pp]ris:\s*((?!\n).+)\s*\z//m; + my $price = $1; + my @attendees; + if ( $entry->property('attendee') ) { + for ( @{ $entry->property('attendee') } ) { + push @attendees, decode_utf8 $_->parameters->{'CN'} + || $_->value =~ s/^mailto://r; + } + } + my $location = get_property_string( $entry, 'location' ); + my $time_begin = ucfirst( $start->strftime('%A') ); + $time_begin .= $start->strftime(' %e. %B kl. %k.%M'); + my $time_end = $end->strftime('%k.%M'); + my %attachments; + if ( $entry->property('attach') ) { + for ( @{ $entry->property('attach') } ) { + my $uri = try { URI->new( $_->value ) } + or next; + $uri->authority and $uri->host + or next; + push @{ $attachments{ $uri->host } }, $uri; + } + } + + $_ = "### $time_begin."; + $_ .= " $summary" + if $summary; + $_ .= "\n$description"; + $_ .= " \nMed " . join( ' og ', @attendees ) . '.' + if @attendees; + $_ .= " \n**Mødested:** $location" + if $location; + $_ .= " \n**Tid:** ${time_begin}-${time_end}." + if $time_begin and $time_end; + $_ .= " \n**Pris:** $price" + if $price; + $_ .= " \n[Køb billet på Billetto]($attachments{'billetto.dk'}[0])" + if $attachments{'billetto.dk'}; + $_ .= " \n[Læs mere her]($attachments{'byvandring.nu'}[0])" + if $attachments{'byvandring.nu'}; + $_ .= "\n\n---\n\n"; + + if ($path) { + $path->append_utf8($_); + } + else { + print $_; + } +} + +sub get_property_string +{ + my ( $entry, $key ) = @_; + + return '' + unless $entry->property($key); + + return decode_utf8 $entry->property($key)->[0]->value; +} + +1; |