import recurrence from ical feeds

This commit is contained in:
Graham Knop 2007-09-27 08:10:05 +00:00
parent 37de40d719
commit 4172e78133
3 changed files with 374 additions and 256 deletions

View file

@ -10,6 +10,7 @@
- changed hover help to use YUI tooltips, fixes positioning issues - changed hover help to use YUI tooltips, fixes positioning issues
- remove duplicate header section in calendar event template - remove duplicate header section in calendar event template
- events now have a time zone. fixes recurring events being generated on the wrong day. - events now have a time zone. fixes recurring events being generated on the wrong day.
- recurring events are included in iCal feeds
7.4.7 7.4.7
- fix: misspelled i18n in webgui password recovery - fix: misspelled i18n in webgui password recovery

View file

@ -218,7 +218,8 @@ sub generateRecurringEvents {
$eventTime = WebGUI::DateTime->new($session, $properties->{startDate} . " " . $properties->{startTime}); $eventTime = WebGUI::DateTime->new($session, $properties->{startDate} . " " . $properties->{startTime});
$eventTime = $eventTime->set_time_zone($properties->{timeZone})->toMysqlTime; $eventTime = $eventTime->set_time_zone($properties->{timeZone})->toMysqlTime;
} }
$properties->{feedUid} = undef;
my @dates = $self->getRecurrenceDates; my @dates = $self->getRecurrenceDates;
for my $date (@dates) { for my $date (@dates) {

View file

@ -25,7 +25,7 @@ use WebGUI::DateTime;
use DateTime::TimeZone; use DateTime::TimeZone;
use LWP::UserAgent; use LWP::UserAgent;
use JSON qw(objToJson jsonToObj);
=head1 NAME =head1 NAME
@ -55,15 +55,15 @@ See WebGUI::Workflow::Activity::defintion() for details.
=cut =cut
sub definition { sub definition {
my $class = shift; my $class = shift;
my $session = shift; my $session = shift;
my $definition = shift; my $definition = shift;
my $i18n = WebGUI::International->new($session, "Asset_Calendar"); my $i18n = WebGUI::International->new($session, "Asset_Calendar");
push(@{$definition}, { push(@{$definition}, {
name => $i18n->get("workflow updateFeeds"), name => $i18n->get("workflow updateFeeds"),
properties => { } properties => { }
}); });
return $class->SUPER::definition($session,$definition); return $class->SUPER::definition($session,$definition);
} }
@ -76,212 +76,214 @@ See WebGUI::Workflow::Activity::execute() for details.
=cut =cut
sub execute { sub execute {
my $self = shift; my $self = shift;
my $session = $self->session; my $session = $self->session;
$self->session->user({userId => 3});
my $object = shift;
my $instance = shift;
$self->session->user({userId => 3});
### TODO: If we take more than a minute, return WAITING so that some ### TODO: If we take more than a minute, return WAITING so that some
# other activity can run # other activity can run
my $startTime = time();
my $ua = LWP::UserAgent->new(agent => "WebGUI"); my $dt = WebGUI::DateTime->new($session, $startTime)->toMysql;
my $dt = WebGUI::DateTime->new($session, time)->toMysql;
my $sth = $self->session->db->read("select * from Calendar_feeds");
#use Data::Dumper;
FEED:while (my $feed = $sth->hashRef) { local $JSON::UnMapping = 1;
my $eventList;
my $feedList;
if ($instance->getScratch('events')) {
$eventList = jsonToObj($instance->getScratch('events'));
$feedList = jsonToObj($instance->getScratch('feeds'));
}
else {
my $ua = LWP::UserAgent->new(agent => "WebGUI");
my $sth = $self->session->db->read("select * from Calendar_feeds");
#!!! KLUDGE - If the feed is on the same server, set a scratch value FEED: while (my $feed = $sth->hashRef) {
# I do not know how dangerous this is, so THIS MUST CHANGE! #!!! KLUDGE - If the feed is on the same server, set a scratch value
# Preferably: Spectre would add a userSession to the database, # I do not know how dangerous this is, so THIS MUST CHANGE!
# and send the appropriate cookie with the request. # Preferably: Spectre would add a userSession to the database,
my $sitename = $self->session->config->get("sitename")->[0]; # and send the appropriate cookie with the request.
if ($feed->{url} =~ m{http://[^/]*$sitename}) 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 (?,?,?)", $feed->{url} .= ( $feed->{url} =~ /[?]/ ? ";" : "?" ) . "adminId=".$session->getId;
[$session->getId,$feed->{assetId},"SPECTRE"]); $self->session->db->write("REPLACE INTO userSessionScratch (sessionId,name,value) VALUES (?,?,?)",
} [$session->getId,$feed->{assetId},"SPECTRE"]);
#/KLUDGE }
#warn "FEED URL: ".$feed->{url} ."\n"; #/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) ## Somebody point me to a DECENT iCalendar parser...
{ # Text::vFile perhaps?
my $data = $response->content;
# Get the feed
# If doesn't start with BEGIN:VCALENDAR then error my $response = $ua->get($feed->{url});
unless ($data =~ /^BEGIN:VCALENDAR/i)
{ if (!$response->is_success) {
# Update the result and last updated fields # Update the result and last updated fields
$self->session->db->write( $self->session->db->write("update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?",
"update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?", [($response->message || $response->content),$dt,$feed->{feedId}]);
["Not an iCalendar feed",$dt,$feed->{feedId}]); next FEED;
next FEED; }
}
my $data = $response->content;
my $active = 0; # Parser on/off # If doesn't start with BEGIN:VCALENDAR then error
my %current_event = (); unless ($data =~ /^BEGIN:VCALENDAR/i) {
my $current_entry = ""; # Update the result and last updated fields
my %events; $self->session->db->write(
my $line_number = 0; "update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?",
for my $line (split /[\r\n]+/,$data) ["Not an iCalendar feed",$dt,$feed->{feedId}]);
{ next FEED;
chomp $line; }
$line_number++;
next unless $line =~ /\w/; my $active = 0; # Parser on/off
my %current_event = ();
#warn "LINE $line_number: $line\n"; my $current_entry = "";
my %events;
if ($line =~ /^BEGIN:VEVENT$/i) my $line_number = 0;
{ for my $line (split /[\r\n]+/,$data) {
$active = 1; chomp $line;
} $line_number++;
elsif ($line =~ /^END:VEVENT$/i) next unless $line =~ /\w/;
{
$active = 0; #warn "LINE $line_number: $line\n";
# Flush event
my $uid = lc $current_event{uid}[1]; if ($line =~ /^BEGIN:VEVENT$/i) {
delete $current_event{uid}; $active = 1;
$events{$uid} = {%current_event}; }
%current_event = (); elsif ($line =~ /^END:VEVENT$/i) {
} $active = 0;
elsif ($line =~ /^ /) # Flush event
{ my $uid = lc $current_event{uid}[1];
# Add to entry data delete $current_event{uid};
$current_entry .= substr $line, 1; $events{$uid} = {%current_event};
} %current_event = ();
else }
{ elsif ($line =~ /^ /) {
# Flush old entry # Add to entry data
# KEY;ATTRIBUTE=VALUE;ATTRIBUTE=VALUE:KEYVALUE $current_entry .= substr $line, 1;
my ($key_attrs,$value) = split /:/,$current_entry,2; }
my @attrs = split /;/, $key_attrs; else {
my $key = shift @attrs; # Flush old entry
my %attrs; # KEY;ATTRIBUTE=VALUE;ATTRIBUTE=VALUE:KEYVALUE
while (my $attribute = shift @attrs) my ($key_attrs,$value) = split /:/,$current_entry,2;
{ my @attrs = split /;/, $key_attrs;
my ($attr_key, $attr_value) = split /=/, $attribute, 2; my $key = shift @attrs;
$attrs{lc $attr_key} = $attr_value; my %attrs;
} while (my $attribute = shift @attrs) {
my ($attr_key, $attr_value) = split /=/, $attribute, 2;
# Unescape value $attrs{lc $attr_key} = $attr_value;
}
$current_event{lc $key} = [\%attrs,$value]; # Unescape value
# Start new entry
$current_entry = $line; $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) my $feedData = $feedList->{$feed->{feedId}} = {
{ added => 0,
#use Data::Dumper; updated => 0,
#warn "EVENT: $id; ".Dumper $events{$id}; errored => 0,
assetId => $feed->{assetId},
# Prepare event data };
my $properties = { EVENT: for my $id (keys %events) {
feedUid => $id, #use Data::Dumper;
feedId => $feed->{feedId}, #warn "EVENT: $id; ".Dumper $events{$id};
description => $events{$id}->{description}->[1],
title => $events{$id}->{summary}->[1], # Prepare event data
menuTitle => substr($events{$id}->{summary}->[1],0,15), my $properties = {
className => 'WebGUI::Asset::Event', feedUid => $id,
isHidden => 1, feedId => $feed->{feedId},
}; description => $events{$id}->{description}->[1],
title => $events{$id}->{summary}->[1],
# Prepare the date menuTitle => substr($events{$id}->{summary}->[1],0,15),
my $dtstart = $events{$id}->{dtstart}->[1]; className => 'WebGUI::Asset::Event',
if ($dtstart =~ /T/) isHidden => 1,
{ };
my ($date, $time) = split /T/, $dtstart;
# Prepare the date
my ($year, $month, $day) = $date =~ /(\d{4})(\d{2})(\d{2})/; my $dtstart = $events{$id}->{dtstart}->[1];
my ($hour, $minute, $second) = $time =~ /(\d{2})(\d{2})(\d{2})/; 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})/;
my $tz = $events{$id}->{dtstart}->[0]->{tzid}; my $tz = $events{$id}->{dtstart}->[0]->{tzid};
if (!$tz || !DateTime::TimeZone->is_valid_name($tz)) { if (!$tz || !DateTime::TimeZone->is_valid_name($tz)) {
$tz = "UTC"; $tz = "UTC";
} }
($properties->{startDate}, $properties->{startTime}) = ($properties->{startDate}, $properties->{startTime}) =
split / /, WebGUI::DateTime->new( split / /, WebGUI::DateTime->new(
year => $year, year => $year,
month => $month, month => $month,
day => $day, day => $day,
hour => $hour, hour => $hour,
minute => $minute, minute => $minute,
second => $second, second => $second,
time_zone => $tz, time_zone => $tz,
)->toMysql; )->toMysql;
} $properties->{timeZone} = $tz;
elsif ($dtstart =~ /(\d{4})(\d{2})(\d{2})/) }
{ elsif ($dtstart =~ /(\d{4})(\d{2})(\d{2})/) {
my ($year, $month, $day) = $dtstart =~ /(\d{4})(\d{2})(\d{2})/; my ($year, $month, $day) = $dtstart =~ /(\d{4})(\d{2})(\d{2})/;
$properties->{startDate} = join "-",$year,$month,$day; $properties->{startDate} = join "-",$year,$month,$day;
} }
elsif ($dtstart) { elsif ($dtstart) {
$session->errorHandler->warn( $session->errorHandler->warn(
"Workflow::Activity::CalendarUpdateFeeds" "Workflow::Activity::CalendarUpdateFeeds"
. " -- '$dtstart' does not appear to be a valid date" . " -- '$dtstart' does not appear to be a valid date"
); );
$errored++; $feedData->{errored}++;
next EVENT; next EVENT;
} }
my $dtend = $events{$id}->{dtend}->[1]; my $dtend = $events{$id}->{dtend}->[1];
my $duration = $events{$id}->{duration}->[1]; my $duration = $events{$id}->{duration}->[1];
if ($dtend =~ /T/) if ($dtend =~ /T/) {
{ my ($date, $time) = split /T/, $dtend;
my ($date, $time) = split /T/, $dtend;
my ($year, $month, $day) = $date =~ /(\d{4})(\d{2})(\d{2})/;
my ($year, $month, $day) = $date =~ /(\d{4})(\d{2})(\d{2})/; my ($hour, $minute, $second) = $time =~ /(\d{2})(\d{2})(\d{2})/;
my ($hour, $minute, $second) = $time =~ /(\d{2})(\d{2})(\d{2})/;
my $tz = $events{$id}->{dtend}->[0]->{tzid}; my $tz = $events{$id}->{dtend}->[0]->{tzid};
if (!$tz || !DateTime::TimeZone->is_valid_name($tz)) { if (!$tz || !DateTime::TimeZone->is_valid_name($tz)) {
$tz = "UTC"; $tz = "UTC";
} }
($properties->{endDate}, $properties->{endTime}) = ($properties->{endDate}, $properties->{endTime}) =
split / /, WebGUI::DateTime->new( split / /, WebGUI::DateTime->new(
year => $year, year => $year,
month => $month, month => $month,
day => $day, day => $day,
hour => $hour, hour => $hour,
minute => $minute, minute => $minute,
second => $second, second => $second,
time_zone => $tz, time_zone => $tz,
)->toMysql; )->toMysql;
} $properties->{timeZone} = $tz;
elsif ($dtend =~ /(\d{4})(\d{2})(\d{2})/) }
{ elsif ($dtend =~ /(\d{4})(\d{2})(\d{2})/) {
my ($year, $month, $day) = $dtend =~ /(\d{4})(\d{2})(\d{2})/; my ($year, $month, $day) = $dtend =~ /(\d{4})(\d{2})(\d{2})/;
$properties->{endDate} = join "-",$year,$month,$day; $properties->{endDate} = join "-",$year,$month,$day;
} }
# If we can't parse it, forget the whole event # If we can't parse it, forget the whole event
elsif ($dtend) { elsif ($dtend) {
$session->errorHandler->warn( $session->errorHandler->warn(
"Workflow::Activity::CalendarUpdateFeeds" "Workflow::Activity::CalendarUpdateFeeds"
. " -- '$dtend' does not appear to be a valid date" . " -- '$dtend' does not appear to be a valid date"
); );
$errored++; $feedData->{errored}++;
next EVENT; next EVENT;
} }
# No dtend, but we have duration! # No dtend, but we have duration!
elsif ($duration) { elsif ($duration) {
my ($days, $hours, $minutes, $seconds) my ($days, $hours, $minutes, $seconds)
= $duration =~ m{ = $duration =~ m{
P P
@ -295,7 +297,6 @@ sub execute {
# Fill in bogus value to get a WebGUI::DateTime object, # Fill in bogus value to get a WebGUI::DateTime object,
# we'll figure out what we actually need later # we'll figure out what we actually need later
my $startTime = $properties->{startTime} || "00:00:00"; my $startTime = $properties->{startTime} || "00:00:00";
my $datetime = WebGUI::DateTime->new($session,$startDate." ".$startTime); my $datetime = WebGUI::DateTime->new($session,$startDate." ".$startTime);
$datetime->add( $datetime->add(
@ -316,79 +317,194 @@ sub execute {
$properties->{endDate} = $properties->{startDate}; $properties->{endDate} = $properties->{startDate};
$properties->{endTime} = $properties->{startTime}; $properties->{endTime} = $properties->{startTime};
} }
# If there are X-WebGUI-* fields
# If there are X-WebGUI-* fields for my $key (grep /^X-WEBGUI-/, keys %{$events{$id}}) {
for my $key (grep /^X-WEBGUI-/, keys %{$events{$id}}) my $property_name = $key;
{ $property_name =~ s/^X-WEBGUI-//;
my $property_name = $key;
$property_name =~ s/^X-WEBGUI-//; if (lc $property_name eq "groupidedit")
{
if (lc $property_name eq "groupidedit") $properties->{groupIdEdit} = $events{$id}->{$key}->[1];
{ }
$properties->{groupIdEdit} = $events{$id}->{$key}->[1]; elsif (lc $property_name eq "groupidview")
} {
elsif (lc $property_name eq "groupidview") $properties->{groupIdView} = $events{$id}->{$key}->[1];
{ }
$properties->{groupIdView} = $events{$id}->{$key}->[1]; elsif (lc $property_name eq "url")
} {
elsif (lc $property_name eq "url") $properties->{url} = $events{$id}->{$key}->[1];
{ }
$properties->{url} = $events{$id}->{$key}->[1];
}
elsif (lc $property_name eq "menutitle") elsif (lc $property_name eq "menutitle")
{ {
$properties->{menuTitle} = $events{$id}->{$key}->[1]; $properties->{menuTitle} = $events{$id}->{$key}->[1];
} }
} }
my $recur;
# Update event if ($events{$id}->{rrule}) {
my ($assetId) = $self->session->db->quickArray("select assetId from Event where feedUid=?",[$id]); $recur = _icalToRecur($session, $properties->{startDate}, $events{$id}->{rrule}->[1]);
}
# If this event already exists, update
if ($assetId) # save events for later
{ push @$eventList, {
#warn "Updating $assetId\n"; properties => $properties,
recur => $recur,
my $event = WebGUI::Asset->newByDynamicClass($self->session,$assetId); };
}
if ($event) }
{ }
$event->update($properties); while (@$eventList) {
$event->requestAutoCommit; if ($startTime + 55 < time()) {
$updated++; $instance->setScratch('events', objToJson($eventList));
} $instance->setScratch('feeds', objToJson($feedList));
} return $self->WAITING;
else }
{ my $eventData = shift @$eventList;
my $calendar = WebGUI::Asset->newByDynamicClass($self->session,$feed->{assetId}); my $recur = $eventData->{recur};
if (!defined $calendar) { my $properties = $eventData->{properties};
$self->session->errorHandler->error("CalendarUpdateFeeds Activity: Calendar object failed to instanciate. Did you commit the calendar wobject?"); my $id = $properties->{feedUid};
return $self->ERROR; my $feed = $feedList->{$properties->{feedId}};
}
my $event = $calendar->addChild($properties); # Update event
$event->requestAutoCommit; my ($assetId) = $self->session->db->quickArray("select assetId from Event where feedUid=?",[$id]);
$added++;
} # If this event already exists, update
if ($assetId) {
# TODO: Only update if last-updated field is #warn "Updating $assetId\n";
# greater than the event's lastUpdated property my $event = WebGUI::Asset->newByDynamicClass($self->session,$assetId);
}
if ($event) {
# Update the result and last updated fields $event->update($properties);
$self->session->db->write("update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?", $event->requestAutoCommit;
["Success! $added added, $updated updated, $errored parsing errors",$dt,$feed->{feedId}]); $feed->{updated}++;
} }
else }
{ else {
# Update the result and last updated fields my $calendar = WebGUI::Asset->newByDynamicClass($self->session,$feed->{assetId});
$self->session->db->write("update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?", if (!defined $calendar) {
[($response->message || $response->content),$dt,$feed->{feedId}]); $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);
return $self->COMPLETE; $event->requestAutoCommit;
$feed->{added}++;
if ($recur) {
$event->setRecurrence($recur);
$event->generateRecurringEvents;
}
}
# TODO: Only update if last-updated field is
# greater than the event's lastUpdated property
}
for my $feedId (keys %$feedList) {
my $feed = $feedList->{$feedId};
$self->session->db->write("update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?",
["Success! $feed->{added} added, $feed->{updated} updated, $feed->{errored} parsing errors",$dt,$feedId]);
}
$instance->deleteScratch('events');
$instance->deleteScratch('feeds');
return $self->COMPLETE;
}
# We need to use ical format for everything, but this is a stopgap until then.
sub _icalToRecur {
my $session = shift;
my $startDate = shift;
my $rrule = lc shift;
my $ical = {
map {split /=/} split(/;/, $rrule)
};
my $date = WebGUI::DateTime->new($session, "$startDate 00:00:00");
my $startWeekDay = substr('umtwrfs', $date->day_of_week % 7, 1);
my $icalDays = {
su => 'u',
mo => 'm',
tu => 't',
we => 'w',
th => 'r',
fr => 'f',
sa => 's',
};
my $icalMonths = {
1 => 'jan',
2 => 'feb',
3 => 'mar',
4 => 'apr',
5 => 'may',
6 => 'jun',
7 => 'jul',
8 => 'aug',
9 => 'sep',
10 => 'oct',
11 => 'nov',
12 => 'dec',
};
my $recur = {
startDate => $startDate,
every => $ical->{interval} || 1,
};
my $type = lc $ical->{"freq"};
if ($type eq "daily") {
$recur->{recurType} = 'daily';
}
elsif ($type eq "weekly") {
$recur->{recurType} = 'weekly';
$recur->{dayNames} = [];
for my $day (split /,/, $ical->{byday}) {
push @{$recur->{dayNames}}, $icalDays->{$day};
}
if(!@{$recur->{dayNames}}) {
$recur->{dayNames} = [ $startWeekDay ];
}
elsif (!defined $recur->{dayNames}->[0]) {
warn "---$ical->{byday}--- length:" . length($ical->{byday});
}
}
elsif ($type eq "monthly") {
$recur->{recurType} = "monthDay";
$recur->{dayNumber} = $ical->{bymonthday};
}
elsif ($type eq "yearly") {
$recur->{recurType} = "yearDay";
$recur->{dayNumber} = $ical->{bymonthday};
$recur->{months} = [
map { $icalMonths->{lc $1} } split(',', $ical->{bymonth})
];
}
if ($ical->{count}) {
$recur->{endAfter} = $ical->{count};
}
elsif ($ical->{until}) {
$recur->{endDate} = (_icalToMySQL($ical->{until}))[0];
}
else {
$recur->{endDate} = $date->clone->add(years => 2)->toDatabaseDate;
}
return $recur;
}
sub _icalToMySQL {
my $dt = shift;
my ($date, $time) = split /t/, $dt;
my ($year, $month, $day) = $date =~ /(\d{4})(\d{2})(\d{2})/;
my ($hour, $minute, $second) = $time =~ /(\d{2})(\d{2})(\d{2})/;
return split / /, WebGUI::DateTime->new(
year => $year,
month => $month,
day => $day,
hour => $hour,
minute => $minute,
second => $second,
)->toMysql;
} }
@ -398,10 +514,10 @@ 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 not have time to make a decent observation but the following were observed and
rejected rejected
Data::ICal - Best one I saw. Rejected because I've run out of time Data::ICal - Best one I saw. Rejected because I've run out of time
Text::vFile Text::vFile
Net::ICal Net::ICal
iCal::Parser - Bad data structure iCal::Parser - Bad data structure
Tie::iCal Tie::iCal
=cut =cut