diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 02b25ec31..83bbf175b 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -10,6 +10,7 @@ - changed hover help to use YUI tooltips, fixes positioning issues - remove duplicate header section in calendar event template - 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 - fix: misspelled i18n in webgui password recovery diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index e48a4ebeb..92fd27adb 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -218,7 +218,8 @@ sub generateRecurringEvents { $eventTime = WebGUI::DateTime->new($session, $properties->{startDate} . " " . $properties->{startTime}); $eventTime = $eventTime->set_time_zone($properties->{timeZone})->toMysqlTime; } - + $properties->{feedUid} = undef; + my @dates = $self->getRecurrenceDates; for my $date (@dates) { diff --git a/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm b/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm index c7d7737db..1d8968e5a 100755 --- a/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm +++ b/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm @@ -25,7 +25,7 @@ use WebGUI::DateTime; use DateTime::TimeZone; use LWP::UserAgent; - +use JSON qw(objToJson jsonToObj); =head1 NAME @@ -55,15 +55,15 @@ 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); + 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); } @@ -76,212 +76,214 @@ See WebGUI::Workflow::Activity::execute() for details. =cut sub execute { - my $self = shift; + my $self = shift; 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 # other activity can run - - my $ua = LWP::UserAgent->new(agent => "WebGUI"); - my $dt = WebGUI::DateTime->new($session, time)->toMysql; - - my $sth = $self->session->db->read("select * from Calendar_feeds"); - - #use Data::Dumper; + my $startTime = time(); + my $dt = WebGUI::DateTime->new($session, $startTime)->toMysql; - 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 - # 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}); + 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"; - if ($response->is_success) - { - my $data = $response->content; - - # If doesn't start with BEGIN:VCALENDAR then error - unless ($data =~ /^BEGIN:VCALENDAR/i) - { + ## Somebody point me to a DECENT iCalendar parser... + # Text::vFile perhaps? + + # Get the feed + my $response = $ua->get($feed->{url}); + + if (!$response->is_success) { # 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; - } + $self->session->db->write("update Calendar_feeds set lastResult=?,lastUpdated=? where feedId=?", + [($response->message || $response->content),$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})/; + 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 $feedData = $feedList->{$feed->{feedId}} = { + added => 0, + updated => 0, + errored => 0, + assetId => $feed->{assetId}, + }; + 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})/; my $tz = $events{$id}->{dtstart}->[0]->{tzid}; if (!$tz || !DateTime::TimeZone->is_valid_name($tz)) { $tz = "UTC"; } - ($properties->{startDate}, $properties->{startTime}) = - split / /, WebGUI::DateTime->new( - year => $year, - month => $month, - day => $day, - hour => $hour, - minute => $minute, - second => $second, - time_zone => $tz, - )->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; - } + ($properties->{startDate}, $properties->{startTime}) = + split / /, WebGUI::DateTime->new( + year => $year, + month => $month, + day => $day, + hour => $hour, + minute => $minute, + second => $second, + time_zone => $tz, + )->toMysql; + $properties->{timeZone} = $tz; + } + 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++; + $feedData->{errored}++; next EVENT; } - - my $dtend = $events{$id}->{dtend}->[1]; + + 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})/; + 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})/; my $tz = $events{$id}->{dtend}->[0]->{tzid}; if (!$tz || !DateTime::TimeZone->is_valid_name($tz)) { $tz = "UTC"; } - - ($properties->{endDate}, $properties->{endTime}) = - split / /, WebGUI::DateTime->new( - year => $year, - month => $month, - day => $day, - hour => $hour, - minute => $minute, - second => $second, - time_zone => $tz, - )->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; - } + + ($properties->{endDate}, $properties->{endTime}) = + split / /, WebGUI::DateTime->new( + year => $year, + month => $month, + day => $day, + hour => $hour, + minute => $minute, + second => $second, + time_zone => $tz, + )->toMysql; + $properties->{timeZone} = $tz; + } + 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++; + $feedData->{errored}++; next EVENT; } # No dtend, but we have duration! - elsif ($duration) { + elsif ($duration) { my ($days, $hours, $minutes, $seconds) = $duration =~ m{ P @@ -295,7 +297,6 @@ sub execute { # 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( @@ -316,79 +317,194 @@ sub execute { $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]; - } + + # 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 || $response->content),$dt,$feed->{feedId}]); - } - } - - return $self->COMPLETE; + } + + my $recur; + if ($events{$id}->{rrule}) { + $recur = _icalToRecur($session, $properties->{startDate}, $events{$id}->{rrule}->[1]); + } + + # save events for later + push @$eventList, { + properties => $properties, + recur => $recur, + }; + } + } + } + while (@$eventList) { + if ($startTime + 55 < time()) { + $instance->setScratch('events', objToJson($eventList)); + $instance->setScratch('feeds', objToJson($feedList)); + return $self->WAITING; + } + my $eventData = shift @$eventList; + my $recur = $eventData->{recur}; + my $properties = $eventData->{properties}; + my $id = $properties->{feedUid}; + my $feed = $feedList->{$properties->{feedId}}; + + # 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; + $feed->{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; + $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 rejected - Data::ICal - Best one I saw. Rejected because I've run out of time - Text::vFile + Data::ICal - Best one I saw. Rejected because I've run out of time + Text::vFile Net::ICal - iCal::Parser - Bad data structure + iCal::Parser - Bad data structure Tie::iCal =cut