#!/usr/bin/perl
# Changelog:
# ver. 0.11 Wed Jun 23 2004
# MST  POD documentation for CPAN, update my mail address
# ver. 0.10 Wed Jun 23 2004
# MST support for monthly recurring meetings
# ver. 0.9 Sun Apr 20 2003
# MST Translate from hebrew mail that comes in 8-bit encoding.
#     On failure, exit and dont create an appointment (only note)
#     Heuristic to allow white space at the beginning of When: lines 
# ver. 0.8 Thu Oct 25
# MST Handle events that span several days
# ver. 0.7 Thu Sep 13
# MST Handle european format dates like 31/05/2001 when
#    the first number is > 12
# ver. 0.6 Wed Jun 20
# MST fixed bug in multiline When:, added hebrew date parsing
# ver. 0.5 Wed Aug 30
# MST fix bug in date parsing
# ver. 0.4 Thu May 18
# MST switch to using Date::Manip perl library for date
# parsing and calculations.
# Time zone support
# By default, create a TODO item if date can not be parsed.
# ver. 0.3 Wed May  3
# MST add space after "Location" field to show better in ical,
#     option to limit the message length
# ver. 0.2 Thu Mar 16
# MST - better handle multi-line dates and recurring events
# ver. 0.1 Sun Mar 12 
# Marc Martinez - fixes for perl 5.005


#Set this variable to limit the message length to first $top_lines.
#This is useful to make sure that you don't get a reminder
#notice that fill your entire screen.
$top_lines=20;

#Set this variable to enable zone conversion
$use_zone=1;

use Date::Manip;

my $VERSION = 0.11;

#This might be needed to fix your local time zone
#if Date::Manip is installed incorrectly or
#if you have a non-standard time zone
#
&Date_Init("TZ=+0200");

#This is a pattern to match your local time zone: zone 
# conversions will be ignored for this zone
$local_zone="Israel";

#Uncomment this if you prefer the script to exit
#if there is an error parsing the message
#By default, creates a TODO item for today with
#a message
#$on_errorOnError=1;

$allmonths="1 2 3 4 5 6 7 8 9 10 11 12";
#Date format for ical
$date_format="%d/%m/%Y";
#$date_format="%e/%f/%Y";
$arg=shift @ARGV;
$task=1 if ($arg eq "-task");



chop($hostname = `hostname`);

while(<STDIN>) {
    chomp;
    s/^>\s*//o;
    if ($previous =~ m/^\s*------_=_NextPart/o &&
	m#^\s*Content-Type:#o && ! m#text/plain#o) {
	$skip_attachment=1;
    }
    if (m/^\s*------_=_NextPart/) {
	$skip_attachment=0;
	$previous=$_;
	next;
    }
    if ($skip_attachment) {
	$previous=$_;
	next;
    }

    s/\[/(/go;
    s/\]/)/go;
    if (/^-----Original Appointment-----/) {
	$from=undef;
	$subj=undef;
	$when=undef;
	$where=undef;
	@text=undef;
	$is_text=undef;
	$is_sep=undef;
	$forward=1;
	next;
    }
    #s/^>\s*//o if ($forward);
    if ($task) {
	last if ($previous =~m/^-----/o) and (/^Message-ID:/o);
	last if ($is_sep and /^------_=_NextPart/o);
    }
    if ($is_sep and $is_text) {
	push @text,$_;
	next;
    }
    $from=$1 if (/^From:\s*(.*)/);
    $subj=$1 if (/^Subject:\s*(.*)/);
    $when=$_ if (/^When:/);
    if (/^\s*When:/ and not defined ($when)) {
      $when=$_; $when=~s/^\s*//;
    } 
    if ((not /^[A-Za-z]+:/) and ($previous =~ m/^When:/)
         and not (/^\*~\*~\*~\*~\*~\*~\*~\*~\*~\*/) ) {
	$when.=" " . $_;
	$previous .=" " . $_;
	next;
    }
    $due=$1 if (/^Due Date:\s*(.*)/);

    $where=$1 if (/^Where:\s*(.*)/);
    $where =~ s/\s*$//;
    
    if ($task) {
	if (/^Owner:/) {
	    $is_sep=1;
	    $is_text=0;
	} else {
	    $is_text=1;
	}
    }
    else {
	if ($forward) {
	    if (/^$/) {
		$is_sep=1;
	    } else {
		$is_text=1;
	    }
	} else {
	    if (/^\*~\*~\*~\*~\*~\*~\*~\*~\*~\*/) {
		$is_sep=1;
		$is_text=0;
	    } else {
		$is_text=1;
	    }
	}
    }

    $previous=$_;
}
$owner=$from;
$content=$subj;
$content.="\nLocation: $where " if ($where);
$content.="\n". join("\n",@text);

