path: root/bin/events2md.pl

#!/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( $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->{DTSTART},
                    $_->value->{DTEND},
                    $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 $time_begin = ucfirst( $start->strftime('%A') );
    $time_begin .= $start->strftime(' %e. %B kl. %k.%M');
    my $time_end = $end->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;