- Publicity: Public Only All
ical-procs.tcl
Utility functions for ical data
This file defines the following Objects and Classes: ::xo::ical::VEVENT
, ::xo::ical::VCALITEM
- Location:
- packages/xotcl-core/tcl/ical-procs.tcl
- Created:
- July 20, 2005, modernized in 2019
- Author:
- neumann@wu-wien.ac.at
Procedures in this file
- Class ::xo::ical::VCALITEM (public)
- Class ::xo::ical::VEVENT (public)
- xo::ical::VCALITEM instproc add_recurrence (public)
- xo::ical::VCALITEM instproc as_ical (public)
- xo::ical::VCALITEM instproc edit_recurrence (public)
- xo::ical::VCALITEM instproc get (public)
- xo::ical::VCALITEM instproc ical_body (public)
- xo::ical::VCALITEM instproc start_end (protected)
- xo::ical::VCALITEM instproc tag (protected)
- xo::ical::VCALITEM instproc {parse RRULE} (public)
- xo::ical::VEVENT instproc finish (public)
Detailed information
Class ::xo::ical::VCALITEM (public)
::nx::Class ::xo::ical::VCALITEMVCALITEM is the superclass of a VTODO and a VEVENT, intended as an abstract class.
- Testcases:
- No testcase defined.
Class ::xo::ical::VEVENT (public)
::nx::Class ::xo::ical::VEVENTVEVENT optional fields, must not occur more than once class / *created / *description / *dtstart / *geo / *last-mod / *location / organizer / *priority / *dtstamp / seq / *status / *summary / transp / *uid / *url / recurid / dtend or duration may appear, but dtend and duration are mutual exclusive *dtend / duration / optional fields, may occur more than once attach / attendee / categories / comment / contact / exdate / exrule / rstatus / related / resources / rdate / rrule / x-prop
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method add_recurrence (public)
<instance of xo::ical::VCALITEM> add_recurrence \
[ -cal_item_id cal_item_id ]Call calendar::item::add_recurrence with the options calculated by "parse RRULE"
- Switches:
- -cal_item_id (optional, integer)
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method as_ical (public)
<instance of xo::ical::VCALITEM> as_icalOutput a VCALITEM (VTODO or VEVENT) "object" in ical notation.
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method edit_recurrence (public)
<instance of xo::ical::VCALITEM> edit_recurrence \
[ -cal_item_id cal_item_id ] [ -recurrence_id recurrence_id ]We might or might not have a recurrence on the old entry. In case we have one, the old one might have started earlier, so we try to terminate it.
- Switches:
- -cal_item_id (optional, integer)
- -recurrence_id (optional, integer, accept empty)
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method get (public)
<instance of xo::ical::VCALITEM> get property [ default ]Return a certain property of an ical items. In case, the item has no such property, return the default value.
- Parameters:
- property (required)
- default (optional)
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method ical_body (public)
<instance of xo::ical::VCALITEM> ical_bodyThe method ical_body returns the ical-formatted content of the variables. All variables of VEVENTs and VTODOs are listed below, since the names are distinct, and no methods are used. So far there is no handling for the repetition fields (which might occur more than once). An option would be to handle these as lists. All date/timestamps are provided either by the ANSI date (from postgres) or by a date which can be processed via clock scan
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method start_end (protected)
<instance of xo::ical::VCALITEM> start_endOutput either a DAY-EVENT (denoted by a single DTSTART with appropriate VALUE format) or a state and end timestamps.
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method tag (protected)
<instance of xo::ical::VCALITEM> tag [ -tag tag ] \
[ -param param ] [ -conv conv ] [ -value value ] slotGenerate a single (line) entry in ical format starting with the specified tag. If no "tag" is specified, the tag name is uppercase of the slot. The value might be specified literally or it can be the name of an instance variable (named by the "slot" attribute". The functions returns empty (produces no output) when either the value is empty or no instance variable exists. Optionally, the value can be converted.
- Switches:
- -tag (optional)
- -param (optional)
- -conv (optional)
- -value (optional)
- Parameters:
- slot (required)
- Testcases:
- No testcase defined.
xo::ical::VCALITEM method parse RRULE (public)
<instance of xo::ical::VCALITEM> parse RRULE recurruleparse recurrence rule provided in cal syntax. This method assumes that the instance variable dtstart is already set, before this method is called.
- Parameters:
- recurrule (required)
- Testcases:
- No testcase defined.
xo::ical::VEVENT method finish (public)
<instance of xo::ical::VEVENT> finish parse_errorIn case, there was no :dtend given, set it either to the value of :dtstart, or :dtstart + :duration
- Parameters:
- parse_error (required)
- Testcases:
- No testcase defined.
Content File Source
::xo::library doc { Utility functions for ical data @author neumann@wu-wien.ac.at @creation-date July 20, 2005, modernized in 2019 } namespace eval ::xo::ical {} nx::Object create ::xo::ical { # # The Object ::calendar::ical provides the methods for # importing and exporting single or multiple calendar items # in the ical format (see rfc 2445). Currently only the part # of ical is implemented, which is used by the mozilla # calendar (Sunbird, or Lightning for Thunderbird). # # @author Gustaf Neumann :object method debug {msg} { # # TODO: maybe add Debug(ical)? # ns_log Debug(caldav) "[uplevel current proc]: $msg" } # # Conversion routines from and to the date formats used by ical # :public object method date_time_to_clock {date time utc} { # # Convert separate fields date and time with boolean utc flags # into clock value in seconds. # set year [string range $date 0 3] set month [string range $date 4 5] set day [string range $date 6 7] set hour [string range $time 0 1] set min [string range $time 2 3] set sec [string range $time 4 5] set TZ [expr {$utc ? "GMT" : ""}] return [clock scan "$year-$month-$day $hour:$min $TZ"] } :public object method tcl_time_to_utc {time} { # # Convert Tcl time stamp to UTC. # clock format [clock scan $time] -format "%Y%m%dT%H%M%SZ" -gmt 1 } :public object method tcl_time_to_local_day {time} { # # Convert Tcl time stamp into local day format # https://tools.ietf.org/html/rfc5545#section-3.3.4 # return "VALUE=DATE:[:clock_to_local_day [clock scan $time]]" } :public object method utc_to_clock {utc_time} { # # Convert UTC time to clock seconds. # clock scan $utc_time -format "%Y%m%dT%H%M%SZ" -gmt 1 } :public object method clock_to_utc {seconds:integer} { # # Convert clock epoch (result from [clock seconds]) into UTC time. # clock format $seconds -format "%Y%m%dT%H%M%SZ" -gmt 1 } :public object method clock_to_iso {seconds:integer} { # # Convert clock epoch (result from [clock seconds]) into ISO format # clock format $seconds -format "%Y-%m-%dT%H:%M:%SZ" -gmt 1 } :public object method clock_to_local_day {seconds:integer} { # # Convert clock epoch (result from [clock seconds]) to local day (YearMonthDay) # clock format $seconds -format "%Y%m%d" } :public object method clock_to_oacstime {seconds:integer} { # # Convert clock epoch (result from [clock seconds]) into time # format usually used in OpenACS. # clock format $seconds -format "%Y-%m-%d %H:%M" } :public object method dates_valid_p { -start_date:required -end_date:required } { # A sanity check that the start time is before the end time. # This is a rewrite of calendar::item::dates_valid_p, but # about 100 times faster. # #my log "$start_date <= $end_date = [expr {[clock scan $start_date] <= [clock scan $end_date]}]" expr {[clock scan $start_date] <= [clock scan $end_date]} } :public object method text_to_ical {{-remove_tags:boolean false} text} { # # Transform arbitrary text to the escaped ical text format # (see rfc 2445) # if {$remove_tags} { regsub -all {<[^>]+>} $text "" text } regsub -all {(\\|\;|\,)} $text {\\\1} text regsub -all \n $text {\\n} text return $text } :public object method ical_to_text {text} { # # Transform the escaped ical text format to plain text # regsub -all {\\(n|N)} $text \n text regsub -all {\\(\\|\;|\,)} $text {\1} text return $text } :public object method reflow_content_line {text} { # # Perform line folding: According to RFC 5545 section 3.1, # SHOULD NOT be longer than 75 octets, excluding the line break. # https://www.ietf.org/rfc/rfc5545.txt # if {[string length $text] > 73} { set lines "" while {[string length $text] > 73} { append lines [string range $text 0 73] \r\n " " set text [string range $text 74 end] } append lines $text set text $lines } return $text } } namespace eval ::xo { nx::Class create ::xo::ical::VCALITEM { # # VCALITEM is the superclass of a VTODO and a VEVENT, intended as # an abstract class. # :property -accessor public creation_date :property -accessor public last_modified :property -accessor public dtstart :property -accessor public dtstamp :property -accessor public uid :property -accessor public priority :property -accessor public summary :property -accessor public url :property -accessor public description :property -accessor public location :property -accessor public geo :property -accessor public status :property -accessor public {is_day_item false} :property -accessor public last-modified ;# TODO: who (which client) needs this? not a standard ical attribute :public method get {property {default ""}} { # # Return a certain property of an ical items. In case, the # item has no such property, return the default value. # if {[info exists :$property]} { return [set :$property] } return $default } :method tag {-tag -param -conv -value slot:required} { # # Generate a single (line) entry in ical format starting with # the specified tag. If no "tag" is specified, the tag name is # uppercase of the slot. The value might be specified literally # or it can be the name of an instance variable (named by the # "slot" attribute". # # The functions returns empty (produces no output) when either # the value is empty or no instance variable exists. # Optionally, the value can be converted. # # #ns_log notice "::xo::ical::VCALITEM tag [self args]" if {![info exists tag]} { set tag [string toupper $slot] } # # if we get a param, we expect it to include delimiters, such # as the leading semicolon # if {[info exists param]} { append tag $param } if {![info exists value]} { if {[info exists :$slot]} { set value [set :$slot] } else { # # If we have no value and no instance variable set, do not # output this slot. # return "" } } # # When a converter is given, apply it # if {[info exists conv]} { set value [::xo::ical $conv $value] } if {$value ne ""} { set result [::xo::ical reflow_content_line "$tag:$value"] append result \r\n #ns_log notice "::xo::ical::VCALITEM tag [self args] -> len: [string length $result]" } else { set result "" } return $result } :method start_end {} { # # Output either a DAY-EVENT (denoted by a single DTSTART with # appropriate VALUE format) or a state and end timestamps. # if {${:is_day_item}} { append result \ "DTSTART;" [::xo::ical tcl_time_to_local_day ${:dtstart}] \r\n } else { append result \ [:tag -conv tcl_time_to_utc dtstart] \ [:tag -conv tcl_time_to_utc dtend] } } :public method as_ical {} { # # Output a VCALITEM (VTODO or VEVENT) "object" in ical notation. # set item_type [namespace tail [:info class]] append t "BEGIN:$item_type\r\n" \ [:ical_body] \ "END:$item_type\r\n" return $t } :public method ical_body {} { # # The method ical_body returns the ical-formatted content of the # variables. All variables of VEVENTs and VTODOs are listed below, # since the names are distinct, and no methods are used. # # So far there is no handling for the repetition fields (which # might occur more than once). An option would be to handle these # as lists. # # # All date/timestamps are provided either by # the ANSI date (from postgres) or by a date # which can be processed via clock scan # if {![info exists :dtstamp]} {set :dtstamp ${:creation_date}} if {![info exists :last_modified]} {set :last_modified ${:dtstamp}} set tcl_stamp [::xo::db::tcl_date ${:dtstamp} tz] set tcl_creation_date [::xo::db::tcl_date ${:creation_date} tz] set tcl_last_modified [::xo::db::tcl_date ${:last_modified} tz] # status values: # VEVENT: TENTATIVE, CONFIRMED, CANCELLED # VTODO: NEEDS-ACTION, COMPLETED, IN-PROCESS, CANCELLED # VJOURNAL: DRAFT, FINAL, CANCELLED append t \ [:tag -conv tcl_time_to_utc -value $tcl_creation_date created] \ [:tag -conv tcl_time_to_utc -value $tcl_last_modified last-modified] \ [:tag -conv tcl_time_to_utc -value $tcl_stamp dtstamp] \ [:start_end] \ [:tag -conv tcl_time_to_utc completed] \ [:tag -conv tcl_time_to_utc percent-complete] \ [:tag transp] \ [:tag uid] \ [:tag url] \ [:tag geo] \ [:tag priority] \ [:tag sequence] \ [:tag CLASS] \ [:tag -conv text_to_ical location] \ [:tag status] \ [:tag -conv text_to_ical description] \ [:tag -conv text_to_ical summary] \ [:tag -conv tcl_time_to_utc due] if {[info exists :formatted_recurrences]} { append t ${:formatted_recurrences} } return $t } :public method "parse RRULE" {recurrule} { # # parse recurrence rule provided in cal syntax. This method # assumes that the instance variable dtstart is already set, # before this method is called. # set r_freq "" set every_n 1 set r_error 0 set r_until "" set days_of_week "" set r_count 0 foreach rval [split $recurrule ";"] { if { [regexp {^FREQ\=+(.*)$} $rval _ freqval] } { switch $freqval { DAILY { set r_freq "day" } WEEKLY { set r_freq "week" } MONTHLY { set r_freq "month_by_day"} YEARLY { set r_freq "year"} default { set r_error 1 } } } elseif { [regexp {^COUNT=(.*)$} $rval _ countval] } { set r_count $countval } elseif { [regexp {^UNTIL=([0-9]+)(T([0-9]+)Z?)?$} $rval _ untildate untiltime] } { if {$untiltime eq ""} { set untiltime 000000 } append r_until \ "[string range $untildate 0 3]-[string range $untildate 4 5]-[string range $untildate 6 7]" \ " " \ "[string range $untiltime 0 1]:[string range $untiltime 2 3]" } elseif { [regexp {^INTERVAL\=+(.*)$} $rval _ intval] } { set every_n $intval } elseif { [regexp {^BYDAY\=+(.*)$} $rval _ bydayval] } { # # Build days_of_week list # foreach dayval [split $bydayval ","] { switch $dayval { SU { lappend days_of_week "0" } MO { lappend days_of_week "1" } TU { lappend days_of_week "2" } WE { lappend days_of_week "3" } TH { lappend days_of_week "4" } FR { lappend days_of_week "5" } SA { lappend days_of_week "6" } } } } elseif { [regexp {^BYMONTHDAY\=+(.*)$} $rval _ bymonthdayval] } { set r_freq "month_by_date" } else { # other rules don't work with OpenACS recurrence model :debug "ignore recurrence rule <$rval> of <$recurrule>" } #check we can make this rule, else ignore } # # We should have now 'r_freq' computed. If 'r_until' is not # provided, calculate it based on 'r_count' (COUNT is not # directly supported by OpenACS). If both UNTIL and COUNT are # not set, it is an unlimited event and skipped. # if { $r_until eq "" && $r_freq ne "" && $r_count > 0 } { # current date + r_count * r_freq * every_n (/ num_days) # set num seconds per frequency switch $r_freq { day { set r_freq_amount 86400 } week { set r_freq_amount 604800 } month_by_day { set r_freq_amount 2419200 } month_by_date { set r_freq_amount 2678400 } year { set r_freq_amount 31449600 } } # start date is count=1, so adjust count set r_count [expr {$r_count - 1}] set r_extra [expr {$r_count * $r_freq_amount * $every_n}] if { $r_freq eq "week" && [llength $days_of_week] > 0} { set r_extra [expr {$r_extra / [llength $days_of_week]}] } set r_until [::xo::ical clock_to_oacstime [expr {[clock scan ${:dtstart}] + $r_extra}]] } # # If we have no errors, and 'r_freq' is computed, then keep the # computed values in form of a parameter list for # calendar::item::add_recurrence # if { !$r_error && $r_freq ne ""} { set :recurrence_options [list -interval_type $r_freq -every_n $every_n] if {$days_of_week ne ""} { lappend :recurrence_options -days_of_week $days_of_week } if {$r_until ne ""} { lappend :recurrence_options -recur_until $r_until } } } :public method add_recurrence {-cal_item_id:integer} { # # Call calendar::item::add_recurrence with the options # calculated by "parse RRULE" # if { [info exists :recurrence_options] } { calendar::item::add_recurrence \ -cal_item_id $cal_item_id \ {*}${:recurrence_options} } } :public method edit_recurrence { -cal_item_id:integer -recurrence_id:integer,0..1 } { # # We might or might not have a recurrence on the old entry. # In case we have one, the old one might have started earlier, # so we try to terminate it. :debug "do we have a recurrence? [info exists :recurrence_options]" if { [info exists :recurrence_options] } { if {$recurrence_id ne ""} { # # The current implementation of calendar::item::edit_recurrence is # just built for the interface of the calendar package, which does # not allow one to change multiple attributes. We have to assume, that a # calendar client allows this. # # When the old start date is the same as the new start date, # we could delete the recurrence and add a new one. # # calendar::item::delete_recurrence -recurrence_id $recurrence_id lassign [::xo::dc list -prepare integer get_old_start_date_and_event_id { select start_date, from acs_events e, timespans t, time_intervals i where recurrence_id = :recurrence_id and e.timespan_id = t.timespan_id and i.interval_id = t.interval_id order by 1 limit 1 }] old_start_date old_event_id :debug "recurrence_id $recurrence_id old_event_id $old_event_id cal_item_id $cal_item_id \ old_start_date $old_start_date new start_date ${:dtstart} opts ${:recurrence_options}" ::xo::db::sql::acs_event recurrence_timespan_edit \ -event_id $old_event_id \ -start_date $old_start_date \ -end_date ${:dtstart} } calendar::item::add_recurrence \ -cal_item_id $cal_item_id \ {*}${:recurrence_options} } } # # End of class definition of ::xo::ical::VCALITEM # } nx::Class create ::xo::ical::VTODO -superclass ::xo::ical::VCALITEM { # # VTODO # # optional fields, must not occur more than once # # class / *completed / *created / *description / *dtstamp / # *dtstart / *geo / *last-mod / *location / organizer / # *percent-complete / *priority / recurid / seq / *status / # *summary / *uid / *url / # # optional, but mutual exclusive # *due / duration / # # optional fields, may occur more than once # # attach / attendee / categories / comment / contact / # exdate / exrule / rstatus / related / resources / # rdate / rrule / x-prop :property -accessor public due :property -accessor public completed :property -accessor public percent-complete } nx::Class create ::xo::ical::VEVENT -superclass ::xo::ical::VCALITEM { # # VEVENT # # optional fields, must not occur more than once # # class / *created / *description / *dtstart / *geo / # *last-mod / *location / organizer / *priority / # *dtstamp / seq / *status / *summary / transp / # *uid / *url / recurid / # # dtend or duration may appear, but dtend and duration are mutual exclusive # *dtend / duration / # # optional fields, may occur more than once # # attach / attendee / categories / comment / contact / # exdate / exrule / rstatus / related / resources / # rdate / rrule / x-prop # :property -accessor public dtend :property -accessor public sequence :property -accessor public transp :property -accessor public formatted_recurrences :public method finish {parse_error} { # # In case, there was no :dtend given, set it either to the value # of :dtstart, or :dtstart + :duration # if {![info exists :dtend]} { set end_clock [clock scan ${:dtstart}] if {[info exists :duration]} { incr end_clock ${:duration} } set :dtend [::xo::ical clock_to_oacstime $end_clock] } # TODO: not sure, for what purpose we need parse_error incr $parse_error $parse_error } } # # This class is designed to be a mixin for an ordered composite # Class create ::xo::ical::VCALENDAR -parameter {prodid version method} ::xo::ical::VCALENDAR instproc as_ical {} { if {[info exists :prodid]} {set prodid "PRODID:[:prodid]\n"} {set prodid ""} if {[info exists :method]} {set method "METHOD:[string toupper [:method]]\n"} {set method ""} if {[info exists :version]} {set version "VERSION:[:version]\n"} {set version "VERSION:2.0\n"} set t "" append t "BEGIN:VCALENDAR\n" $prodid $version $method foreach i [:children] { append t [$i as_ical] } append t "END:VCALENDAR\n" return $t } # # Subclass ::xo::ProtocolHandler for dav (as used by ical) # Class create ::xo::dav -superclass ProtocolHandler -parameter { {url /webdav} } } ::xo::library source_dependent # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # eval: (setq tcl-type-alist (remove* "method" tcl-type-alist :test 'equal :key 'car)) # End:
