diff options
| -rw-r--r-- | .perlcriticrc | 4 | ||||
| -rw-r--r-- | .perltidyrc | 21 | ||||
| -rw-r--r-- | .tidyallrc | 7 | ||||
| -rwxr-xr-x | bin/events2md.pl | 242 |
4 files changed, 274 insertions, 0 deletions
diff --git a/.perlcriticrc b/.perlcriticrc new file mode 100644 index 0000000..4e08e03 --- /dev/null +++ b/.perlcriticrc @@ -0,0 +1,4 @@ +[-Subroutines::ProhibitSubroutinePrototypes] + +[TestingAndDebugging::RequireUseStrict] +equivalent_modules = strictures diff --git a/.perltidyrc b/.perltidyrc new file mode 100644 index 0000000..2e08554 --- /dev/null +++ b/.perltidyrc @@ -0,0 +1,21 @@ +# use best practices, except use of stdout +--perl-best-practices +--no-standard-output +--no-standard-error-output + +# use TAB for lead indentation +--tabs +--entab-leading-whitespace=4 +-nola + +# indent only already indented comments +--indent-spaced-block-comments + +# put brace on new line for named subroutines +--opening-sub-brace-on-new-line + +# preserve horisontally styled lists +--break-at-old-comma-breakpoints + +# overwrite (we use CVS), and leave backup only on error +--backup-file-extension=/~ diff --git a/.tidyallrc b/.tidyallrc new file mode 100644 index 0000000..4bcb16c --- /dev/null +++ b/.tidyallrc @@ -0,0 +1,7 @@ +[PerlTidy] +select = **/*.{pl,pm,t} +;select = bin/* +argv = --profile=$ROOT/.perltidyrc + +[PerlCritic] +select = lib/**/*.pm diff --git a/bin/events2md.pl b/bin/events2md.pl new file mode 100755 index 0000000..2f2db52 --- /dev/null +++ b/bin/events2md.pl @@ -0,0 +1,242 @@ +#!/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(pairs); + +use IO::Interactive::Tiny; +use Log::Any qw($log); +use Log::Any::Adapter; + +use URI; +use IO::Prompter; +use Cal::DAV; +use iCal::Parser; +use List::Util qw(first); +use List::MoreUtils qw(nsort_by sort_by); +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 ); +$base_uri = URI->new($BASE_URI) + if ($BASE_URI); +if ( !$base_uri or !$base_uri->authority ) { + $log->fatal('bad base URI: must be an internet URI'); + exit 2; +} +$log->infof( 'will use base URI %s', $base_uri ); +$calendar_uri = URI->new( $CALENDAR_URI || $base_uri ); +if ( !$calendar_uri or !$calendar_uri->authority ) { + $log->fatal('bad calendar URI: must be an internet URI'); + exit 2; +} +elsif ( $base_uri->eq($calendar_uri) ) { + $calendar_uri = undef; +} +else { + $log->infof( 'will use calendar URI %s', $calendar_uri ); +} + +# resolve credentials +$log->debug('resolve credentials...'); +my ( $mach, $user, $pass ); +if ( $base_uri->userinfo ) { + ( $user, $pass ) = split ':', $base_uri->userinfo; +} +$user ||= $ENV{CAL_DAV_USER}; +$pass ||= $ENV{CAL_DAV_PASS}; +if ( !$user or !$pass ) { + $mach = Net::Netrc->lookup( $base_uri->host, $user ); +} +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 calendar data +$log->debug('fetch and parse calendar data...'); +my $start = DateTime->now; +my $end = $start->clone->add( months => 1 ); +my $calendar = Cal::DAV->new( + user => $user, + pass => $pass, + url => $base_uri, +); +$calendar->get($calendar_uri) + if $calendar_uri; +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 $parser = iCal::Parser->new( start => $start, end => $end ); +my $events = $parser->parse_strings( decode_utf8 $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 { $_->value } + nsort_by { $_->key } pairs %{ $events->{events} } ) +{ + for my $month ( map { $_->value } nsort_by { $_->key } pairs %$year ) { + for my $day ( map { $_->value } nsort_by { $_->key } pairs %$month ) { + for ( + sort_by { + $_->value->{DTSTART} + . $_->value->{DTEND} + . $_->value->{SUMMARY} + } + pairs %$day + ) + { + print_event( + $calendar_entries{VEVENT}{ $_->key }, + $_->value, + $output_path, + ); + } + } + } +} + +sub print_event +{ + my ( $calendar_event, $event, $path ) = @_; + + if ( $log->is_trace ) { + use DDP; + p $calendar_event; + p $event; + } + my $summary = unescape( $event->{SUMMARY} ); + my $description = unescape( $event->{DESCRIPTION} ); + $description =~ s/\n\n[Pp]ris:\s*((?!\n).+)\s*\z//m; + my $price = $1; + if ( $event->{ATTENDEE} ) { + $description .= "\nMed "; + $description .= join ' og ', + map { $_->{CN} || $_->{value} =~ s/^mailto://r } + @{ $event->{ATTENDEE} }; + $description .= '.'; + } + my $location = unescape( $event->{LOCATION} ); + my $time_begin = ucfirst( $event->{DTSTART}->strftime('%A') ); + $time_begin .= $event->{DTSTART}->strftime(' %e. %B kl. %k.%M'); + my $time_end = $event->{DTEND}->strftime('%k.%M'); + my %attachments; + if ( $calendar_event->property('attach') ) { + for ( @{ $calendar_event->property('attach') } ) { + my $uri = try { URI->new( $_->value ) } + or next; + $uri->authority and $uri->host + or next; + push @{ $attachments{ $uri->host } }, $uri; + } + } + + $_ = <<"STRING"; +### $time_begin. $summary +$description +STRING + $_ .= "**Mødested:** $location \n" + if $location; + $_ .= "**Tid:** ${time_begin}-${time_end}. \n" + if $time_begin and $time_end; + $_ .= "**Pris:** $price \n" + if $price; + $_ .= "[Køb billet på Billetto]($attachments{'billetto.dk'}[0])" + if $attachments{'billetto.dk'}; + $_ .= "\n\n---\n\n"; + + if ($path) { + $path->append_utf8($_); + } + else { + print $_; + } +} + +# unescape characters in iCalendar TEXT content strings +# should fully cover iCalendar 2.0 (rfc5545 and rfc6868) +sub unescape +{ + ($_) = @_; + + s/\^n|\\[Nn]/\n/g; + s/\^\'/\"/g; + s/\^\^/^/g; + s/\\([\\;,])/$1/g; + + return $_; +} + +1; |