I've been working on taking Mohit's code for auto-accepting / rejection
calendar requests for use with resources and making it less specific.
Then idea is to have the script accept any requests that don't conflict
and reject any request that do. Right now, it grabs all the events from
the user's calendar and searches for any with the status of
NEEDS-ACTION. Then is determines yes or no and posts that. I've added
some documentation and removed the file queue and inotify part of the
original perl script.
I'm having one problem, which is probably very simple. If you have an
empty calendar, it works fine and changes the event status, etc. If you
have events in the calendar I believe it correctly identifies which to
accept and which to reject. However, when it tries to post the changes
it replaces every calendar entry with the first calendar entry. So if
you have Event1, Event2, Event3, you get Event1, Event1, Event1. The
ICS that is sent to SOGo is (should be?) the entire ICS calendar, not
just the changed event and I think that is part of the problem, although
from my reading of Mohit's original script that is how it was done.
I haven't looked into recurring events yet. Also, probably because of
the bug mentioned above, I was able to rail the SOGo CPU once when
testing this, so be careful.
Any ideas and code suggestions, feature requests, etc welcome.
Ben
On 3/4/2011 1:22 PM, Mohit Chawla wrote:
Hi,
On Fri, Mar 4, 2011 at 11:54 PM, Ben <[email protected]
<mailto:[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/
<http://search.cpan.org/%7Ealexmv/Data-ICal-0.16/> and
http://search.cpan.org/~simonw/Data-ICal-DateTime-0.7/
<http://search.cpan.org/%7Esimonw/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 Data::ICal::DateTime;
use Class::Inspector;
my $isconflict;
my $resource = $ARGV[0];
my $resource_cn = $ARGV[1];
my $d = HTTP::DAV->new();
my $tmp_dir = "/tmp/cal_$resource";
if ( $#ARGV != 1 ) {
print "This script must be run with 2 arguments\n";
print "./Accept-ben.pl uid cn\n";
exit
}
if (!-d $tmp_dir)
{
mkdir $tmp_dir;
}
sub auth
{
my $url = shift;
$d->credentials(
-user => "nothing",
-pass => "crypt",
-url => $url,
-realm => "SOGo"
);
$d->open(-url => $url);
}
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")
{
$loc = $i;
}
}
$ev->properties()->{'attendee'}->[$loc]->parameters()->{'PARTSTAT'} = $val;
}
sub is_infinite
{
my $ev = shift;
if (my $ev_r = $ev->recurrence)
{
if (!defined $ev_r->count)
{
return 1;
}
}
}
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);
}
}
##This is the main part. Grab the entire ICS calendar. And save it to the disk
my $url = "http://localhost/SOGo/dav/$resource/Calendar/personal";;
auth($url);
$d->get(-url => "$url.ics", to => "$tmp_dir/ev.ics");
#Load the ICS file just saved into $ev_cal as an ICal structure
my $ev_cal = Data::ICal->new(filename => "$tmp_dir/ev.ics");
##Questions:
##What is cancel_val for? When I delete an event
##it goes away from the calendar... when does this come up?
my @evs = $ev_cal->events();
my @evcopy=@evs;
foreach my $e (@evs) {
print "Event " . $e->uid . " has status of " . pstat($e) . "\n";
$isconflict=0;
if (pstat($e) eq 'NEEDS-ACTION')
{
#print "event " . $i->uid . " needs action\n";
#Check if the event is infinite, if so reject.
##I want to allow infinite events, so I'll comment this part out.
#if (is_infinite($e))
#{
# print " Infinite Event, will reject \n";
# set_pstat($e, 'DECLINED');
#}
##Is there a conflict? Go through every Event that has been accepted
and
##see if it conflicts with the new event.
my $dump=0;
foreach my $a (@evcopy) {
##When checking for conflicts, reject conflicts between
NEEDS-ACTIONS events
##as well as accepted events.
if ( ( pstat($a) eq 'ACCEPTED' or pstat($a) eq 'NEEDS-ACTION' ) and
( $e->uid ne $a->uid ) ) {
$isconflict=events_conflict($a,$e);
if ($isconflict ) {
print "Event Conflict Found\n";
last;
}
}
}
if ($isconflict) {
set_pstat($e, 'REJECTED');
} else {
set_pstat($e, 'ACCEPTED');
}
my $euid = $e->uid;
#print "UID is: $euid\n";
if (-f "$tmp_dir/ev.ics")
{
unlink "$tmp_dir/ev.ics";
}
open(my $afh, '>', "$tmp_dir/ev.ics");
print $afh $ev_cal->as_string;
close($afh);
$d->put(-local => "$tmp_dir/ev-single.ics", -url => "$url/$euid.ics");
}
}
