add script events2md.pl

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;