Hi,
On Fri, Mar 4, 2011 at 11:54 PM, Ben <[email protected]>wrote:
> I was wondering how your perl interface for resource management was working
> and if you'd be willing to share the code? I'd be interested in testing /
> debuging / using it.
>
Here's how it works.
For the particular organization for which the solution was devised - the
criteria for resource booking is pretty simple - first come, first serve.
So, keeping that in mind, the process involves calculating the appropriate
recurrence ( in case of recurring events ), breaking 'em down and comparing
for conflicts. Otherwise, a straightforward affair. If there's a conflict,
that particular user's event will be rejected. Infinite events are rejected
as well.
There are some great modules that perl provides which we use -
http://search.cpan.org/~alexmv/Data-ICal-0.16/ and
http://search.cpan.org/~simonw/Data-ICal-DateTime-0.7/
Currently, the code is integrated with the email sub-system ( based on qmail
). Also, the code can be made a lot efficient if I could use object-oriented
paradigms. But anyway I am attaching the particular script.
You would probably want to avoid the email parts.
So, mainly there are two queues - the first reads off the iCal objects and
the other one puts a paticular mail in a separate queue ( $m_dirq ) ..
.which you would avoid, unless in a similar situation.
Let me know of any problems - the script is quite specific - and hasn't been
generalized, so there might be a few things to watch out for.
#!/usr/bin/perl
use strict;
use warnings;
use POSIX;
use HTTP::DAV;
use File::Copy;
use File::Path;
use MIME::Lite::TT;
use Linux::Inotify2;
use Directory::Queue;
use Data::ICal::DateTime;
my $resource = $ARGV[0];
my $resource_cn = $ARGV[1];
my $tmp_dir = "/tmp/cal_$resource";
my $queue_dir = "/tmp/queue_$resource";
my $m_queue_dir = "/tmp/m_queue_$resource";
my $m_schema = {"body" => "table"};
my $mq_name;
my $schema = {"body" => "string"};
my $alias = "/home/caladmin";
my $d;
my ($ne_path, $nc_path);
my $cal;
my $nc_cal;
my $nc_events;
my $e;
my $oldmod;
my $conflicts;
my $dirq;
my $name;
my %data;
my $ce;
$| = 1;
sub catch_sig {
my $signame = shift;
die " Caught TERM \n\n\n";
}
$SIG{TERM} = \&catch_sig;
sub auth
{
my $url = shift;
$d->credentials(
-user => "cal.admin",
-pass => "cal246",
-url => $url,
-realm => "SOGo"
);
$d->open(-url => $url);
}
sub end
{
shift->properties()->{dtend}->[0]->decoded_value();
}
sub cancel_val
{
shift->properties()->{method}->[0]->decoded_value();
}
sub sequence
{
shift->properties()->{sequence}->[0]->decoded_value();
}
sub organizer
{
shift->properties()->{organizer}->[0]->parameters->{CN};
}
sub lastmod
{
shift->properties()->{'last-modified'}->[0]->decoded_value();
}
sub dstart
{
shift->properties()->{dtstart}->[0]->decoded_value();
}
sub dend
{
shift->properties()->{dtend}->[0]->decoded_value();
}
sub pstat
{
my $ev = shift;
my $att = scalar @{$ev->properties()->{attendee}} - 1;
my $cn;
my $loc;
foreach my $i (0 .. $att)
{
$cn = $ev->properties()->{attendee}->[$i]->parameters->{CN};
if ($cn eq "$resource_cn")
{
$loc = $i;
}
}
return $ev->properties()->{'attendee'}->[$loc]->parameters()->{'PARTSTAT'};
}
sub set_pstat
{
my ($ev, $val) = @_;
my $att = scalar @{$ev->properties()->{attendee}} - 1;
my $cn;
my $loc;
foreach my $i (0 .. $att)
{
$cn = $ev->properties()->{attendee}->[$i]->parameters->{CN};
if ($cn eq "$resource_cn")
{
$loc = $i;
}
}
$ev->properties()->{'attendee'}->[$loc]->parameters()->{'PARTSTAT'} = $val;
}
sub rec
{
my $ev = shift;
my $ev_span = $ev->recurrence;
my $iter = $ev_span->iterator;
my $ev_cal = Data::ICal->new(filename => $nc_path);
my @ev_events = $ev_cal->events();
foreach my $i (@ev_events)
{
if ($i->uid eq $ev->uid and !$i->recurrence)
{
while (my $dt = $iter->next)
{
if ($dt->ymd eq $i->start->ymd)
{
$ev_span = $ev_span->complement($dt);
}
}
}
}
return $ev_span;
}
sub events_conflict
{
my ($e1, $e2) = @_;
my $e1_span;
my $e2_span;
if (!$e1->recurrence and !$e2->recurrence)
{
$e1_span =
DateTime::Span->from_datetimes(start => $e1->start, end => $e1->end);
$e2_span =
DateTime::Span->from_datetimes(start => $e2->start, end => $e2->end);
return 1
if ( $e1_span->intersects($e2_span)
and $e1->end ne $e2->start
and $e1->start ne $e2->end);
} elsif ($e1->recurrence)
{
my $recur = rec($e1);
my @evts = $e1->explode($recur);
foreach my $e (@evts)
{
return 1 if events_conflict($e2, $e);
}
} elsif ($e2->recurrence)
{
return events_conflict($e2, $e1);
}
}
sub r_end
{
my $ev = shift;
my $recur = $ev->recurrence;
my @evts = $ev->explode($recur);
my $last_recur_e = pop(@evts);
my $d_cal = Data::ICal->new(filename => $nc_path);
my @d_events = $d_cal->events();
my $check = 0;
my $last_rrule_date = $ev->recurrence->max;
my $exdate_span;
my $ev_end;
my $iter_exdate;
if ($ev->exdate)
{
$exdate_span = $ev->exdate;
$iter_exdate = $exdate_span->iterator;
while (my $dt_exdate = $iter_exdate->next)
{
if ($dt_exdate eq $last_rrule_date)
{
$check = 1;
}
}
} else
{
foreach my $i (@d_events)
{
if ( $i->uid eq $ev->uid
and $i->recurrence_id
and $i->recurrence_id eq $last_rrule_date)
{
$ev_end = end($i);
} elsif ( $i->uid eq $ev->uid
and $i->recurrence)
{
$ev_end = end($last_recur_e);
}
}
}
if ($check)
{
foreach my $i (@d_events)
{
if ( $i->uid eq $ev->uid
and $i->recurrence_id
and $i->recurrence_id eq $last_recur_e->start)
{
$ev_end = end($i);
}
}
}
return $ev_end;
}
sub nc_cal_check
{
my $ev = shift;
my $ev_end;
if (!$ev->recurrence and !$ev->recurrence_id)
{
$ev_end = end($ev);
} elsif ($ev->recurrence and !$ev->recurrence_id)
{
$ev_end = r_end($ev);
} elsif ($ev->recurrence_id)
{
my $rcal = Data::ICal->new(filename => $nc_path);
my @revents = $rcal->events();
foreach my $i (@revents)
{
if ( $i->uid eq $ev->uid
and $i->recurrence)
{
$ev_end = r_end($i);
}
}
}
if ($ev_end lt strftime("%Y%m%dT%H%M%SZ", gmtime(time)))
{
return 1;
}
}
sub maildir_name
{
my $ev = shift;
if ($ev->recurrence_id)
{
return $ev->uid . "--" . $ev->recurrence_id . "--" . sequence($ev);
} else
{
if ($ev->properties()->{sequence})
{
return $ev->uid . "--" . sequence($ev);
} else
{
return $ev->uid;
}
}
}
my $m_dirq = Directory::Queue->new(path => $m_queue_dir, schema => $m_schema);
sub maildir_flush
{
my ($maildir, $num_of_att) = @_;
my $m_ref = {
"$maildir" => "$num_of_att",
"operation" => "send"
};
$mq_name = $m_dirq->add(body => $m_ref);
}
sub maildir_delete
{
my ($maildir, $num_of_att) = @_;
my $m_ref = {
"$maildir" => "$num_of_att",
"operation" => "delete"
};
$mq_name = $m_dirq->add(body => $m_ref);
}
sub num_of_attendees
{
my $ev = shift;
my $num = scalar @{$ev->properties()->{attendee}};
my $att_count = scalar @{$ev->properties()->{attendee}} - 1;
foreach my $i (0 .. $att_count)
{
if ($ev->properties()->{attendee}->[$i]->parameters()->{PARTSTAT} eq
'DECLINED')
{
$num -= 1;
}
}
return $num;
}
sub new_accept_event
{
my $ev = shift;
my $euid = $ev->uid;
my $ev_cal;
my $num_of_att = num_of_attendees($ev);
my $mdir = maildir_name($ev);
my $url = "http://calendar.foo.com/SOGo/dav/$resource/Calendar/personal";;
if (-f "$tmp_dir/ev.ics")
{
unlink "$tmp_dir/ev.ics";
}
maildir_flush("$alias/$mdir/", $num_of_att);
auth($url);
$d->get(-url => "$url/$euid.ics", to => "$tmp_dir/ev.ics");
$ev_cal = Data::ICal->new(filename => "$tmp_dir/ev.ics");
my @evs = $ev_cal->events();
foreach my $i (@evs)
{
if (pstat($i) eq 'NEEDS-ACTION')
{
set_pstat($i, 'ACCEPTED');
}
}
open(my $afh, '>', "$tmp_dir/ev.ics");
print $afh $ev_cal->as_string;
close($afh);
$d->put(-local => "$tmp_dir/ev.ics", -url => "$url/$euid.ics");
}
sub new_reject_event
{
my $ev = shift;
my $euid = $ev->uid;
my $ev_cal;
my $organizer = $ev->properties()->{organizer}->[0]->parameters->{CN};
my $url = "http://calendar.foo.com/SOGo/dav/$organizer/Calendar/personal/";;
my $multiple = 0;
if (-f "$tmp_dir/ev.ics")
{
unlink "$tmp_dir/ev.ics";
}
auth($url);
$d->get(-url => "$url/$euid.ics", to => "$tmp_dir/ev.ics");
$ev_cal = Data::ICal->new(filename => "$tmp_dir/ev.ics");
my $evs = [];
@$evs = $ev_cal->events();
if (scalar @{$ev_cal->entries} > 1)
{
$multiple = 1;
foreach my $i (0 .. $#$evs)
{
my $ae = $evs->[$i];
if (pstat($ae) eq 'NEEDS-ACTION')
{
splice(@{$ev_cal->entries}, $i, 1);
}
}
}
open(my $afh, '>', "$tmp_dir/ev.ics");
print $afh $ev_cal->as_string;
close($afh);
if ($multiple)
{
$d->put(-local => "$tmp_dir/ev.ics",
-url => "$url/$euid.ics");
} else
{
$d->delete(-url => "$url/$euid.ics");
}
my $mdir_invitations = maildir_name($ev);
my $num_of_att = num_of_attendees($ev);
maildir_delete("$alias/$mdir_invitations/", $num_of_att);
}
sub date_time
{
my ($ev, $t) = @_;
my ($yr, $mt, $d, $hr, $min, $s) =
$t =~ m/(\d{4})(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)Z/;
my $dt = DateTime->new(
year => $yr,
month => $mt,
day => $d,
hour => $hr,
minute => $min,
second => $s
);
$dt->add(hours => 5,
minutes => 30);
return $dt;
}
sub reject_mail
{
my ($c_e, $n_c_e) = @_;
my $org = organizer($c_e);
my %params;
my %options;
$params{resource} = $resource_cn;
$params{c_organizer} = $org;
$params{summary} = $n_c_e->summary;
$params{nc_organizer} = organizer($n_c_e);
$params{last_modified_time} = date_time($n_c_e, lastmod($n_c_e))->hms;
$params{last_modified_date} = date_time($n_c_e, lastmod($n_c_e))->dmy;
$params{start_time} = date_time($n_c_e, dstart($n_c_e))->hms;
$params{end_time} = date_time($n_c_e, dend($n_c_e))->hms;
$params{start_date} = date_time($n_c_e, dstart($n_c_e))->dmy;
$params{end_date} = date_time($n_c_e, dend($n_c_e))->dmy;
$options{INCLUDE_PATH} = '/home/caladmin/templates';
my $msg = MIME::Lite::TT->new(
From => '[email protected]',
To => "$org\@foo.com",
Subject => "Resource booking rejected",
Template => 'ev.txt.tt',
TmplOptions => \%options,
TmplParams => \%params
);
$msg->send;
}
sub cutjob
{
my $cut_e = shift;
my $euid = $cut_e->uid;
my $to_be_cut = undef;
my $cut_flag = 0;
my $uid_flag = 0;
my $caladmin_index = undef;
my @array_cut = ();
my $cut_cal = Data::ICal->new(filename => $nc_path);
my $cut_cal_events = [];
@$cut_cal_events = $cut_cal->events();
my $url = "http://calendar.foo.com/SOGo/dav/$resource/Calendar/personal";;
foreach my $i (0 .. $#$cut_cal_events)
{
my $cce = $cut_cal_events->[$i];
if ($cut_e->uid eq $cce->uid)
{
$uid_flag = 1;
if (!$cut_e->recurrence_id and !$cut_e->recurrence)
{
$to_be_cut = $i;
} elsif ( $cut_e->recurrence_id
and $cce->recurrence_id
and $cut_e->recurrence_id eq $cce->recurrence_id)
{
$to_be_cut = $i;
$cut_flag = 1;
} elsif ($cut_e->recurrence)
{
unshift(@array_cut, $i);
} elsif ($cut_e->recurrence_id and $cce->recurrence)
{
$caladmin_index = $i;
}
}
}
if (defined $to_be_cut)
{
if (!$cut_flag)
{
splice(@{$cut_cal->entries}, $to_be_cut, 1);
save_cal($cut_cal);
} elsif ($cut_flag)
{
if ($to_be_cut lt $caladmin_index)
{
splice(@{$cut_cal->entries}, $caladmin_index, 1);
splice(@{$cut_cal->entries}, $to_be_cut, 1);
} else
{
splice(@{$cut_cal->entries}, $to_be_cut, 1);
splice(@{$cut_cal->entries}, $caladmin_index, 1);
}
if (-f "$tmp_dir/splice.ics")
{
unlink "$tmp_dir/splice.ics";
}
auth($url);
$d->get(-url => "$url/$euid.ics",
-to => "$tmp_dir/splice.ics");
my $scal = Data::ICal->new(filename => "$tmp_dir/splice.ics");
my @sevents = $scal->events();
my $se = $sevents[0];
$cut_cal->add_entry($se);
save_cal($cut_cal);
}
} elsif (defined $caladmin_index and !$cut_flag)
{
print "called procesing for caladmin index";
splice(@{$cut_cal->entries}, $caladmin_index, 1);
if (-f "$tmp_dir/splice.ics")
{
unlink "$tmp_dir/splice.ics";
}
auth($url);
$d->get(-url => "$url/$euid.ics", -to => "$tmp_dir/splice.ics");
my $scal = Data::ICal->new(filename => "$tmp_dir/splice.ics");
my @sevents = $scal->events();
my $se = $sevents[0];
$cut_cal->add_entry($se);
save_cal($cut_cal);
} elsif ($cut_e->recurrence)
{
foreach my $i (@array_cut)
{
splice(@{$cut_cal->entries}, $i, 1);
}
save_cal($cut_cal);
}
my $mdir = maildir_name($cut_e) . "--cancel";
my $num_of_att = num_of_attendees($cut_e);
if ($uid_flag)
{
maildir_flush("$alias/$mdir/", $num_of_att);
} else
{
maildir_delete("$alias/$mdir/", $num_of_att);
}
}
sub is_infinite
{
my $ev = shift;
if (my $ev_r = $ev->recurrence)
{
if (!defined $ev_r->count)
{
return 1;
}
}
}
sub reject_mail_infinite
{
my $ev = shift;
my $org = organizer($ev);
my %params;
my %options;
$params{resource} = $resource_cn;
$params{organizer} = $org;
$params{summary} = $ev->summary;
$options{INCLUDE_PATH} = '/home/caladmin/templates';
my $msg = MIME::Lite::TT->new(
From => '[email protected]',
To => "$org\@foo.com",
Subject => " Resource booking rejected ",
Template => 'ev.infinite.txt.tt',
TmplOptions => \%options,
TmplParams => \%params
);
$msg->send;
}
sub save_cal
{
my $nc_cal = shift;
open(my $fh, ">", $nc_path);
print $fh $nc_cal->as_string;
close($fh);
}
$nc_path = "$alias/nc_cal_$resource.ics";
$d = HTTP::DAV->new();
if (!-d $tmp_dir)
{
mkdir $tmp_dir;
}
if (!-d $queue_dir)
{
mkdir $queue_dir;
}
$dirq = Directory::Queue->new(path => $queue_dir, schema => $schema);
my $inotify = Linux::Inotify2->new();
$inotify->watch("$queue_dir/temporary", IN_MOVED_FROM, \&queue_process);
1 while $inotify->poll;
sub queue_process
{
for ($name = $dirq->first() ; $name ; $name = $dirq->next())
{
next unless $dirq->lock($name);
%data = $dirq->get($name);
$ne_path = "$data{body}";
my $cancel_flag = 0;
$cal = Data::ICal->new(filename => $ne_path);
my @events = $cal->events();
$e = $events[0];
print " Processing " . $e->uid . "\n";
if (cancel_val($cal) eq 'CANCEL')
{
print " Calendar method is CANCEL, event will be removed \n";
cutjob($e);
$dirq->remove($name);
print " Processing complete for " . $e->uid . "\n\n\n";
next;
}
if (is_infinite($e))
{
print " Infinite Event, will reject \n";
new_reject_event($e);
reject_mail_infinite($e);
$dirq->remove($name);
print " Processing complete for " . $e->uid . "\n\n\n";
next;
}
if (!-f $nc_path)
{
copy($ne_path, $nc_path);
print
"First event in the queue, will be accepted and nc_cal.ics initialized \n";
new_accept_event($e);
$dirq->remove($name);
print " Processing complete for " . $e->uid . "\n\n\n";
next;
}
$nc_cal = Data::ICal->new(filename => $nc_path);
$nc_events = [];
@$nc_events = $nc_cal->events();
$oldmod = undef;
$conflicts = 0;
print " Total non-conflicting events: " . (scalar @$nc_events) . "\n";
foreach my $i (0 .. $#$nc_events)
{
my $nce = $nc_events->[$i];
if (nc_cal_check($nce))
{
if ($nce->recurrence_id or $nce->recurrence)
{
my $nce_uid = $nce->uid;
foreach my $j (0 .. $#$nc_events)
{
my $ncve = $nc_events->[$j];
if ($ncve->uid eq $nce_uid)
{
splice(@{$nc_cal->entries}, $j, 1);
}
}
} else
{
splice(@{$nc_cal->entries}, $i, 1);
}
next;
}
if ($nce->uid eq $e->uid)
{
if ( $e->recurrence_id
and $nce->recurrence_id
and $e->recurrence_id eq $nce->recurrence_id)
{
print " Modified occurence, will remove if conflicts \n";
$oldmod = $i;
} elsif ( $e->recurrence_id
and $nce->recurrence_id
and $e->recurrence_id ne $nce->recurrence_id)
{
print " New occurence, both events have a recurrence-id \n";
} elsif ($e->recurrence_id and !$nce->recurrence_id)
{
print
" New occurence, incoming event has a recurrence-id \n";
} elsif (!$e->recurrence_id and !$nce->recurrence_id)
{
if ($e->recurrence)
{
print
" Modified recurring incoming event with recurrence, nce doesn't have rec-id \n";
$oldmod = $i;
} else
{
print " Modified non recurring incoming event \n";
$oldmod = $i;
}
} elsif (!$e->recurrence_id and $nce->recurrence_id)
{
print
" Modified recurring incoming event, nce has rec-id \n";
}
} elsif (!$conflicts
and events_conflict($e, $nce))
{
print " Event conflicts\n ";
$conflicts = 1;
$ce = $nce;
}
}
if (defined $oldmod)
{
print " Removing modified event from nc_cal \n";
splice(@{$nc_cal->entries}, $oldmod, 1);
}
if ($conflicts)
{
print " Will reject \n";
new_reject_event($e);
reject_mail($e, $ce);
} else
{
print " Will accept \n";
new_accept_event($e);
$nc_cal->add_entry($e);
}
SAVECAL:
print " Will now save nc_cal \n";
save_cal($nc_cal);
$dirq->remove($name);
print " Processing complete for " . $e->uid . "\n\n\n";
}
}
