#!/usr/bin/perl use v5.14; use utf8; use open qw(:std :encoding(UTF-8)); use strictures; use autodie; use Feature::Compat::Try; 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::DateTime; use DateTime; 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; } # 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 $start; if ( $ENV{CAL_DAV_NOW} ) { try { require DateTimeX::Easy } catch ($e) { $log->fatalf( 'failed parsing CAL_DAV_NOW: %s', $e ) && exit 2 } $start = DateTimeX::Easy->new( $ENV{CAL_DAV_NOW} ); $log->fatalf( 'failed parsing CAL_DAV_NOW: unknown start time "%s"', $ENV{CAL_DAV_NOW} ) && exit 2 unless defined $start; } $start ||= DateTime->now; my $end = $start->clone->add( months => 6 ); $log->infof( 'will pick events between %s and %s', $start, $end ); my $span = DateTime::Span->from_datetimes( start => $start, end => $end ); my @events = sort { DateTime->compare( $a->start, $b->start ) || DateTime->compare( $a->end, $b->end ) || get_property_string( $a, 'summary' ) cmp get_property_string( $b, 'summary' ) } $calendar->events($span); 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 (@events) { next unless $_->summary; print_event( $_, $_->start, $_->end, $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 $date_begin = $start->strftime('%A %e. %B'); my $time_begin = $start->strftime('%k.%M'); my $time_end = $end->strftime('%k.%M'); my $time_brief = ucfirst("$date_begin kl. $time_begin"); my $timespan = $time_end ? ucfirst("$date_begin kl. $time_begin-$time_end") : undef; my %attachments; if ( $entry->property('attach') ) { for ( @{ $entry->property('attach') } ) { my $uri; try { $uri = URI->new( $_->value ) } catch ($e) { $log->errorf( 'failed to parse URI %s: %s', $uri, $e ); next; } $uri->authority and $uri->host or next; push @{ $attachments{ $uri->host } }, $uri; } } $_ = "### $time_brief."; $_ .= " $summary" if $summary; $_ .= "\n$description"; $_ .= " \nMed " . join( ' og ', @attendees ) . '.' if @attendees; $_ .= " \n**Mødested:** $location" if $location; $_ .= " \n**Tid:** $timespan." if $timespan; $_ .= " \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;