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 Feature::Compat::Try;

use FindBin qw($Bin);

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;
use Text::Xslate;

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, $SKELDIR, $OUTPUT_FILE );
$BASE_URI     = $ENV{CAL_DAV_URL_BASE};
$CALENDAR_URI = $ENV{CAL_DAV_URL_CALENDAR};
$SKELDIR      = $ENV{SKELDIR} || "$Bin/../templates";
$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 <https://stackoverflow.com/a/11673483>

# 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;
}

my %vars;
for (@events) {
    next unless $_->summary;
    push @{ $vars{events} }, resolve_event( $_, $_->start, $_->end );
}

my %tmpl;
$tmpl{list} = path($SKELDIR)->child('list.md')->slurp_utf8;

my $template = Text::Xslate->new(
    path   => \%tmpl,
    syntax => 'TTerse',
    type   => 'text',
);

my $content = $template->render( 'list', \%vars );

if ($output_path) {
    $output_path->append_utf8($content);
}
else {
    print $content;
}

sub resolve_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;
        }
    }

    return {
        time_brief  => $time_brief,
        summary     => $summary,
        description => $description,
        attendees   => [@attendees],
        location    => $location,
        timespan    => $timespan,
        price       => $price,
        attachments => [@attachments],
    };
}

sub get_property_string
{
    my ( $entry, $key ) = @_;

    return ''
        unless $entry->property($key);

    return decode_utf8 $entry->property($key)->[0]->value;
}

1;