if (defined ($top_lines)) {
#Ignore all but the first $top_lines lines
    @content_array=split("\n",$content);
    if ($#content_array > $top_lines) {
	$content = join("\n",@content_array[1..$top_lines],"...");
    }
}

##################################################################
# Translate Hebrew to English
##################################################################
$due = heb2eng($due);
$when = heb2eng($when);

##################################################################
# Formatted Output for ical
##################################################################

$date=$when;
if ($task) {
    $sdate=&UnixDate($due,$date_format);
    create_todo($sdate);
    exit(0);
} 
elsif ($date=~m#^When:\s+Occurs\s+every\s+(.*)\s+effective\s+(.*)#) {
    ($sdate,$start,$length,$fdate,$offset)=gettimes($2);


    ($every,$weekdays)=getevery($1,$offset);
    $every || $weekdays || on_error ("1: Unable to parse date : $1");

    create_item($sdate,$start,$length,$fdate,$every,$weekdays);
    exit(0);

} 
elsif ($date=~m#^When:\s+Occurs\s+day\s+(.*)of every\s+([0-9]+)\s+month\(s\)\s+effective\s+(.*)#) {
    ($sdate,$start,$length,$fdate,$offset)=gettimes($3);


#    ($every,$weekdays)=getevery($1,$offset);
#    $every || $weekdays || on_error ("1: Unable to parse date : $1");

    create_item($sdate,$start,$length,$fdate,undef,undef,$2);
    exit(0);

} 
elsif ($date=~m/^When:(.*)/) {
    ($sdate,$start,$length)=gettimes($1);
    create_item($sdate,$start,$length);
    exit(0);
} 
else {
    on_error ( "2: Unable to parse date: $date\n");
}

#Get number of week day (given by name)+ offset days.
sub getdaynum {
    my($name,$offset)= @_;
    my($d);
    getday: {
	    $d=1, last getday if ($name =~ m/^Sun/oi); 
	    $d=2, last getday if ($name =~ m/^Mon/oi); 
	    $d=3, last getday if ($name =~ m/^Tue/oi); 
	    $d=4, last getday if ($name =~ m/^Wed/oi); 
	    $d=5, last getday if ($name =~ m/^Thu/oi); 
	    $d=6, last getday if ($name =~ m/^Fri/oi); 
	    $d=7, last getday if ($name =~ m/^Sat/oi); 
	    return undef;
	}

    $d = $d +$offset;
    if ($d < 1) { $d=$d+7;}
    if ($d > 7) { $d=$d-7;}

    return $d;
}

#return start date, start time and length , finish date
#(if available) and offset (in days).
#The offset is non zero if the same time falls
#on different days in the two time zones,
#and equals [day_here] - [day_there]


#Handles the following patterns:
#1/27/00 from 2:00 PM to 3:00 PM (GMT+02:00) Israel.
#1/27/00 until 1/27/00 from 2:00 PM to 3:00 PM (GMT+02:00) Israel.
#12/20/1999 from 11:00 AM to 12:00 PM (GMT+02:00) Israel.
#Thursday, January 20, 2000 3:00 PM-4:00 PM (GMT+02:00) Israel.
#Wednesday, August 30, 2000 14:00-15:00 (GMT+02:00) Israel.
#When: יום חמישי 01 נובמבר 2001 15:30 to יום שישי 02 נובמבר 2001 0:00

