summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.perlcriticrc4
-rw-r--r--.perltidyrc21
-rw-r--r--.tidyallrc7
-rwxr-xr-xbin/events2md.pl242
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;