406 lines
12 KiB
Perl
Executable file
406 lines
12 KiB
Perl
Executable file
package WebGUI::Workflow::Activity::CalendarUpdateFeeds;
|
|
|
|
|
|
=head1 LEGAL
|
|
|
|
-------------------------------------------------------------------
|
|
WebGUI is Copyright 2001-2006 Plain Black Corporation.
|
|
-------------------------------------------------------------------
|
|
Please read the legal notices (docs/legal.txt) and the license
|
|
(docs/license.txt) that came with this distribution before using
|
|
this software.
|
|
-------------------------------------------------------------------
|
|
http://www.plainblack.com info@plainblack.com
|
|
-------------------------------------------------------------------
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use warnings;
|
|
use base 'WebGUI::Workflow::Activity';
|
|
|
|
use WebGUI::Asset::Wobject::Calendar;
|
|
use WebGUI::Asset::Event;
|
|
use WebGUI::DateTime;
|
|
|
|
use LWP::UserAgent;
|
|
|
|
|
|
=head1 NAME
|
|
|
|
Package WebGUI::Workflow::Activity::CalendarUpdateFeeds;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Imports calendar events from Calendar feeds.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
See WebGUI::Workflow::Activity for details on how to use any activity.
|
|
|
|
=head1 METHODS
|
|
|
|
These methods are available from this class:
|
|
|
|
=cut
|
|
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 definition ( session, definition )
|
|
|
|
See WebGUI::Workflow::Activity::defintion() for details.
|
|
|
|
=cut
|
|
|
|
sub definition {
|
|
my $class = shift;
|
|
my $session = shift;
|
|
my $definition = shift;
|
|
my $i18n = WebGUI::International->new($session, "Asset_Calendar");
|
|
push(@{$definition}, {
|
|
name => $i18n->get("workflow updateFeeds"),
|
|
properties => { }
|
|
});
|
|
return $class->SUPER::definition($session,$definition);
|
|
}
|
|
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 execute ( )
|
|
|
|
See WebGUI::Workflow::Activity::execute() for details.
|
|
|
|
=cut
|
|
|
|
sub execute {
|
|
my $self = shift;
|
|
my $session = $self->session;
|
|
$self->session->user({userId => 3});
|
|
|
|
### TODO: If we take more than a minute, return WAITING so that some
|
|
# other activity can run
|
|
|
|
my $ua = LWP::UserAgent->new(agent => "WebGUI");
|
|
my $dt = WebGUI::DateTime->new($session, time)->toMysql;
|
|
|
|
my $sth = $self->session->db->prepare("select * from Calendar_feeds");
|
|
$sth->execute();
|
|
|
|
#use Data::Dumper;
|
|
|
|
FEED:while (my $feed = $sth->hashRef) {
|
|
|
|
#!!! KLUDGE - If the feed is on the same server, set a scratch value
|
|
# I do not know how dangerous this is, so THIS MUST CHANGE!
|
|
# Preferably: Spectre would add a userSession to the database,
|
|
# and send the appropriate cookie with the request.
|
|
my $sitename = $self->session->config->get("sitename")->[0];
|
|
if ($feed->{url} =~ m{http://[^/]*$sitename})
|
|
{
|
|
$feed->{url} .= ( $feed->{url} =~ /[?]/ ? ";" : "?" ) . "adminId=".$session->getId;
|
|
$self->session->db->write("REPLACE INTO userSessionScratch (sessionId,name,value) VALUES (?,?,?)",
|
|
[$session->getId,$feed->{assetId},"SPECTRE"]);
|
|
}
|
|
#/KLUDGE
|
|
#warn "FEED URL: ".$feed->{url} ."\n";
|
|
|
|
|
|
|
|
## Somebody point me to a DECENT iCalendar parser...
|
|
# Text::vFile perhaps?
|
|
|
|
# Get the feed
|
|
my $response = $ua->get($feed->{url});
|
|
|
|
if ($response->is_success)
|
|
{
|
|
my $data = $response->content;
|
|
|
|
# If doesn't start with BEGIN:VCALENDAR then error
|
|
unless ($data =~ /^BEGIN:VCALENDAR/i)
|
|
{
|
|
# Update the result and last updated fields
|
|
$self->session->db->write(
|
|
"update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?",
|
|
["Not an iCalendar feed",$dt,$feed->{feedId}]);
|
|
next FEED;
|
|
}
|
|
|
|
|
|
my $active = 0; # Parser on/off
|
|
my %current_event = ();
|
|
my $current_entry = "";
|
|
my %events;
|
|
my $line_number = 0;
|
|
for my $line (split /[\r\n]+/,$data)
|
|
{
|
|
chomp $line;
|
|
$line_number++;
|
|
next unless $line =~ /\w/;
|
|
|
|
#warn "LINE $line_number: $line\n";
|
|
|
|
if ($line =~ /^BEGIN:VEVENT$/i)
|
|
{
|
|
$active = 1;
|
|
}
|
|
elsif ($line =~ /^END:VEVENT$/i)
|
|
{
|
|
$active = 0;
|
|
# Flush event
|
|
my $uid = lc $current_event{uid}[1];
|
|
delete $current_event{uid};
|
|
$events{$uid} = {%current_event};
|
|
%current_event = ();
|
|
}
|
|
elsif ($line =~ /^ /)
|
|
{
|
|
# Add to entry data
|
|
$current_entry .= substr $line, 1;
|
|
}
|
|
else
|
|
{
|
|
# Flush old entry
|
|
# KEY;ATTRIBUTE=VALUE;ATTRIBUTE=VALUE:KEYVALUE
|
|
my ($key_attrs,$value) = split /:/,$current_entry,2;
|
|
|
|
my @attrs = split /;/, $key_attrs;
|
|
my $key = shift @attrs;
|
|
my %attrs;
|
|
while (my $attribute = shift @attrs)
|
|
{
|
|
my ($attr_key, $attr_value) = split /=/, $attribute, 2;
|
|
$attrs{lc $attr_key} = $attr_value;
|
|
}
|
|
|
|
# Unescape value
|
|
|
|
|
|
$current_event{lc $key} = [\%attrs,$value];
|
|
|
|
# Start new entry
|
|
$current_entry = $line;
|
|
}
|
|
}
|
|
|
|
my $added = 0;
|
|
my $updated = 0;
|
|
my $errored = 0;
|
|
EVENT: for my $id (keys %events)
|
|
{
|
|
#use Data::Dumper;
|
|
#warn "EVENT: $id; ".Dumper $events{$id};
|
|
|
|
# Prepare event data
|
|
my $properties = {
|
|
feedUid => $id,
|
|
feedId => $feed->{feedId},
|
|
description => $events{$id}->{description}->[1],
|
|
title => $events{$id}->{summary}->[1],
|
|
menuTitle => substr($events{$id}->{summary}->[1],0,15),
|
|
className => 'WebGUI::Asset::Event',
|
|
isHidden => 1,
|
|
};
|
|
|
|
# Prepare the date
|
|
my $dtstart = $events{$id}->{dtstart}->[1];
|
|
if ($dtstart =~ /T/)
|
|
{
|
|
my ($date, $time) = split /T/, $dtstart;
|
|
|
|
my ($year, $month, $day) = $date =~ /(\d{4})(\d{2})(\d{2})/;
|
|
my ($hour, $minute, $second) = $time =~ /(\d{2})(\d{2})(\d{2})/;
|
|
|
|
($properties->{startDate}, $properties->{startTime}) =
|
|
split / /, WebGUI::DateTime->new(
|
|
year => $year,
|
|
month => $month,
|
|
day => $day,
|
|
hour => $hour,
|
|
minute => $minute,
|
|
second => $second,
|
|
time_zone => "UTC",
|
|
)->toMysql;
|
|
}
|
|
elsif ($dtstart =~ /(\d{4})(\d{2})(\d{2})/)
|
|
{
|
|
my ($year, $month, $day) = $dtstart =~ /(\d{4})(\d{2})(\d{2})/;
|
|
$properties->{startDate} = join "-",$year,$month,$day;
|
|
}
|
|
elsif ($dtstart) {
|
|
$session->errorHandler->warn(
|
|
"Workflow::Activity::CalendarUpdateFeeds"
|
|
. " -- '$dtstart' does not appear to be a valid date"
|
|
);
|
|
$errored++;
|
|
next EVENT;
|
|
}
|
|
|
|
my $dtend = $events{$id}->{dtend}->[1];
|
|
my $duration = $events{$id}->{duration}->[1];
|
|
if ($dtend =~ /T/)
|
|
{
|
|
my ($date, $time) = split /T/, $dtend;
|
|
|
|
my ($year, $month, $day) = $date =~ /(\d{4})(\d{2})(\d{2})/;
|
|
my ($hour, $minute, $second) = $time =~ /(\d{2})(\d{2})(\d{2})/;
|
|
|
|
($properties->{endDate}, $properties->{endTime}) =
|
|
split / /, WebGUI::DateTime->new(
|
|
year => $year,
|
|
month => $month,
|
|
day => $day,
|
|
hour => $hour,
|
|
minute => $minute,
|
|
second => $second,
|
|
time_zone => "UTC",
|
|
)->toMysql;
|
|
}
|
|
elsif ($dtend =~ /(\d{4})(\d{2})(\d{2})/)
|
|
{
|
|
my ($year, $month, $day) = $dtend =~ /(\d{4})(\d{2})(\d{2})/;
|
|
|
|
$properties->{endDate} = join "-",$year,$month,$day;
|
|
}
|
|
# If we can't parse it, forget the whole event
|
|
elsif ($dtend) {
|
|
$session->errorHandler->warn(
|
|
"Workflow::Activity::CalendarUpdateFeeds"
|
|
. " -- '$dtend' does not appear to be a valid date"
|
|
);
|
|
$errored++;
|
|
next EVENT;
|
|
}
|
|
# No dtend, but we have duration!
|
|
elsif ($duration) {
|
|
my ($days, $hours, $minutes, $seconds)
|
|
= $duration =~ m{
|
|
P
|
|
(?:(\d+)D)? # Days
|
|
T
|
|
(?:(\d+)H)? # Hours
|
|
(?:(\d+)M)? # Minutes
|
|
(?:(\d+)S)? # Seconds
|
|
}ix;
|
|
my $startDate = $properties->{startDate};
|
|
# Fill in bogus value to get a WebGUI::DateTime object,
|
|
# we'll figure out what we actually need later
|
|
my $startTime = $properties->{startTime} || "00:00:00";
|
|
|
|
my $datetime = WebGUI::DateTime->new($session,$startDate." ".$startTime);
|
|
|
|
$datetime->add(
|
|
days => $days || 0,
|
|
hours => $hours || 0,
|
|
minutes => $minutes || 0,
|
|
seconds => $seconds || 0,
|
|
);
|
|
|
|
$properties->{endDate} = $datetime->toDatabaseDate;
|
|
# If it not an all-day event, set the end time too
|
|
if ($properties->{startTime}) {
|
|
$properties->{endTime} = $datetime->toDatabaseTime;
|
|
}
|
|
}
|
|
# No dtend, no duration, just copy the start
|
|
else {
|
|
$properties->{endDate} = $properties->{startDate};
|
|
$properties->{endTime} = $properties->{startTime};
|
|
}
|
|
|
|
|
|
# If there are X-WebGUI-* fields
|
|
for my $key (grep /^X-WEBGUI-/, keys %{$events{$id}})
|
|
{
|
|
my $property_name = $key;
|
|
$property_name =~ s/^X-WEBGUI-//;
|
|
|
|
if (lc $property_name eq "groupidedit")
|
|
{
|
|
$properties->{groupIdEdit} = $events{$id}->{$key}->[1];
|
|
}
|
|
elsif (lc $property_name eq "groupidview")
|
|
{
|
|
$properties->{groupIdView} = $events{$id}->{$key}->[1];
|
|
}
|
|
elsif (lc $property_name eq "url")
|
|
{
|
|
$properties->{url} = $events{$id}->{$key}->[1];
|
|
}
|
|
elsif (lc $property_name eq "menutitle")
|
|
{
|
|
$properties->{menuTitle} = $events{$id}->{$key}->[1];
|
|
}
|
|
}
|
|
|
|
|
|
# Update event
|
|
my ($assetId) = $self->session->db->quickArray("select assetId from Event where feedUid=?",[$id]);
|
|
|
|
# If this event already exists, update
|
|
if ($assetId)
|
|
{
|
|
#warn "Updating $assetId\n";
|
|
|
|
my $event = WebGUI::Asset->newByDynamicClass($self->session,$assetId);
|
|
|
|
if ($event)
|
|
{
|
|
$event->update($properties);
|
|
$event->requestAutoCommit;
|
|
$updated++;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
my $calendar = WebGUI::Asset->newByDynamicClass($self->session,$feed->{assetId});
|
|
if (!defined $calendar) {
|
|
$self->session->errorHandler->error("CalendarUpdateFeeds Activity: Calendar object failed to instanciate. Did you commit the calendar wobject?");
|
|
return $self->ERROR;
|
|
}
|
|
my $event = $calendar->addChild($properties);
|
|
$event->requestAutoCommit;
|
|
$added++;
|
|
}
|
|
|
|
# TODO: Only update if last-updated field is
|
|
# greater than the event's lastUpdated property
|
|
}
|
|
|
|
# Update the result and last updated fields
|
|
$self->session->db->write("update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?",
|
|
["Success! $added added, $updated updated, $errored parsing errors",$dt,$feed->{feedId}]);
|
|
}
|
|
else
|
|
{
|
|
# Update the result and last updated fields
|
|
$self->session->db->write("update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?",
|
|
[$response->message,$dt,$feed->{feedId}]);
|
|
}
|
|
}
|
|
|
|
$sth->finish;
|
|
|
|
return $self->COMPLETE;
|
|
}
|
|
|
|
|
|
=head1 BUGS
|
|
|
|
We should probably be using some sort of parser for the iCalendar files. I did
|
|
not have time to make a decent observation but the following were observed and
|
|
rejected
|
|
|
|
Data::ICal - Best one I saw. Rejected because I've run out of time
|
|
Text::vFile
|
|
Net::ICal
|
|
iCal::Parser - Bad data structure
|
|
Tie::iCal
|
|
|
|
=cut
|
|
|
|
1;
|
|
|
|
|