sub gettimes {
    my($in)=@_;
    my($date)=$in;
    if ($date =~ s/\s+from\s+([0-9]+:[0-9]+.*)//) {
    } elsif ($date =~ s/([0-9]+:[0-9]+.*)//) {
    } else {
	on_error ("3: Unable to parse date $in");
    }
    my($times)=$1;
    $times=~s/\(GMT([^)]*)\)\s*(.*)//;
    my($zone_hours)=$1;
    my($zone_name)=$2;

    #ignore zone if this is local one
    $zone_hours = undef if ($local_zone && $zone_name =~ m/$local_zone/);
    #Remove : from zone, to get +-HHMM format
    $zone_hours =~ s/:\s//g;

    my($tfrom,$tto)=split(/\bto\b|-/,$times);
    my($dstop);
    
    if (not ($tto =~ m/^\s*[0-9]+:[0-9]+.*/)) {
       $tto =~ s/^(.*\s+)([0-9]+:[0-9]+.*)/$2/;
       $dstop = $1;
    }

    on_error ("4: Unable to parse date: $in") if not ($tfrom and $tto);

    my($dstart,$dfinish) = split(/until/,$date);

    #Form times for ParseDate
    if (not $dstop) { $dstop=$dstart; }
    my($from)="$dstart $tfrom $zone_hours";
    my($to)="$dstop $tto $zone_hours";

    my($date0,$date1,$date2,$length, $stime, $sdate, $fdate);
    $date1=&ParseDate($from) || on_error ("5: Unable to parse date: $from");
    $date2=&ParseDate($to) || on_error ("6: Unable to parse date: $to");
    $date0=&Date_SetTime($date1,"00:00");
    $stime=&Delta_Format(&DateCalc($date0,$date1),0,"%mh");
    $length=&Delta_Format(&DateCalc($date1,$date2),0,"%mh");
    $sdate=&UnixDate($date1,$date_format);
    if ($dfinish) {
	my($date3)=&ParseDate($dfinish) || on_error ("7: Unable to parse date: $dfinish");
	$fdate=&UnixDate($date3,$date_format) || 
	on_error ("8: Unable to parse date: $dfinish");
    }

    #Offset: check if the time falls on different days
    #in the local and specified time zone. If it does, offset is the
    #difference [day_here] - [day_there]
    my($offset);
    if ($use_zone) {
        #Calculate offset. We need to find out what day is it "there",
        #that is just strip the zone
	my($from_here)="$dstart 00:00";
	my($date0_here)=&ParseDate($from_here) || 
	    on_error ("9: Unable to parse date: $from_here");
	$offset=&Delta_Format(&DateCalc($date0_here,$date0),0,"%dh");
    }

    return ($sdate,$stime,$length, $fdate,$offset);
}


