#!/usr/bin/perl
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2017 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://www.rezic.de/eserte/
#

package # hide from PAUSE indexer
    App::org2ical;

use strict;
use warnings;
use FindBin;
use lib $FindBin::RealBin; # for org-daemon

use Digest::MD5    'md5_base64';
use Encode         'encode_utf8', 'decode_utf8';
use Fcntl          'SEEK_SET';
use File::Basename 'basename', 'dirname';
use POSIX          'strftime', 'ceil';
use File::Copy     'cp';
use File::Temp     ();

require "org-daemon"; # for App::orgdaemon::find_dates_in_org_file

our $VERSION = '0.04';

sub org2ical {
    my(%opts) = @_;
    my $out_ics    =    delete $opts{out_ics};
    my @todo_files = @{ delete $opts{todo_files} };
    my $domain_id  =    delete $opts{domain_id};
    my $debug      =    delete $opts{debug};
    die "Unhandled options: " . join(" ", %opts) if %opts;

    my %old_events;
    if (-e $out_ics) {
	open my $fh, "<", $out_ics
	    or die "ERROR: Can't open $out_ics: $!";
	binmode $fh, ':encoding(utf-8)';
	my $current_event;
	my $current_uid;
	my $in_event;
	my $in_alarm;
	while(<$fh>) {
	    if (/^BEGIN:VEVENT$/) {
		$current_event = $_;
		$in_event = 1;
	    } elsif (/^END:VEVENT$/) {
		$current_event .= $_;
		if (!$current_uid) {
		    warn "Strange: VEVENT without UID, ignoring...";
		} else {
		    $old_events{$current_uid} = $current_event;
		}
		undef $current_event;
		undef $current_uid;
		$in_event = 0;
	    } elsif ($in_event) {
		if (/^BEGIN:VALARM$/) {
		    $in_alarm = 1;
		} elsif (/^END:VALARM$/) {
		    $in_alarm = 0;
		} elsif (!$in_alarm && /^UID:(.*)$/) {
		    if (defined $current_uid) {
			warn "Strange: multiple UIDs defined, choosing later one...";
		    }
		    $current_uid = $1;
		}
		$current_event .= $_;
	    }
	}
    }

    my $ofh = File::Temp->new(TEMPLATE => 'org2ical-XXXXXXXX', DIR => dirname($out_ics), SUFFIX => '.ics');
    if (-e $out_ics) {
	copy_stat($out_ics, $ofh->filename);
    }
    binmode $ofh, ':encoding(utf-8)';
    print $ofh <<EOF;
BEGIN:VCALENDAR
VERSION:2.0
CALSCALE:GREGORIAN
PRODID:-//Slaven Rezic//NONSGML rezic.de org2ical $VERSION//EN
EOF

    my $hostname = defined $domain_id ? $domain_id : _hostname();

    for my $todo_file (@todo_files) {
	my $todo_mtime = (stat($todo_file))[9];
	my @todo_dates = App::orgdaemon::find_dates_in_org_file($todo_file, include_timeless => 1, time_fallback => '00:00');
	for my $todo_date (reverse @todo_dates) {
	    if ($todo_date->{text} !~ m{:(homecomputer|workcomputer|ignoreics):}) { # XXX tag list to ignore should be only configurable
		my $uid = md5_base64(encode_utf8($todo_date->id)) . '@' . $hostname;
		my $dtstamp = strftime "%Y%m%dT%H%M%SZ", gmtime $todo_mtime;
		#my $dtstart = $todo_date->start_is_timeless ? strftime("DTSTART;VALUE=DATE:%Y%m%d", localtime $todo_date->{epoch}) : strftime("DTSTART:%Y%m%dT%H%M%SZ", gmtime $todo_date->{epoch});
		my $dtstart = $todo_date->start_is_timeless ? strftime("DTSTART;VALUE=DATE:%Y%m%d", localtime $todo_date->{epoch}) : strftime("DTSTART:%Y%m%dT%H%M%S", localtime $todo_date->{epoch});
		my $dtend;
		if ($todo_date->date_end) {
		    # rfc5545: If such a "VEVENT" (daily reminder) has a "DTEND" property, it MUST be specified as a DATE value also.
		    #$dtend = $todo_date->end_is_timeless || $todo_date->start_is_timeless ? strftime("DTEND;VALUE=DATE:%Y%m%d", localtime($todo_date->epoch_end + 86400)) : strftime("DTEND:%Y%m%dT%H%M%SZ", gmtime $todo_date->epoch_end);
		    $dtend = $todo_date->end_is_timeless || $todo_date->start_is_timeless ? strftime("DTEND;VALUE=DATE:%Y%m%d", localtime($todo_date->epoch_end + 86400)) : strftime("DTEND:%Y%m%dT%H%M%S", localtime $todo_date->epoch_end);
		}
		my $description = $todo_date->formatted_text; # XXX description vs. summary?
		my $early_warning_min;
		if (!$todo_date->start_is_timeless || $todo_date->early_warning) {
		    $early_warning_min = ceil(($todo_date->{epoch} - ($todo_date->{early_warning_epoch} || 5*60)) / 60);
		} else {
		    $early_warning_min = ceil((16*3600) / 60);
		}
		my $trigger = "TRIGGER:-PT${early_warning_min}M";
		$description =~ s{\s+:.*}{};
		$description =~ s{\s+<.*>$}{};
		$description =~ s{\s*SCHEDULED:\s*}{ };
		$description =~ s{,}{\\,}g;

		# The comment is currently the complete item, except for really boring lines
		# (scheduled date, former state changes, properties...). It feels somewhat
		# hacky, see XXXs below.
		my $comment;
		if ($todo_date->{seek} && open my $forward_fh, $todo_file) {
		    seek $forward_fh, $todo_date->{seek}, SEEK_SET or die "seek failed: $!";
		    scalar <$forward_fh>; # overread title line; already in the summary of the vevent
		    while(defined(my $line = decode_utf8(scalar <$forward_fh>))) { # XXX should not assume utf-8 as org file encoding
			last if $line =~ /^\*/;
			if ($line !~ m{^(
					   \s+SCHEDULED:\s+<\d+.*>
				       |   \s+-\s+State\s+"DONE"\s+from\s+"TODO"\s+\[.*\] # XXX other state changes are possible
				       |   \s+:(PROPERTIES|LAST_REPEAT|END): # XXX there are more possible properties
				       |   \s+\[cropped\]$ # XXX private convention
				       )}x) {
			    $comment .= $line;
			}
		    }
		}
		if ($comment) {
		    $comment =~ s{^\s+}{}gm;
		    $comment =~ s{\n}{\\n}g;
		    $comment =~ s{([,;])}{\\$1}g;
		}
		
		my $vcal = <<"EOF";
BEGIN:VEVENT
UID:$uid
$dtstart
EOF
		if (defined $dtend) {
		    $vcal .= $dtend . "\n";
		}
		$vcal .= <<"EOF";
CREATED:$dtstamp
DTSTAMP:$dtstamp
LAST-MODIFIED:$dtstamp
SUMMARY:$description
TRANSP:OPAQUE
EOF
		if ($comment) {
		    $vcal .= <<"EOF";
DESCRIPTION:$comment
EOF
		}
		if (defined $trigger) {
		    $vcal .= <<"EOF";
BEGIN:VALARM
ACTION:DISPLAY
DESCRIPTION:Reminder
$trigger
UID:ALARM-$uid
END:VALARM
EOF
		}
		$vcal .= <<"EOF";
END:VEVENT
EOF
		if (exists $old_events{$uid}) {
		    $vcal = _get_old_or_new($vcal, $old_events{$uid});
		}
		print $ofh $vcal;
	    }
	}
    }

    print $ofh <<EOF;
END:VCALENDAR
EOF

    close $ofh
	or die "ERROR: closing $ofh failed: $!";

    if (-r $out_ics) {
	require File::Compare;
	if (File::Compare::compare($out_ics, $ofh->filename) == 0) {
	    warn ".ics file $out_ics did not change\n" if $debug;
	    return;
	} else {
	    if ($debug) {
		if ($^O ne 'MSWin32' && is_in_path('diff')) {
		    system 'diff', '-u', $out_ics, $ofh->filename;
		} else {
		    warn ".ics file, but no diff available\n";
		}
	    }
	}
	cp $out_ics, "$out_ics~";
    }

    rename $ofh->filename, $out_ics
	or die "Renaming " . $ofh->filename . " to $out_ics failed: $!";
}

