#!/bin/sh
############################################################################
# Copyright (c) 1994 by Sanjay Ghemawat
############################################################################
#
# Move old calendar entries into another calendar.  This can be used
# for archiving old entries without having them take space in your
# day-to-day calendar.
#
# Example:
#
# The folllowing command will move expired entries from the user's
# calendar into the file "calendar-archive".
#
#	icalexpire calendar-archive
#
# Usage:
#	icalexpire [-calendar <input>] <output> [<expiration days>]
#
#	All items in the <input> calendar that have no occurrence after
#	(<today>-<expiration days>) are moved to the calendar stored in the
#	file named by <output>.
#
#	The default value for <expiration days> is 31.  The default value
#	for <input> is the user's normal calendar.  Threfore, if you just
#	specify an archival calendar, then all items that do not occur
#	in the past month and do not occur in the future will be moved to
#	the archival calendar.

# Tcl sees the next 5 lines as an assignment to variable `kludge'.
# For sh, the two shifts cancel the effect of the set, and then we
# run calshell on this script.
set kludge { ${1+"$@"}
shift
shift
exec calshell $0 ${1+"$@"}
}

# Tcl code starts here.

# Parse arguments
proc usage {} {
    puts stderr {Usage: icalexpire [-calendar <input>] <output> [<days>]}
    exit 1
}

set days 31

switch [llength $argv] {
    1 {set output [lindex $argv 0]}
    2 {set output [lindex $argv 0];set days [lindex $argv 1]}
    default {usage}
}

if ![regexp {[0-9]+} $days] {usage}
if {$days < 1} {usage}

# Set-up arrays for pretty-printing dates
set wday(1)	sun
set wday(2)	mon
set wday(3)	tue
set wday(4)	wed
set wday(5)	thu
set wday(6)	fri
set wday(7)	sat

set mon(1)	jan
set mon(2)	feb
set mon(3)	mar
set mon(4)	apr
set mon(5)	may
set mon(6)	jun
set mon(7)	jul
set mon(8)	aug
set mon(9)	sep
set mon(10)	oct
set mon(11)	nov
set mon(12)	dec

# Generate terse description of item
proc item2short_string {i} {
    global mon wday

    set type [$i type]
    if {$type == ""} {
	set d [$i first]
	set str [format {%-3s %-3s %2d, %4d}\
		 $wday([date weekday $d])\
		 $mon([date month $d])\
		 [date monthday $d]\
		 [date year $d]\
		 ]
    } else {
	set str $type
    }

    set txt [$i text]
    regsub \n $txt " " txt
    set txt [string range $txt 0 60]
    return [format "%-16s %s" $str $txt]
}

# Move expired items from input to output.  Use tmp as temporary calendar.
proc move_items {tmp input output days} {
    # Create a temporary calendar that includes both input and output so
    # we can move items.
    calendar cal $tmp
    cal include $input
    cal include $output
    cal save
    if [cal readonly $input] {error "$input: permission denied"}
    if [cal readonly $output] {error "$output: permission denied"}

    set threshold [expr [date today] - $days]

    # Copy expired items into output
    set removed {}
    cal incalendar $input item {
	if [catch {$item next $threshold}] {
	    # No occurrence after $threshold
	    set clone [$item clone]
	    cal add $clone $output
	    lappend removed $item
	    puts stdout "Expire: [item2short_string $item]"
	}
    }

    # Remove the expired items from input
    foreach item $removed {
	cal remove $item
    }

    # Now save the destination first to avoid losing data
    cal save $output

    # Save the source
    cal save $input
}

set tmp /tmp/ical[pid]
set result 0
if [catch {move_items $tmp $ical(calendar) $output $days} msg] {
    set result 1
    puts stderr "Error: $msg"
}
catch {exec /bin/rm $tmp}