#Return weekdays and/or 
#Recurring patterns:
#every 2 week(s) on Thursday 
#every 2 days(s) 
#every Monday and Wednesday
#every Monday
#input : recurrence pattern + 
#day offset.
# The offset is for weekly patterns with
# time zones: we might need to fix the 
# week day.
sub getevery {
    my($in, $offset)=@_;
    my($every,@weekdays,$d,$day);
    if ($in =~ m/^\s*([0-9]+)\s+week/) {
	$every=$1*7;
	return ($every,undef);
    }
    if ($in =~ m/^\s*([0-9]+)\s+day/) {
	$every=$1;
	return ($every,undef);
    }
#Try to match weekdays
    my(@list)=split(/((and)?[\s,])+/,$in);

    foreach $d (@list) {
        $day=getdaynum($d, $offset);
        next if not defined($day);
	push @weekdays,$day;
    }
#If there is only one week day, just translate it to
#every 7th day
    return (7,undef) if ($#weekdays < 1);
    return (undef,join(' ',@weekdays));
}

sub create_todo {
    my($sdate)=@_;
    if (not $sdate) {
	$sdate=&UnixDate("today",$date_format);
    }
    print "Note [\n";
    print "Length [30]\n";
    print "Uid [$hostname" . "_" . "$$]\n";
    print "Owner [$owner]\n";
    print "Contents [$content]\n";
    print "Remind [0]\n";
    print "Hilite [always]\n";
    print "Todo []\n";
    print "Dates [Single $sdate End\n";
    print "]\n";
    print "]\n";
}

sub create_item {
    my($sdate,$start,$length,$fdate,$every,$weekdays,$monthly)=@_;
    print "Appt [\n";
    print "Start [$start]\n";
    print "Length [$length]\n";
    print "Uid [$hostname" . "_" . "$$]\n";
    print "Owner [$owner]\n";
    print "Contents [$content]\n";
    print "Remind [1]\n";
    print "Hilite [always]\n";

    if ($every || $weekdays || $monthly) {
	if ($monthly) {
	    print "Dates [Months $sdate $monthly\n";
  } elsif ($every) {
	    print "Dates [Days $sdate $every\n";
	} elsif ($weekdays) {
	    print "Dates [WeekDays $weekdays Months  $allmonths\n";
	} 
	if ($fdate) {
	    print "Start $sdate\n";
	    print "Finish $fdate End\n";
	} else {
	    print "Start $sdate End\n";
	} 
    } else {
	print "Dates [Single $sdate End\n";
    }

    print "]\n";
    print "]\n";
}

sub on_error {
    if ($dieOnError) {
	print STDERR join("\n",@_); 
	exit(1);
    }
    $content=join("\n",@_,$content);
    create_todo;
    exit(2);
}

#Translate hebrew mime into plain english
sub heb2eng {
  my($line)=@_;

  #Guess this is Hebrew by the fact that date zone is Jerusalem
  return $line unless ( $line =~ m/Jerusalem/);

  #Remove extra = that may appear in the encoding
  $line =~ s/\s+=\s+/ /go;
  #Yom rishon/sheni/shlishi/revii/hamishi/shishi/shabat
  $line =~ s/=E9=E5=ED\s+(=F8=E0=F9=E5=EF|=E0(=[0-9A-F][0-9A-F])*)/Sunday/go;
  $line =~ s/=E9=E5=ED\s+(=F9=F0=E9|=E1(=[0-9A-F][0-9A-F])*)/Monday/go;
  $line =~ s/=E9=E5=ED\s+(=F9=EC=E9=F9=E9|=E2(=[0-9A-F][0-9A-F])*)/Tuesday/go;
  $line =~ s/=E9=E5=ED\s+(=F8=E1(=E9)?=F2=E9|=E3(=[0-9A-F][0-9A-F])*)/Wednesday/go;
  $line =~ s/=E9=E5=ED\s+(=E7=EE=E9=F9=E9|=E4(=[0-9A-F][0-9A-F])*)/Thursday/go;
  $line =~ s/=E9=E5=ED\s+(=F9=E9=F9=E9|=E5(=[0-9A-F][0-9A-F])*)/Friday/go;
  $line =~ s/=E9=E5=ED\s+(=F9=E1=FA|=E6(=[0-9A-F][0-9A-F])*)/Saturday/go;

  $line =~ s/\xE9\xE5\xED\s+(\xF8\xE0\xF9\xE5\xEF|\xE0[\xE0-\xFA]*)/Sunday/go;
  $line =~ s/\xE9\xE5\xED\s+(\xF9\xF0\xE9|\xE1[\xE0-\xFA]*)/Monday/go;
  $line =~ s/\xE9\xE5\xED\s+(\xF9\xEC\xE9\xF9\xE9|\xE2[\xE0-\xFA]*)/Tuesday/go;
  $line =~ s/\xE9\xE5\xED\s+(\xF8\xE1(\xE9)?\xF2\xE9|\xE3[\xE0-\xFA]*)/Wednesday/go;
  $line =~ s/\xE9\xE5\xED\s+(\xE7\xEE\xE9\xF9\xE9|\xE4[\xE0-\xFA]*)/Thursday/go;
  $line =~ s/\xE9\xE5\xED\s+(\xF9\xE9\xF9\xE9|\xE5[\xE0-\xFA]*)/Friday/go;
  $line =~ s/\xE9\xE5\xED\s+(\xF9\xE1\xFA|\xE6[\xE0-\xFA]*)/Saturday/go;

  #Months
  $line =~ s/=E9(=E0)?=F0=E5=E0=F8/January/go;
  $line =~ s/=E9(=E0)?=F0=E5=E0=F8/January/go;
  $line =~ s/=F4=E1=F8=E5=E0=F8/February/go;
  $line =~ s/=EE=F8=F5/March/go;
  $line =~ s/=E0=F4=F8=E9=EC/April/go;
  $line =~ s/=EE=E0=E9/May/go;
  $line =~ s/=E9=E5=F0=E9/June/go;
  $line =~ s/=E9=E5=EC=E9/July/go;
  $line =~ s/=E0=E5=E2=E5=F1=E8/August/go;
  $line =~ s/=F1=F4=E8=EE=E1=F8/September/go;
  $line =~ s/=E0=E5=F7=E8=E5=E1=F8/October/go;
  $line =~ s/=F0=E5=E1=EE=E1=F8/November/go;
  $line =~ s/=E3=F6=EE=E1=F8/December/go;

  $line =~ s/\xE9(\xE0)?\xF0\xE5\xE0\xF8/January/go;
  $line =~ s/\xE9(\xE0)?\xF0\xE5\xE0\xF8/January/go;
  $line =~ s/\xF4\xE1\xF8\xE5\xE0\xF8/February/go;
  $line =~ s/\xEE\xF8\xF5/March/go;
  $line =~ s/\xE0\xF4\xF8\xE9\xEC/April/go;
  $line =~ s/\xEE\xE0\xE9/May/go;
  $line =~ s/\xE9\xE5\xF0\xE9/June/go;
  $line =~ s/\xE9\xE5\xEC\xE9/July/go;
  $line =~ s/\xE0\xE5\xE2\xE5\xF1\xE8/August/go;
  $line =~ s/\xF1\xF4\xE8\xEE\xE1\xF8/September/go;
  $line =~ s/\xE0\xE5\xF7\xE8\xE5\xE1\xF8/October/go;
  $line =~ s/\xF0\xE5\xE1\xEE\xE1\xF8/November/go;
  $line =~ s/\xE3\xF6\xEE\xE1\xF8/December/go;
  
  #Hebrew dates are sometimes in reverse order
  #If it is possible to figure out from the format 
  # (because first number is >12), do so for all dates

  #Note if there is one match, we change all dates,
  #as they are always in consistent format
  
  if ($line =~ m#\s(1[3-9]|2[0-9]|3[0-1])/(0?[1-9]|1[0-2])/#) {
    $line =~ s#(\s)(0?[1-9]|[1-2][0-9]|3[0-1])/(0?[1-9]|1[0-2])/#$1$3/$2/#g;
  }

  return $line;
}

=head1 NAME

Outlook2Ical - convert mail messages produced by MS Outlook Calendar to .calendar file for the ical program.

=head1 DESCRIPTION

Outlook2Ical is a simple perl script that converts mail messages produced by
MS Outlook Calendar to .calendar file used by the ical program.
It handles appointment messages and task requests (with -task flag).
Download the latest version from CPAN scripts section.

You will also need the Date Manip module, which can be downloaded from:
 http://www.perl.com/CPAN-local/modules/by-module/Date/.

Please drop me a line if you find it useful.
For usage tips, and explanation about the ical program,  please review the
README file.

Click here: http://www.toptown.com/hp/mtsirkin/outlook/ical_snapshot.gif
to see a screen snapshot of ical running.

There is no warranty of any kind.


=head1 README

This is a simple perl script that converts mail messages
produced by MS Outlook Calendar to .calendar file used by the ical program.
It handles appointment messages and task requests (with -task flag).

There is no warranty of any kind.

To see an appointment that you yourself created in Outlook, just 
forward it to yourself from Outlook - this way you get a mail message.

To use this, you need the Date Manip module, which can be downloaded from:
http://www.perl.com/CPAN-local/modules/by-module/Date/

Also, outlook2ical.pl will not work, if the file .calendar 
was not previously created with a header like:

Calendar [v2.0]

The simplest way to generate it is just to run ical once and do File/Save.
Please drop me a line at address misha at cpan dot org, if you find it useful.

I use it by the following receipe in my .procmailrc file:

:0 Bc:
* ^When:
* ^\*\~\*\~\*\~\*\~\*\~\*\~\*\~\*\~\*\~\*
|$HOME/bin/outlook2ical.pl>>$HOME/.calendar

:0
* ^Subject: FW:
{
:0 Bc:
* ^>[   ]*-----Original Appointment-----
* ^>[   ]*When:
|$HOME/bin/outlook2ical.pl>>$HOME/.calendar
}

:0
* ^Subject: Task Request:
{
:0 Bc:
* ^Owner:
* ^Status:
* ^Subject:
* ^Total Work:
* ^Actual Work:
* ^Percent Complete:
|$HOME/bin/outlook2ical.pl -task>>$HOME/.calendar
}

About ical:

Ical is a TCL program distributed e.g. as part of RedHat Linux. 
I was able to run it on HPUX and AIX without any problems.

Ical used to be developed by Sanjay Ghemawat.
However, the links have gone all dead.
There does not seem to exist a mailing list for the development of the program,
nor a central CVS/distribution site.
If you have more information about what happened and/or comments,
please let me know at  misha at cpan dot org.

More about Ical:
Ical is a Tcl/Tk-based calendar program.
Here is a small list of useful features of ical:
 Items can be created, edited, and deleted easily.
 Items can be made to repeat in various ways.
 Ical will post reminders for upcoming appointments.
 Ical can print and list item occurrences.
 An ical calendar can include other calendars.
 Ical calendars can be shared by different users.

Click here: http://www.toptown.com/hp/mtsirkin/outlook/ical_snapshot.gif
to see a screen snapshot.

=head1 PREREQUISITES

This script requires the C<Date::Manip> module.

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

Mail

=cut