sub _hostname {
    my $hostname;
    if (is_in_path('hostname')) {
	chomp($hostname = `hostname -f`);
    }
    if (!defined $hostname || $hostname eq '') {
	require Sys::Hostname;
	$hostname = Sys::Hostname::hostname();
    }
    $hostname;
}

sub _get_old_or_new {
    my($new_vcal, $old_vcal) = @_;
    my($new_vcal_cmp, $old_vcal_cmp);
    for my $def (
	      [$new_vcal, \$new_vcal_cmp],
	      [$old_vcal, \$old_vcal_cmp],
	     ) {
	my($src, $destref) = @$def;
	for my $l (split /\n/, $src) {
	    if ($l !~ m{^(CREATED|DTSTAMP|LAST-MODIFIED):}) {
		$$destref .= $l;
		$$destref .= "\n";
	    }
	}
    }
    if ($new_vcal_cmp eq $old_vcal_cmp) {
	$old_vcal;
    } else {
	$new_vcal;
    }
}

# REPO BEGIN
# REPO NAME copy_stat /home/eserte/src/srezic-repository 
# REPO MD5 f567def1f7ce8f3361e474b026594660

#=head2 copy_stat($src, $dest)
#
#=for category File
#
#Copy stat information (owner, group, mode and time) from one file to
#another. If $src is an array reference, then this is used as the
#source stat information.
#
#=cut

