#!/usr/bin/perl
# $Id: palm2ical,v 1.20 2010-02-02 02:47:39 adye Exp $
# palm2ical requires CPAN packages p5-Palm, Data-ICal, DateTime-Format-ICal,
# Data-ICal-TimeZone, and their dependencies.
#
# Copyright (C) 2009-2010, Tim Adye.
# This program is free software; you may redistribute it under the terms of the
# Artistic License, as specified at http://dev.perl.org/licenses/artistic.html

use warnings;
use strict;

use Encode ();
use File::Basename ();
use Getopt::Std ();
use Time::Local ();

use Palm::PDB;
use Palm::Datebook;

use Data::ICal;
use Data::ICal::Entry::Event;
use Data::ICal::Entry::Alarm::Display;
use Data::ICal::Entry::TimeZone;
use Data::ICal::Entry::TimeZone::Standard;
use Data::ICal::Entry::TimeZone::Daylight;
##use Data::ICal::TimeZone;             # only loaded if needed

use DateTime;
use DateTime::Event::ICal;
##use DateTime::TimeZone::Local;        # only loaded if needed

my $VERSION= do { my @r= (q$Revision: 1.20 $ =~ /\d+/g); sprintf "%d.".("%02d" x $#r), @r };
my $prog= File::Basename::basename ($0, '.exe');
my @defaultFiles= qw(CalendarDB-PDat.PDB DatebookDB.PDB);

sub help {
  my @deflist= join (" or ", @defaultFiles);
#=============================================================================
  print <<EOHELP;
$prog $VERSION - Palm Databook/Calendar PDB conversion to iCalendar (.ics)

USAGE:
  $prog
  $prog [OPTIONS] FILENAME
  $prog -T

Reads a PalmOS Datebook or Calendar database file and writes complete
information from all entries as an iCalendar (RFC 2445) file, suitable for
import to Microsoft Outlook, Google Calendar, Mozilla Sunbird, and many other
calendar applications.

When run with no arguments, tries to read @deflist
from the current directory and write a iCalendar file with extension .ics
(this will only work if the local timezone can be determined).
If the .PDB file is not found, this help is printed instead.

If a FILENAME is specified, then that is read as a PDB file, and an iCalendar
file is written to standard output (or the file specified with -o).
With the -p option, the Calendar information is summarised in a more
human-readable and compact form than the iCalendar format.

When run with the -T option, lists the supported timezones.

OPTIONS:
  -h -?    display this help and exit
  -v       verbose running (use -V for additional debugging)
  -o FILE  write output to FILE instead of standard output.
  -p       print events, one per line (with -p, options -t -l -k -s are ignored)
  -n       don\'t include informational data, X-PALM-* and DTSTAMP fields.
           With -p, don\'t print unknown-format data.
  -L       don\'t include location    from the Calendar file (not in Datebook)
  -Z       include time zone entries from the Calendar file (not in Datebook)
  -t TZ    specify the local time zone to write to the iCalendar file.
           Use the "zoneinfo" name, eg. "Europe/London" for the UK.
           Use $prog -T to list the supported time zones. If not specified
           (and not -z or -l), then the local time zone is used. Note that
           $prog may not be able to determine the time zone automatically,
           in which case you should specify it with the -t option.
  -z       convert all times from the local time zone to UTC for the iCalendar
           file. With -p, excludes time zone entries.
  -l       do not specify a time zone. The iCalendar specification says that
           this means that times will be interpreted as floating times (ie. not
           bound to any time zone).
  -k       keep spurious events. Otherwise we remove repeating events with no
           undeleted occurrences and instances at start or end of repeat period.
  -s       Replace new-lines with spaces in summary and location fields
           (Outlook concatenates multiple lines into one).
  -c NAME  select only the specified category NAME
  -d DATE  select only the specified DATE or or date range
           (DATE1-DATE2 or DATE1- or -DATE2).
           DATE is of the form 2009/07/30:21:07 with optional time.
           You can also specify 2009/07/30:21:07-23:00.
  -r NUM   only output specified record numbers: comma separated and can include
           ranges (eg. 10-20,30-). The first record is number 0.
  -i ID    only output the specified record ids (comma separated).

EXAMPLE:

  $prog -t Europe/London CalendarDB-PDat.pdb > palm.ics

REQUIREMENTS:

$prog requires CPAN packages Palm::Datebook, Data::ICal,
DateTime::Format::ICal, Data::ICal::TimeZone, and their dependencies.
These are built into the Windows executable version.

DOCUMENTATION:

See http://hepunx.rl.ac.uk/~adye/software/palm/palm2ical/ for more details.

AUTHOR:
  Tim Adye <T.J.Adye\@rl.ac.uk>

LICENSE:
  This program is free software; you may redistribute it under the terms of the
  Artistic License, as specified at http://dev.perl.org/licenses/artistic.html
EOHELP
#=============================================================================
  return 0;
}

my $verbose= 0;
my %units=        (0 => 'minutes', 1 => 'hours', 2 => 'days');
my %unitmins=     (0 => 1,         1 => 60,      2 => 24*60);
my %repeat=       (0 => 'none', 1 => 'days',  2 => 'weeks',  3 => 'months',  4 => 'months',  5 => 'years');
my %repeat1=      (0 => 'none', 1 => 'daily', 2 => 'weekly', 3 => 'monthly', 4 => 'monthly', 5 => 'yearly');
my @weekdays=   qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
my @shweekdays= qw(su     mo     tu      we        th       fr     sa);
my %weeknum=      (0 => '1st', 1 => '2nd', 2 => '3rd', 3 => '4th', 4 => 'last');
my %weekno=       (0 =>  1,    1 =>  2,    2 =>  3,    3 =>  4,    4 => -1);
my @month=      (undef, qw(January February March April May June July August September October November December));
my %known= (map (($_=>1), qw(id category day month year start_hour start_minute end_hour end_minute
                             when_changed exceptions description location note other_flags other_data
                             recnum)),
            alarm      => {map (($_=>1), qw(advance unit))},
            repeat     => {map (($_=>1), qw(type repeat_days start_of_week weeknum daynum frequency unknown
                                            end_day end_month end_year))},
            timezone   => {map (($_=>1), qw(offset start_hour start_daynum start_weeknum start_month
                                                     end_hour   end_daynum   end_weeknum   end_month
                                            dst_adjustment country flags custom name data))},
            attributes => {map (($_=>1), qw(Busy Delete Dirty Secret archive deleted dirty expunged private))});
my %dupattr=              (map (($_=>1), qw(expunged dirty deleted private)));
my $EPOCH_1904= 2082844800; # Difference between Palm's epoch (1/1/1904) and Unix's epoch (1/1/1970), in seconds ($EPOCH_1904 from Palm::PDB)
my $NOTIME = -$EPOCH_1904;  # Unix epoch for Palm time 0.
my $MINTIME= -172800; # 30/12/1969 midnight - taken as earliest time on Palm
my $have_utf8= 0;

exit palm2ical(@ARGV);

#=============================================================================

package DbExport;

sub new {
  my $class= shift;
  my $pdb= Palm::PDB->new;
  return bless {
    pdb => $pdb,
    @_
  }, $class;
}

sub init {
  my $self= shift;
  my %setopt= @_;
  $self->{$_}= $setopt{$_} for (keys %setopt);
  $self->{utc}= $self->{opt}{z};
  $self->{msghead}= "$self->{file}: " if defined $self->{file};
  return $self;
}

sub gmtime {
  my ($self, $t)= @_;
  unless (defined $t) {
    $self->message ("undefined time for gmtime");
    return;
  }
  my @tm= CORE::gmtime ($t);
  if (!@tm and my $dt= DateTime->from_epoch(epoch=>0)->add (seconds => $t)) {  # some gmtime implementations (eg. Windows) don't allow negative Unix times
    @tm= ($dt->second, $dt->minute, $dt->hour, $dt->day, $dt->month - 1, $dt->year - 1900, $dt->dow-1, $dt->doy-1, 0);
  }
  unless (@tm) {
    $self->err ("bad Unix time: $t");
  } elsif ($t <= $MINTIME) {
    $self->err ("Unix time $t (",sprintf ("%04d/%02d/%02d %02d:%02d:%02d", $tm[5]+1900, $tm[4]+1, @tm[3,2,1,0]),") is out of range");
  }
  return @tm;
}

sub palmtime {
  my ($self, $t)= @_;
  $t += $EPOCH_1904 if $t < $MINTIME;
  return $self->gmtime ($t);  # Palm epoch is local time, so don't use time zone
}

sub timeerr {
  my ($self, $routine)= (shift, shift);
  my $msg= $@;
  if (defined $msg) {
    $msg =~ s/ at $0 line \d+\s*$//;
    $msg= ": $msg";
  } else {
    $msg= "";
  }
  $self->err ("bad date/time: ",sprintf ("%04d/%02d/%02d %02d:%02d:%02d", $_[5], $_[4]+1, @_[3,2,1,0])," ($routine$msg)");
  return;
}

sub timegm {
  my $self= shift;
  my $t= eval {Time::Local::timegm (@_)};
  $self->timeerr ("Time::Local::timegm", @_) unless defined $t;
  return $t;
}

sub timelocal {
  my $self= shift;
  my $t= eval {Time::Local::timelocal (@_)};
  $self->timeerr ("Time::Local::timelocal", @_) unless defined $t;
  return $t;
}

sub weekday {
  my ($self, $day, $month, $year)= @_;
  return ($self->gmtime ($self->timegm (0, 0, 0, $day, $month-1, $year)))[6];
}

sub categories {
  my $self= shift;
  unless ($self->{categories}) {
    my $pdb= $self->{pdb};
    $self->{categories}= [map (defined $_->{name} && $_->{name} ne '' ? $_->{name} : undef, @{$pdb->{appinfo}{categories}})];
  }
  return $self->{categories};
}

sub category {
  my ($self, $r)= @_;
  my $categories= $self->categories;
  return defined $categories->[$r->{category}] ? $categories->[$r->{category}] : "Category $r->{category}";
}

sub dateSelection {
  my $self= shift;
  return $self->{dateSelection} if exists $self->{dateSelection};
  $self->{dateSelection}= undef;
  return unless defined $self->{opt}{d};
  my @parts= (split /-/, $self->{opt}{d}, -1);
  push (@parts, $parts[0]) if @parts==1;
  die "invalid date: $self->{opt}{d}\n" unless @parts==2;
  my ($yy, $mm, $dd, $hh, $MM, @date);
  foreach (@parts) {
    if ($_ eq '') {
      push (@date, undef);
      next;
    }
    ($yy, $mm, $dd,        $hh, $MM)= m!^(\d\d\d\d)/(\d\d?)/(\d\d?)([/:](\d\d?):(\d\d?))?$!
      or (defined $yy and ($hh, $MM)=                                m!^(\d\d?):(\d\d?)$!)
      or die "invalid date: $self->{opt}{d}\n";
    if      ($yy <  70) {
      $yy += 2000;
    } elsif ($yy < 100) {
      $yy += 1900;
    }
    ($hh, $MM)= (!@date ? (0, 0) : (23, 59)) unless defined $hh;
    push (@date, $self->timelocal (0, $MM, $hh, $dd, $mm-1, $yy));
  }
  $self->{dateSelection}= \@date;
  $self->trace ("select dates between ",(defined $date[0] ? $date[0] : "the far past")," and ",(defined $date[1] ? $date[1] : "the far future"));
  return $self->{dateSelection};
}

sub selectByDate {
  my ($self, $r)= @_;
  my $dateSelection= $self->dateSelection or return 1;
  my $t= ($r->{start_minute}==255 && $r->{start_hour}==255)
         ? $self->timelocal (0, 0,                  0,                $r->{day}, $r->{month}-1, $r->{year})
         : $self->timelocal (0, $r->{start_minute}, $r->{start_hour}, $r->{day}, $r->{month}-1, $r->{year});
  return if defined $dateSelection->[0] && $t < $dateSelection->[0];
  return if defined $dateSelection->[1] && $t > $dateSelection->[1];
  return 1;
}

sub categorySelection {
  my $self= shift;
  return $self->{categorySelection} if exists $self->{categorySelection};
  $self->{categorySelection}= undef;
  return unless defined $self->{opt}{c};
  my $spec= $self->{opt}{c};
  my $categories= $self->categories;
  for (my $i= 0; $i<@$categories; $i++) {
    $self->{categorySelection}{$i}++ if defined $categories->[$i] && $categories->[$i] eq $spec;
  }
  if (my ($i)= $spec =~ /^Category (\d+)$/) {
    $self->{categorySelection}{$i}++;
  }
  $self->{categorySelection} or die "invalid category: $spec\n";
  $self->trace ("select category number @{[keys %{$self->{categorySelection}}]}");
  return $self->{categorySelection};
}

sub selectByCategory {
  my ($self, $r)= @_;
  my $categorySelection= $self->categorySelection or return 1;
  return $categorySelection->{$r->{category}};
}

sub idSelection {
  my $self= shift;
  return $self->{idSelection} if exists $self->{idSelection};
  return ($self->{idSelection}= (defined $self->{opt}{i} ? {map(($_=>1),split(",", $self->{opt}{i}))} : undef));
}

sub selectById {
  my ($self, $r)= @_;
  my $idSelection= $self->idSelection or return 1;
  return $idSelection->{$r->{id}};
}

sub recordSelection {
  my $self= shift;
  return $self->{recordSelection} if exists $self->{recordSelection};
  return ($self->{recordSelection}= undef) unless defined $self->{opt}{r};
  my $last= @{$self->{pdb}{records}}-1;
  my @recsel;
  $#recsel= $last;
  foreach (split(",", $self->{opt}{r})) {
    my ($n, $m);
    if (/^\d+$/) {
      if ($_ > $last) { $self->err ("record $_ is beyond the last record, $last"); next; }
      $recsel[$_]++;
    } elsif (($n)= /^(\d+)-$/) {
      if ($n > $last) { $self->err ("record $n is beyond the last record, $last"); next; }
      $recsel[$_]++ for ($n..$last);
    } elsif (($n, $m)= /^(\d+)?-(\d+)$/ and $m>$n) {
      if ($n > $last) { $self->err ("record $n is beyond the last record, $last"); next; }
      if ($m > $last) { $self->err ("record $m is beyond the last record, $last"); $m= $last; }
      $recsel[$_]++ for (($n||0)..$m);
    } else {
      die "invalid record number spec: $self->{opt}{r}\n";
    }
  }
  return ($self->{recordSelection}= \@recsel);
}

sub selectByRecord {
  my ($self, $r)= @_;
  my $recordSelection= $self->recordSelection or return 1;
  return $recordSelection->[$r->{recnum}];
}

sub selectRecord {
  my ($self, $r)= @_;
  return $self->selectByRecord($r) && $self->selectById($r) && $self->selectByCategory($r) && $self->selectByDate($r);
}

sub selectOut {
  my $self= shift;
  my $out= $self->{opt}{o};
  unless (defined $out && $out ne '-') {
    binmode STDOUT;   # Data::ICal already puts \r\n in its output (as per RFC2445), so don't mangle further
    return;
  }
  open (OUT, '>', $out) or die "cannot create output file $out: $!\n";
  select OUT;
  binmode OUT;
  return 1;
}

# This repeats code that will be added to Palm::Datebook in case we still have version 1.011.
sub get_timezone {
  my ($self, $r)= @_;
  my $other_data= $r->{other_data};
  return ($r->{timezone}, $other_data) if $r->{timezone} || !defined $other_data || $self->{pdb}{creator} ne 'PDat';
  my $tz;
  if (length ($other_data) >= 6 && substr ($other_data, 0, 4) eq 'Bd00') {
    my $len= unpack ('n', substr ($other_data, 4, 2));
    if ($len >= 15) {
      my $tzdata= substr ($other_data, 6, $len);
      $tzdata .= ("\0" x ($len-length($tzdata))) if length($tzdata)<$len;  # Palm::Datebook 1.011 removed trailing nulls
      $other_data= length($other_data) > $len+6 ? substr ($other_data, $len+6) : undef;
      @{$tz}{qw(offset start_hour start_daynum start_weeknum start_month
                         end_hour   end_daynum   end_weeknum   end_month
                dst_adjustment country flags name)}= unpack ('n C8 n C2 a*', $tzdata);
      $tz->{name} =~ s/\0$//;
      $tz->{offset}=         $tz->{offset}        -65536 if $tz->{offset}         > 32767;  # signed short
      $tz->{dst_adjustment}= $tz->{dst_adjustment}-65536 if $tz->{dst_adjustment} > 32767;  # signed short
      $tz->{custom}= ($tz->{flags} & 0x80) ? 1 : 0;
      $tz->{flags} &= 0x7f;
      $tz->{data}= $tzdata;
    }
  }
  return ($tz, $other_data);
}

sub process {
  my $self= shift;
  my $pdb= $self->{pdb};
  my $file= $self->{file};
  $pdb->Load ($self->{fh} ? $self->{fh} : $file);
  $self->start;
  my ($i, $n)= (-1, 0);
  for my $r (@{$pdb->{records}}) {
    $i++;
    unless ($r) {
      $self->err ("record $i does not exist");
      next;
    }
    local $self->{msghead}= "$file:$i:$r->{id}: ";
    unless (defined $r->{start_hour}) {   # start_hour is the first byte of the record
      if ($r->{attributes}{Delete} && !$r->{attributes}{archive}) {
        $self->trace ("deleted record is empty");  # no problem
      } else {
        $self->err ("record is empty");
      }
      next;
    }
    $r->{recnum}= $i;
    $self->selectRecord ($r) or next;
    $self->record ($r);
    $n++;
  }
  $self->finish;
  return $n;
}

sub start{}
sub finish{}

sub message {
  my $self= shift;
  print STDERR ((defined $self->{msghead} ? ($self->{msghead}) : ()), @_, "\n");
}

BEGIN {*err= \&message};

sub trace {
  my $self= shift;
  $self->message (@_) if $verbose >= 1;
}

sub debug {
  my $self= shift;
  $self->message (@_) if $verbose >= 2;
}

# Returns printable version of a string, with control characters converted to
# escape sequences. \()[] are also escaped, since we use those as delimiters.
sub escape {
  my ($self, $s)= @_;
  for ($s) {
    s/([][()\\])/\\$1/g;
    s/\t/\\t/g;   s/\n/\\n/g; s/\r/\\r/g; s/\f/\\f/g;
    s/[\b]/\\b/g; s/\a/\\a/g; s/\e/\\e/g;
    s/([\0-\x1F\x7F-\xFF])/sprintf("\\%03o",ord($1))/ge;
  }
  return $s;
}

#=============================================================================

package ICalExport;
use base qw(DbExport);

sub icalDate {
  my ($self, $day, $month, $year, $offset)= @_;
  if ($offset) {
    my $epoch= $self->timegm (0, 0, 0, $day, $month-1, $year);
    $epoch += $offset;
    (undef, undef, undef, $day, $month, $year)= $self->gmtime ($epoch);
    $month++; $year += 1900;
  }
  return sprintf ('%04d%02d%02d', $year, $month, $day);
}

sub icalDateTime {
  my ($self, $day, $month, $year, $hour, $minute, $offset)= @_;
  if ($hour==255 && $minute==255) {
    return $self->icalDate ($day, $month, $year, $offset);
  } else {
    my $tz= "";
    my $epoch;
    if ($self->{utc}) {
      $epoch= $self->timelocal (0, $minute, $hour, $day, $month-1, $year);
      $tz= "Z";
    } elsif ($offset) {
      $epoch= $self->timegm    (0, $minute, $hour, $day, $month-1, $year);
    } else {
      return sprintf ('%04d%02d%02dT%02d%02d%02d', $year, $month, $day, $hour, $minute, 0);
    }
    $epoch += $offset if $offset;
    return tm2ical ($self->gmtime ($epoch)).$tz;
  }
}

sub tm2str {
  my ($str, $second, $minute, $hour, $day, $month, $year)= @_;
  $month++;
  $year += 1900;
  return sprintf ($str, $year, $month, $day, $hour, $minute, $second);
}

sub tm2ical {
  return tm2str ('%04d%02d%02dT%02d%02d%02d', @_);
}

sub icalPalmEpoch {
  my ($self, $epoch)= @_;
  my @tm= $self->palmtime ($epoch);
  if ($self->{utc}) {
    @tm= $self->gmtime ($self->timelocal (@tm));  # Palm epoch is local time, so convert to GMT
    return tm2ical (@tm)."Z";
  } else {
    return tm2ical (@tm);
  }
}

sub epochNum {
  my ($self, $epoch)= @_;
  return tm2str ('%04d%02d%02d%02d%02d%02d', $self->palmtime ($epoch));
}

sub icalDateProperty {
  my $self= shift;
  return [$self->icalDate(@_), {VALUE=>'DATE'}];
}

sub icalTZProperty {
  my ($self, $time)= @_;
  if (defined $self->{timezone}) {
    return [$time, {TZID=>$self->{timezone}}];
  } else {
    return  $time;
  }
}

sub icalDateTimeProperty {
  my $self= shift;
  my ($day, $month, $year, $hour, $minute, $offset)= @_;
  if ($hour==255 && $minute==255) {
    return [$self->icalDate($day, $month, $year, $offset), {VALUE=>'DATE'}];
  } else {
    return $self->icalTZProperty ($self->icalDateTime (@_));
  }
}

sub start {
  my $self= shift;
  my $ical= $self->{ical}= Data::ICal->new;
  my $pdb= $self->{pdb};
  my $opt= $self->{opt};
  $self->{now}= tm2ical ($self->gmtime (time()))."Z";
  $ical->add_property     (prodid            => "$prog $VERSION (".$ical->product_id.")");
  unless ($opt->{n}) {
    $ical->add_properties ('X-PALM-MODNUM'   => $pdb->{modnum},
                           'X-PALM-DBNAME'   => $pdb->{name});
    $ical->add_property   ('X-PALM-CREATED'  => $self->icalPalmEpoch ($pdb->{ctime}))   unless $pdb->{ctime}   == $NOTIME;
    $ical->add_property   ('X-PALM-MODIFIED' => $self->icalPalmEpoch ($pdb->{mtime}))   unless $pdb->{mtime}   == $NOTIME;
    $ical->add_property   ('X-PALM-BACKUP'   => $self->icalPalmEpoch ($pdb->{baktime})) unless $pdb->{baktime} == $NOTIME;
  }

  $self->{ctime}= $self->epochNum($self->{pdb}{ctime});

  my $tz= $opt->{t};
  unless (defined $tz || $opt->{l} || $opt->{z}) {
    my $tzlocal;
    main::useModule ("DateTime::TimeZone::Local");
    eval { $tzlocal= DateTime::TimeZone::Local->TimeZone }
      or die "Cannot determine local time zone\n";
    $tz= $tzlocal->name;
  }
  $self->{timezones}= {};
  if (defined $tz) {
    $self->{timezone}= $tz;
    main::useModule ("Data::ICal::TimeZone");
    my $zone= Data::ICal::TimeZone->new (timezone => $tz);
    if ($zone) {
      $ical->add_entry ($zone->definition);
    } else {
      $self->err ($zone->error_message," - cannot include time zone definition in the iCalendar file");
    }
  }
}

sub dayOfWeek {
  my ($self, $daynum, $weeknum, $month, $year)= @_;
  if ($weeknum < 4) {  # 0=1st, 3=4th
    my $dt= DateTime->new               (year => $year, month => $month, day => 1);
    $dt->add      (days => (($daynum - $dt->day_of_week() + 7) % 7), weeks => $weeknum);
    return $dt;
  } else {  # last
    my $dt= DateTime->last_day_of_month (year => $year, month => $month);
    $dt->subtract (days => (($dt->day_of_week() - $daynum + 7) % 7));
    return $dt;
  }
}

sub icalDayOfWeek {
  my ($self, $daynum, $weeknum, $month, $year, $hour, $minute)= @_;
  my $dt= $self->dayOfWeek ($daynum, $weeknum, $month, $year);
  return $self->icalDateTime ($dt->day, $dt->month, $dt->year, $hour, $minute);
}

sub timezoneEntry {
  my ($self, $tzname, $tz)= @_;
  my $tzent= Data::ICal::Entry::TimeZone->new;
  $tzent->add_property (tzid => $tzname);
  my $tzstd= Data::ICal::Entry::TimeZone::Standard->new;
  my $offset= sprintf ("%+03d%02d", int($tz->{offset}/60), $tz->{offset}%60);
  if ($tz->{dst_adjustment}) {
    my $tzdst= Data::ICal::Entry::TimeZone::Daylight->new;
    my $dst_offset= $tz->{offset} + $tz->{dst_adjustment};
    $dst_offset= sprintf ("%+03d%02d", int($dst_offset/60), $dst_offset%60);
    $tzdst->add_property (tzoffsetfrom => $offset);
    $tzdst->add_property (tzoffsetto   => $dst_offset);
    $tzdst->add_property (dtstart      => $self->icalDayOfWeek ($tz->{start_daynum}, $tz->{start_weeknum}, $tz->{start_month}, 1970, $tz->{start_hour}, 0));
    $tzdst->add_property (rrule        => "FREQ=YEARLY;BYMONTH=$tz->{start_month};BYDAY=$weekno{$tz->{start_weeknum}}".uc($shweekdays[$tz->{start_daynum}]));
    $tzent->add_entry ($tzdst);
    $tzstd->add_property (tzoffsetfrom => $dst_offset);
    $tzstd->add_property (tzoffsetto   => $offset);
    $tzstd->add_property (dtstart      => $self->icalDayOfWeek ($tz->{end_daynum}, $tz->{end_weeknum}, $tz->{end_month}, 1970, $tz->{end_hour}, 0));
    $tzstd->add_property (rrule        => "FREQ=YEARLY;BYMONTH=$tz->{end_month};BYDAY=$weekno{$tz->{end_weeknum}}".uc($shweekdays[$tz->{end_daynum}]));
  } else {
    $tzstd->add_property (tzoffsetfrom => $offset);
    $tzstd->add_property (tzoffsetto   => $offset);
    $tzstd->add_property (dtstart      => "19700101T000000");
  }
  $tzent->add_entry ($tzstd);
  return $tzent;
}

sub record {
  my ($self, $r)= @_;
  if ($r->{attributes}{Delete}) {
    $self->trace ("record marked for deletion");
    return;
  }
  my $file= $self->{file};
  my $opt=  $self->{opt};
  my $ical= $self->{ical};

  my $timezone;
  if ($opt->{Z} and my $tz= ($self->get_timezone ($r))[0]) {
    my $tzname= $tz->{name};
    $tzname =~ s/\s+/_/g;
    my $dtstart= ($r->{start_hour}==255 && $r->{start_minute}==255)
                 ? $self->icalDate     ($r->{day}, $r->{month}, $r->{year})
                 : $self->icalDateTime ($r->{day}, $r->{month}, $r->{year}, $r->{start_hour}, $r->{start_minute});
    my @tzdata= ($tz->{offset});
    if ($tz->{dst_adjustment}) {
      if (exists $weeknum{$tz->{start_weeknum}} && $tz->{start_daynum} < @weekdays && $tz->{start_month} && $tz->{start_month} < @month &&
          exists $weeknum{$tz->{end_weeknum}}   && $tz->{end_daynum}   < @weekdays && $tz->{end_month}   && $tz->{end_month}   < @month) {
        push (@tzdata, @{$tz}{qw(dst_adjustment start_month start_weeknum start_daynum start_hour end_month end_weeknum end_daynum end_hour)});
      } else {
        $self->err ("bad DST range for timezone '$tz->{name}': from day $tz->{start_daynum} of week $tz->{start_weeknum} of month $tz->{start_month} to day $tz->{end_daynum} of week $tz->{end_weeknum} of month $tz->{end_month}");
        $tz= {%$tz};   # local copy
        delete $tz->{dst_adjustment};  # disable bad values
      }
    }
    my $key= join (',', @tzdata);
    unless (defined ($timezone= $self->{timezones}{$tzname}{$key})) {
      unless (defined $self->{timezones}{$tzname}{lastname}) {
        $self->{timezones}{$tzname}{lastname}= "${tzname}_0";
        $timezone= $self->{timezones}{$tzname}{$key}= (($tzname eq $self->{timezone}) ? $self->{timezones}{$tzname}{lastname} : $tzname);
      } else {
        $self->{timezones}{$tzname}{lastname} =~ s/_(\d+)$/"_".($1+1)/e;
        $self->{timezones}{$tzname}{lastname} =~ s/_(\d+)$/"_".($1+1)/e if $self->{timezones}{$tzname}{lastname} eq $self->{timezone};
        $timezone= $self->{timezones}{$tzname}{$key}= $self->{timezones}{$tzname}{lastname};
      }
      $ical->add_entry ($self->timezoneEntry ($timezone, $tz));
    }
  }
  local $self->{timezone}= defined $timezone ? $timezone : $self->{timezone};

  my $e= Data::ICal::Entry::Event->new;
  $e->add_property ('UID', $self->{ctime}."-$r->{id}");
  $e->add_property ('X-PALM-RECORD', $r->{recnum}) unless $opt->{n};
  $e->add_property ('DTSTAMP', $self->{now}) unless $opt->{n};   # reportedly Outlook 2003 (not 2007) requires this
  $e->add_property ('CLASS', ($r->{attributes} && $r->{attributes}{Secret} ? 'PRIVATE' : 'PUBLIC'));
  my ($day, $month, $year)= ($r->{day}, $r->{month}, $r->{year});
  my $category= $self->category($r);
  $e->add_properties (categories => enc($category)) if $category ne 'Unfiled';

  if ($r->{alarm} && $r->{alarm}{advance} != -1) {
    if (exists $units{$r->{alarm}{unit}}) {
      my $a= Data::ICal::Entry::Alarm::Display->new;
      $a->add_properties (description => 'Reminder',
                          trigger     => '-PT'.($r->{alarm}{advance}*$unitmins{$r->{alarm}{unit}}).'M');  # Outlook only accepts minutes, not hours
      $e->add_entry ($a);
    } else {
      $self->err ("bad alarm unit: $r->{alarm}{unit}");
    }
  }

  if (my $rep= $r->{repeat} and my $type= $r->{repeat}{type}) {
    my @recur;     #= (dtstart => $e->start);
    if (exists $repeat1{$type}) {
      push (@recur, freq => $repeat1{$type}, ($rep->{frequency}!=1 ? (interval => $rep->{frequency}) : ()));
    } else {
      $self->err ("bad repeat type: $type");
    }
    if      ($type==2) {
      if (@{$rep->{repeat_days}}== 7 && !grep (($_ && $_!=1), @{$rep->{repeat_days}})) {
        $self->err ("start date $day/$month/$year is not one of the repeat days, ",join(',',@weekdays[grep ($rep->{repeat_days}[$_], 0..6)]))
          unless $rep->{repeat_days}[$self->weekday($day, $month, $year)];
        push (@recur, byday => [@shweekdays[grep ($rep->{repeat_days}[$_], 0..6)]]);
      } else {
        $self->err ("bad weekly repeat days: ",join(',',@{$rep->{repeat_days}}));
      }
      if ($rep->{start_of_week} < @shweekdays) {
        push (@recur, wkst => $shweekdays[$rep->{start_of_week}])   # actually start of week only makes a difference if $rep->{frequency}>1
          if $rep->{start_of_week}!=1;  # Monday is iCalendar default
      } else {
        $self->err ("bad start of week number: $rep->{start_of_week}");
      }
    } elsif ($type==3) {
      if (defined $shweekdays[$rep->{daynum}] && exists $weekno{$rep->{weeknum}}) {
        $self->err ("start date $day/$month/$year is not on a $weekdays[$rep->{daynum}]")
          if $rep->{daynum} != $self->weekday($day, $month, $year);  # don't check weeknum, because that's complicated
        push (@recur, byday => [$weekno{$rep->{weeknum}}.$shweekdays[$rep->{daynum}]]);
      } else {
        $self->err ("bad monthly repeat days: day $rep->{daynum}, week $rep->{weeknum}");
      }
    }

    my $ended= (exists $rep->{end_day} || exists $rep->{end_month} || exists $rep->{end_year});
    my $dtrec;
    my $count;
    if ($ended) {
      $dtrec= DateTime::Event::ICal->recur (@recur,
                                             dtstart => DateTime->new (year =>           $year,  month =>           $month,  day =>           $day),
                                             dtend   => DateTime->new (year => $rep->{end_year}, month => $rep->{end_month}, day => $rep->{end_day}));
      $count= $dtrec->count;
      if (!defined $count) {
        $self->err ("bounded recurrence returned infinite count: @recur dtstart $day/$month/$year until $rep->{end_day}/$rep->{end_month}/$rep->{end_year}");
        $ended= 0;
      } elsif ($count <= 0) {
        $self->err ("recurrence count is $count: @recur dtstart $day/$month/$year until $rep->{end_day}/$rep->{end_month}/$rep->{end_year}");
      }
    } elsif (!$opt->{k}) {
      $dtrec= DateTime::Event::ICal->recur (@recur,
                                            dtstart => DateTime->new (year =>           $year,  month =>           $month,  day =>           $day));
    }

    my @exceptions= $r->{exceptions} ? @{$r->{exceptions}} : ();
    if (!$opt->{k} && @exceptions) {  # tidy up spurious events
      my (%exdate, %delex);
      $exdate{sprintf ("%02d-%02d-%02d", @$_)}++ for @exceptions;
      $self->debug ("exceptions: @{[sort keys %exdate]}");
      {
        my $dtiter= $dtrec->iterator;
        my $skip= 0;
        my $dt;
        while ($dt= $dtiter->next and $exdate{$dt->dmy}) {
          $delex{$dt->dmy}++;
          $skip++;
        }
        unless ($dt) {
          $self->trace ("event has no undeleted instances");
          return;
        }
        if ($skip) {
          $self->trace ("start date $day/$month/$year is deleted - change to ",$dt->day,"/",$dt->month,"/",$dt->year);
          ($day, $month, $year)= ($dt->day, $dt->month, $dt->year);
          $count -= $skip if $ended;
        }
      }
      if ($ended) {
        my $dtiter= $dtrec->iterator;
        my $skip= 0;
        my $dt;
        while ($dt= $dtiter->previous and $exdate{$dt->dmy}) {
          $delex{$dt->dmy}++;
          $skip++;
        }
        if ($skip) {
          $self->trace ("end date $rep->{end_day}/$rep->{end_month}/$rep->{end_year} is deleted - change to ",$dt->day,"/",$dt->month,"/",$dt->year);
          $count -= $skip;
        }
      }
      $self->err ("repeat count unaccountably reduced to $count") if $ended && $count <= 0;
      @exceptions= grep (!$delex{sprintf ("%02d-%02d-%02d", @$_)}, @exceptions) if %delex;
    }

    #   Use COUNT, rather than UNTIL since RFC2445 requires UNTIL to be in UTC.
    #   Calculating that (what with DST changes over the repeat range) is probably more
    #   complicated.
    push (@recur, count => $count) if $ended;
    $self->debug ("recur ",join (' ', map (ref() ? join(',',@$_) : $_, @recur)));
    # Create RRULE value by hand (DateTime::Format::ICal->format_recurrence doesn't produce ICal format time).
    my $recur= uc (join (';', map ("$recur[2*$_]=".(ref($recur[2*$_+1]) ? join (',', @{$recur[2*$_+1]}) : $recur[2*$_+1]), 0..($#recur/2))));
    $e->add_property (rrule => $recur);

    if (@exceptions) {
      # Add each property separately - I don't know how to add a property with a
      # comma-separated list without Data::ICal escaping all the commas.
      $e->add_property (exdate => $self->icalDateTimeProperty ($_->[0], $_->[1], $_->[2],
                                                               $r->{start_hour}, $r->{start_minute})) for @exceptions;
    }
  } elsif ($r->{exceptions} && @{$r->{exceptions}}) {
    $self->err ("exceptions without repeat: ",join (',', map (sprintf("%02d/%02d/%04d", @$_), @{$r->{exceptions}})));
  }

  if ($r->{start_hour}==255 && $r->{start_minute}==255 && $r->{end_hour}==255 && $r->{end_minute}==255) {
    $e->add_property (dtstart => $self->icalDateProperty ($day, $month, $year));
    $e->add_property (dtend   => $self->icalDateProperty ($day, $month, $year, 86400));
  } else {
    my $offset= ($r->{end_hour}<$r->{start_hour} || ($r->{end_hour}==$r->{start_hour} && $r->{end_minute}<$r->{start_minute}))
                ? 86400 : 0;
    $e->add_property (dtstart => $self->icalDateTimeProperty ($day, $month, $year, $r->{start_hour}, $r->{start_minute}));
    $e->add_property (dtend   => $self->icalDateTimeProperty ($day, $month, $year, $r->{end_hour},   $r->{end_minute},
                                                              $offset));
  }

  $e->add_property (summary     => enc($r->{description}, $opt->{s})) if defined $r->{description} && $r->{description} ne '';
  $e->add_property (location    => enc($r->{location},    $opt->{s})) if !$opt->{L} && defined $r->{location};
  $e->add_property (description => enc($r->{note}))                   if defined $r->{note};
  $ical->add_entry ($e);
  return;
}

sub enc {
  my ($s, $nl)= @_;
  if ($nl) {
    $s =~ s/\n+$//;
    $s =~ s/\s*\n\s*/ /g;
  }
  if (!$have_utf8 && $s =~ /([\x80-\xff])/) {
    $have_utf8= $1;
  }
  return Encode::encode_utf8 (Encode::decode ("cp1252", $s, Encode::WARN_ON_ERR));
}

sub finish {
  my $self= shift;
  my $ical= $self->{ical};
  $ical->add_property ('X-PALM--UTF8' => enc("This file contains UTF-8 characters such as \"$have_utf8\"")) if $have_utf8 && !$self->{opt}{n};
  $self->selectOut;
  print $ical->as_string;
}

#=============================================================================

package DbPrint;
use base qw(DbExport);

sub epoch {
  my ($self, $epoch)= @_;
  my ($second, $minute, $hour, $day, $month, $year)= $self->palmtime ($epoch);
  $month++;
  $year += 1900;
  return sprintf ('%02d/%02d/%04d %02d:%02d:%02d', $day, $month, $year, $hour, $minute, $second);
}

sub start {
  my $self= shift;
  my $pdb= $self->{pdb};
  my $categories= $self->categories;
  $self->selectOut;
  print "File $pdb->{name}, unique id seed $self->{pdb}{uniqueIDseed}",
        ", modification $pdb->{modnum}, created ", $self->epoch($pdb->{ctime}),
        ", modified ", $self->epoch($pdb->{mtime}), ", backup ", $self->epoch($pdb->{baktime}),
        ", categories: ",
        join (', ', map (defined $categories->[$_] ? ("$_:'$categories->[$_]'") : (), 0..$#$categories)),"\n";
}

sub record {
  my ($self, $r)= @_;
  my $file= $self->{file};
  my $opt= $self->{opt};
  printf "%4d:%d:%s: %02d/%02d/%04d", $r->{recnum}, $r->{id}, $self->category($r), $r->{day}, $r->{month}, $r->{year};
  printf " %02d:%02d-%02d:%02d", $r->{start_hour}, $r->{start_minute}, $r->{end_hour}, $r->{end_minute}
    unless $r->{start_hour}==255 && $r->{start_minute}==255 && $r->{end_hour}==255 && $r->{end_minute}==255;
  my ($tz, $other_data)= $self->get_timezone ($r);
  if ($tz && !$opt->{z}) {
    print " (timezone '$tz->{name}' (",($tz->{custom} ? "custom, " : ""),
          "country $tz->{country}) ",sprintf ("%+03d:%02d", int($tz->{offset}/60), $tz->{offset}%60);
    if ($tz->{dst_adjustment}) {
      my $dst_adjustment= $tz->{offset} + $tz->{dst_adjustment};
      printf (" DST %+03d:%02d", int($dst_adjustment/60), $dst_adjustment%60);
      if (exists $weeknum{$tz->{start_weeknum}} && $tz->{start_daynum} < @weekdays && $tz->{start_month} && $tz->{start_month} < @month &&
          exists $weeknum{$tz->{end_weeknum}}   && $tz->{end_daynum}   < @weekdays && $tz->{end_month}   && $tz->{end_month}   < @month) {
        print " from $weeknum{$tz->{start_weeknum}} $weekdays[$tz->{start_daynum}] of $month[$tz->{start_month}] at $tz->{start_hour}:00 to $weeknum{$tz->{end_weeknum}} $weekdays[$tz->{end_daynum}] of $month[$tz->{end_month}] at $tz->{end_hour}:00";
      } else {
        $self->err ("bad DST range for timezone '$tz->{name}': from day $tz->{start_daynum} of week $tz->{start_weeknum} of month $tz->{start_month} to day $tz->{end_daynum} of week $tz->{end_weeknum} of month $tz->{end_month}");
      }
    }
    print ", flags=$tz->{flags}" if !$opt->{n} && $tz->{flags};
    print ")";
  }
  my $al= 0;
  if ($r->{alarm} && $r->{alarm}{advance} != -1) {
    if (exists $units{$r->{alarm}{unit}}) {
      print " alarm $r->{alarm}{advance} $units{$r->{alarm}{unit}} beforehand";
      $al++;
    } else {
      $self->err ("bad alarm unit: $r->{alarm}{unit}");
    }
  }
  if (my $rep= $r->{repeat} and my $type= $r->{repeat}{type}) {
    print "," if $al;
    if (exists $repeat{$type}) {
      if ($rep->{frequency} == 1) {
        print " repeat $repeat1{$type}";
      } else {
        print " repeat every $rep->{frequency} $repeat{$type}";
      }
    } else {
      $self->err ("bad repeat type: $type");
    }
    if      ($type==2) {
      if (@{$rep->{repeat_days}}== 7 && !grep (($_ && $_!=1), @{$rep->{repeat_days}})) {
        print " on ",join(',',@weekdays[grep ($rep->{repeat_days}[$_], 0..6)]);
        $self->err ("start date $r->{day}/$r->{month}/$r->{year} is not one of the repeat days, ",join(',',@weekdays[grep ($rep->{repeat_days}[$_], 0..6)]))
          unless $rep->{repeat_days}[$self->weekday($r->{day}, $r->{month}, $r->{year})];
      } else {
        $self->err ("bad weekly repeat days: ",join(',',@{$rep->{repeat_days}}));
      }
      if ($rep->{start_of_week} < @weekdays) {
        print " (week starts $weekdays[$rep->{start_of_week}])";  # actually start of week only makes a difference if $rep->{frequency}>1
      } else {
        $self->err ("bad start of week number: $rep->{start_of_week}");
      }
    } elsif ($type==3) {
      if (defined $weekdays[$rep->{daynum}] && exists $weeknum{$rep->{weeknum}}) {
        $self->err ("start date $r->{day}/$r->{month}/$r->{year} is not on a $weekdays[$rep->{daynum}]")
          if $rep->{daynum} != $self->weekday($r->{day}, $r->{month}, $r->{year});  # don't check weeknum, because that's complicated
        print " on $weeknum{$rep->{weeknum}} $weekdays[$rep->{daynum}] of the month";
      } else {
        $self->err ("bad monthly repeat days: day $rep->{daynum}, week $rep->{weeknum}");
      }
    }
    printf " until %02d/%02d/%04d", $rep->{end_day}, $rep->{end_month}, $rep->{end_year}
      if $rep->{end_day} || $rep->{end_month} || $rep->{end_year};
    if ($r->{exceptions} && @{$r->{exceptions}}) {
      print " except ", join (',', map (sprintf("%02d/%02d/%04d", @$_), @{$r->{exceptions}}));
    }
    print " (unknown=$rep->{unknown})" if !$opt->{n} && $rep->{unknown};
  } elsif ($r->{exceptions} && @{$r->{exceptions}}) {
    $self->err ("exceptions without repeat: ",join (',', map (sprintf("%02d/%02d/%04d", @$_), @{$r->{exceptions}})));
  }
  if ($r->{attributes}) {
    print " (",join (',', map ($r->{attributes}{$_}!=1 ? ("$_=$r->{attributes}{$_}") : $dupattr{$_} ? () : ("$_"), sort keys %{$r->{attributes}})),")";
  }
  print " (other flags=$r->{other_flags})" if !$opt->{n} && $r->{other_flags};
  if (!$opt->{n} && defined $other_data) {
    if ($other_data =~ /^Bd01\0\04\0\01\0*$/) {  # what's this?
      print " (Bd01 flag)";
    } else {
      print " (other data: '",$self->escape($other_data),"')";
    }
  }
  print ": ",$self->escape($r->{description})  if defined $r->{description} && $r->{description} ne '';
  print " (",$self->escape($r->{location}),")" if !$opt->{L} && defined $r->{location};
  print " [",$self->escape($r->{note}),    "]" if defined $r->{note};
  print "\n";
  unless ($opt->{n}) {
    my @xtra;
    for my $k (sort keys %$r) {
      if (!$known{$k}) {
        push (@xtra, $k);
      } elsif (ref $r->{$k} && ref $r->{$k} eq 'HASH') {
        if (!ref $known{$k} || ref $known{$k} ne 'HASH') {
          push (@xtra, map ("$k.$_", sort keys %{$r->{$k}}));
        } else {
          push (@xtra, map ($known{$k}{$_} ? () : ("$k.$_"), sort keys %{$r->{$k}}));
        }
      }
    }
    $self->err ("extra fields: @xtra") if @xtra;
  }
}

#=============================================================================

package main;

sub palm2ical {
  my $opt= {};
  Getopt::Std::getopts ('h?vVlzpLnkso:c:d:r:i:t:TZ', $opt);
  $verbose= $opt->{V} ? 2 : $opt->{v} ? 1 : 0;
  return help() if $opt->{h} || $opt->{'?'} || @ARGV > 1;
  if ($opt->{T}) {
    return help() if @ARGV;
    main::useModule ("Data::ICal::TimeZone");
    print $_,"\n" for (Data::ICal::TimeZone->zones);
    eval { main::useModule ("DateTime::TimeZone::Local") };
    unless ($@) {
      my $tzlocal;
      $tzlocal= eval { DateTime::TimeZone::Local->TimeZone }
        and print "Local time zone: ",$tzlocal->name,"\n";
    }
    return 0;
  }
  my ($file, $fh);
  if (@ARGV) {
    $file= $ARGV[0];
  } else {   # default: if PDB file is in the current directory, process that.
    foreach my $f (@defaultFiles) {
      open (FILE, '<', $f) or next;
      ($opt->{o}= $f) =~ s/(\.[^.]*)?$/.ics/ unless defined $opt->{o};
      print STDERR "read Palm Database $f and write iCalendar file $opt->{o}\n";
      $file= $f;
      $fh= \*FILE;
      last;
    }
    return help() unless $fh;
  }
  my $db= $opt->{p} ? DbPrint->new : ICalExport->new;
  $db -> init (file => $file, fh => $fh, opt => $opt) -> process;
  return 0;
}

# Usage: useModule ($MODULE)
# Similar to
#   use MODULE ();
# except it is executed at run-time.
sub useModule {
  my $module= shift;
##local $Exporter::Verbose= 1;
  eval "require $module" or die;
  return;
}
