#!/usr/bin/perl
#
# stow.pl, November, 1999, Eric Busboom 
#
# This program will take a single ical component and store it in a calendar. 
# It expects to be called from metamail. You should have a .mailcap entry like:
#
#    text/calendar; /usr/local/bin/stow.pl  %s %t %{method}
#
# Then, pass the data to metamail with:
#
#    cat mail | metamail -m <relcalid>
#
# The '-m' option specifies the mailer that is calling metamail, but
# this program uses it to pass in the address where the mail was
# sent. Stow will put the incoming component in a calendar named
# <relcalid>


use lib "/home/studio2/local/proj/Net-ICal-0.07/blib/lib";
use lib "/home/studio2/local/proj/Net-ICal-0.07/blib/arch"; 

use lib "../../blib/lib";
use lib "../../blib/arch"; 

use Net::ICal;
use Net::ICal::Calendar;
use Net::ICal::Cluster;
use Getopt::Std;
use POSIX;

$calid = "alice\@cal.softwarestudio.org";

$metamail = '/usr/bin/metamail';
$metasend = '/usr/bin/metasend ';

sub return_error{
  my $to = shift;
  my $from = shift;
  my $orig = shift;
  my $text = shift;
  my $message = shift;
  my $comp = shift;

  $text =~ s/\r\n/\n/g;
  $orig =~ s/\r\n/\n/g;

  $to = $from;
  my $subject = "iMIP message error";
  
  my $bodyfile = POSIX::tmpnam();
  my $calfile = POSIX::tmprnam();

  my $data = "In your iMIP message to $to, the following error occured:\n\n$message\n";

  if ($text ne undef){ 
    $data .= "Here is the text of the component as the parser understood it:\n\n$text\n\n";
  }

  $data .= "Here is the original text of the component:\n\n$orig\n\n";

  $comp->convert_errors;

  open BF,">$bodyfile" or die;
  print BF $data;
  close BF;

  open CF,">$calfile" or die;
  print CF $comp->as_ical_string;
  close CF;

  system("$metasend -b -s \"$subject\" -t $to -m \"text/plain\" -D \"Text\" -f $bodyfile -n -m \"text/calendar; method=REPLY\" -D \"iCalendar reply\" -f $calfile");
#  print("$metasend -b -s \"$subject\" -t $to -m \"text/plain\" -D \"Text\" -f $bodyfile -n -m \"text/calendar; method=REPLY\" -D \"iCalendar reply\" -f $calfile\n");

 unlink $bodyfile;
 unlink $calfile;

}

sub get_first_real_component {
  my $outer = shift;
  my $inner;

  foreach $i ('VEVENT','VTODO','VJOURNAL'){
    $inner = ($outer->components($i))[0];

    if ($inner){
      return $inner;
    }
  }

  return undef;
}
sub store_incoming{


  my ($file, $type, $method) = @ARGV;
  my $comp;
  my $count = 0;
  my $to = $calid;
  my $summary = $ENV{'MM_SUMMARY'};


  $summary =~ /\(from (.*) \)/;

  my $from = $1;

  open FH, $file or die "Can't open input file \"$file\"";
  undef $/;
  my $text = <FH>;
  $/ = "\n";
  close FH;

#  unlink($file);

  die "No recipient" if !$to;
  
  if (!-d $ENV{'HOME'}."/.facal"){
    mkdir($ENV{'HOME'}."/.facal",0775) or die;
  }

  if ($to){
    $caldir = $ENV{'HOME'}."/.facal/$to";
  } else {
    $caldir = $ENV{'HOME'}."/.facal/default";
  }

  if (!-d $caldir){
    mkdir ($caldir,0775) or die "Can't mkdir for '$caldir/";
  }

  my $calendar = new Net::ICal::Calendar($caldir);
  
  #Net::ICal::icalcomponent_as_ical_string($calendar);
  
  die "No calendar" if !$calendar;
  
  my $incoming = $calendar->get_incoming();
  
  die "Can't get \'incoming\' cluster for calendar \'$to\'" if !$incoming;

  
  if ($type ne "text/calendar"){
    return 0 ;
  }
  
  $comp = new Net::ICal::Component(\$text);
  
  
  if (!$comp){
    return_error($to,$from,$text,undef,
		 "Found a text/component MIME part, but could not\n extract an iCal component from it\n");
    exit;
  }
  
  $comp->check_restrictions();

  if($comp->count_errors()>0){
    
    return_error($to,$from,$text,$comp->as_ical_string,
		 "Found a text/component MIME part, but it had one or more fatal \nparsing errors. (Currently all parsing errors are fatal.)\n\n",
		 $comp);
    exit;
  }
  
  
  if ($comp->type() ne "VCALENDAR"){
    return_error($to,$from,$text,$comp->as_ical_string,
		 "The root component is not a VCALENDAR",
		 $comp);
    exit;
  }
  
  my $inner = get_first_real_component($comp);
  my @attendeerefs = $inner->properties('ATTENDEE');
  my $attendee = undef;
  foreach $i (@attendeerefs){
    my $a = $i->get_value();
    
    if (lc($a) eq lc("mailto:$calid")){
      $attendee = $a;
    }
  }
  
  if (!$attendee){
    return_error($to,$from,$text,$comp->as_ical_string,
		 "The event did not list this calendar user, $calid , as an attendee. ",
		 $comp);
    exit;
  }    

  # Add some special properties
  
  $comp->add(new Net::ICal::Property::X("X-LIC-SENDER",$from));
  
  
  # Check that the version and method properties are correct 
  
  my ($version_prop) = $comp->properties("VERSION");
  
  if (!$version_prop){
    return_error($to,$from,undef,$comp->as_ical_string,
		 "No version property",$comp);
    exit;
  }
  
  my $version = $version_prop->get_value();
  
  if ($version < 2){
    return_error($to,$from,undef,$comp->as_ical_string,
		 "This version only handles iCal version 2.0",
		 $comp);
    exit;
  }
  
  my ($method_prop) = $comp->properties("METHOD");
  
  if (!$method_prop){
    return_error($to,$from,undef,$comp->as_ical_string,
		 "No method property",
		 $comp);
    exit; 
  }
  
  
  $incoming->add($comp);
  $incoming->commit();

}




######################################################################
# Main routine
######################################################################

store_incoming();
exit(0);