sub copy_stat {
    my($src, $dest) = @_;
    my @stat = ref $src eq 'ARRAY' ? @$src : stat($src);
    die "Can't stat $src: $!" if !@stat;

    chmod $stat[2], $dest
	or warn "Can't chmod $dest to " . sprintf("0%o", $stat[2]) . ": $!";
    chown $stat[4], $stat[5], $dest
	or do {
	    my $save_err = $!; # otherwise it's lost in the get... calls
	    warn "Can't chown $dest to " .
		 (getpwuid($stat[4]))[0] . "/" .
                 (getgrgid($stat[5]))[0] . ": $save_err";
	};
    utime $stat[8], $stat[9], $dest
	or warn "Can't utime $dest to " .
	        scalar(localtime $stat[8]) . "/" .
		scalar(localtime $stat[9]) .
		": $!";
}
# REPO END

# REPO BEGIN
# REPO NAME is_in_path /home/eserte/src/srezic-repository 
# REPO MD5 4be1e368fea0fa9af4e89256a9878820

#=head2 is_in_path($prog)
#
#=for category File
#
#Return the pathname of $prog, if the program is in the PATH, or undef
#otherwise.
#
#=cut

sub is_in_path {
    my($prog) = @_;
    require File::Spec;
    if (File::Spec->file_name_is_absolute($prog)) {
	if ($^O eq 'MSWin32') {
	    return $prog       if (-f $prog && -x $prog);
	    return "$prog.bat" if (-f "$prog.bat" && -x "$prog.bat");
	    return "$prog.com" if (-f "$prog.com" && -x "$prog.com");
	    return "$prog.exe" if (-f "$prog.exe" && -x "$prog.exe");
	    return "$prog.cmd" if (-f "$prog.cmd" && -x "$prog.cmd");
	} else {
	    return $prog if -f $prog and -x $prog;
	}
    }
    require Config;
    %Config::Config = %Config::Config if 0; # cease -w
    my $sep = $Config::Config{'path_sep'} || ':';
    foreach (split(/$sep/o, $ENV{PATH})) {
	if ($^O eq 'MSWin32') {
	    # maybe use $ENV{PATHEXT} like maybe_command in ExtUtils/MM_Win32.pm?
	    return "$_\\$prog"     if (-f "$_\\$prog" && -x "$_\\$prog");
	    return "$_\\$prog.bat" if (-f "$_\\$prog.bat" && -x "$_\\$prog.bat");
	    return "$_\\$prog.com" if (-f "$_\\$prog.com" && -x "$_\\$prog.com");
	    return "$_\\$prog.exe" if (-f "$_\\$prog.exe" && -x "$_\\$prog.exe");
	    return "$_\\$prog.cmd" if (-f "$_\\$prog.cmd" && -x "$_\\$prog.cmd");
	} else {
	    return "$_/$prog" if (-x "$_/$prog" && !-d "$_/$prog");
	}
    }
    undef;
}
# REPO END

return 1 if caller;

require Getopt::Long;

sub usage (;$) {
    warn $_[0], "\n" if @_;
    die "usage: $0 [--debug] --todo-file path --ics-file path\n";
}

Getopt::Long::GetOptions(
    'todo-file=s@'       => \my @todo_files,
    "ics-file|out-ics=s" => \my $out_ics,
    "debug!"             => \my $debug,
    "domain-id=s"        => \my $domain_id,
    "version|v"          => sub {
	print basename($0) . " $VERSION\n";
	exit 0;
    },
)
    or usage;

if (!$out_ics) {
    usage "Please specify --ics-file (output ics file)";
}

if (!@todo_files) {
    usage "Please specify one or more --todo-file options";
}

App::org2ical::org2ical(
    out_ics    => $out_ics,
    todo_files => \@todo_files,
    domain_id  => $domain_id,
    debug      => $debug,
);

__END__

=head1 NAME

org2ical - convert appointments in org-mode files to .ics files

=head1 SYNOPSIS

    org2ical [--debug] [--domain-id=example.org] --todo-file /path/to/file.org [--todo-file ...] --ics-file /path/to/outfile.ics

=head1 DESCRIPTION

Convert appointments (events; active timestamps) found in one ro more
org-mode files into an ical file.

The generated file may be served with a web server. Probably some kind
of security (authentication, SSL) should be configured in such setup.

=head2 OPTIONS

=over

=item C<--todo-file I<path>>

The path to an org-mode file. Mandatory. May be specified multiple times.

=item C<--ics-file I<path>>

The path for the output ical (.ics) file. Mandatory.

=item C<--domain-id I<value>>

Specify the domain part of generated uids. If not given, then use the
fqdn or short hostname.

=item C<--debug>

Enable debugging, e.g. output of a L<diff(1)> if there were changes to
the generated .ics file.

=back

=head1 EXAMPLE

A sample crontab entry:

    0 * * * * org2ical --domain-id=example.org --todo-file $HOME/TODO.org --ics-file $HOME/public_html/secure/TODO.ics

=head1 TODO & LIMITATIONS

 * it's possible to ignore appointments by tags; this tag list should be configurable

 * the handling of description/summar/comment is not yet defined

=head1 AUTHOR

Slaven Rezic

=head1 SEE ALSO

L<org-daemon>.

=cut
