#!/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 # serialize calendar events $log->debug('serialize calendar events...'); 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 { $_->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 ( $entry, $event, $path ) = @_; if ( $log->is_trace ) { use DDP; p $entry; p $event; } 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( $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 ( $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;