PHP:
(*
Mail2iCal, rev. 1.5.0, © 2002-2006 by Georg Klein <gklein1@mac.com>
Exchange Calendar invite parsing guff by Andrew J Cosgriff <ajc@polydistortion.net>
This script is distributed as open source software
You are free to copy, modify and share parts of or the entire script, as long as you
a) Keep this notice in any modified version of the script
b) Transfer this notice to any derrivative work
c) Don't charge money for this script or any derrivative of it
This software is provided "as is" without any warranty, explicit or implied.
The author of this software is not liable to any loss or damage of data that
may happen by installing or using it.
*)
property pScriptVersion : "Mail2iCal v1.5.0" -- stores the current script version
property pPrefsFileName : "net.kleinware.Mail2iCal.plist"
global gRunMode
(* first, we deal with execution form a mail rule *)
using terms from application "Mail"
on perform mail action with messages allMessages for rule theRule
set AppleScript's text item delimiters to ""
set gRunMode to "rule"
set createToDo to false
set createEvent to false
try
set toDoDelimiter to my readPreference(pPrefsFileName, "RuleToDoDelimiter")
set eventDelimiter to my readPreference(pPrefsFileName, "RuleEventDelimiter")
set calendarName to my readPreference(pPrefsFileName, "DefaultCalendar")
if calendarName is "" then
my errorHandler("Default calendar missing", "0001", me)
end if
if theRule is not missing value then
set ruleName to name of theRule
else -- this shouldn't happen at all, however, use some default values as failsafe
set ruleName to calendarName & " " & eventDelimiter
end if
set theOffset to offset of toDoDelimiter in ruleName
if theOffset is not 0 then -- we found the todo delimiter
set createToDo to true -- create a todo
set AppleScript's text item delimiters to toDoDelimiter -- now, remove the todo delimiter from the rulename
set ruleTokens to text items of ruleName -- ruleTokens now contains the original rulename without the todo delimiter as a list of strings
set AppleScript's text item delimiters to "" -- return the delimiters back to standard
set ruleName to ruleTokens as string -- stich the string list back together. Result: the original rulename without the todo delimiter
end if
set theOffset to offset of eventDelimiter in ruleName -- the same game with the event delimiter
if theOffset is not 0 then
set createEvent to true
set AppleScript's text item delimiters to eventDelimiter
set ruleTokens to text items of ruleName
set AppleScript's text item delimiters to ""
set ruleName to ruleTokens as string
end if
set thePrefix to my readPreference("com.indev.MailActOn.plist", "ActOnRulePrefix")
set theDelimiter to my readPreference("com.indev.MailActOn.plist", "ActOnRuleTitleDelimiter")
if thePrefix is not "" then -- MailActOn is installed
if ruleName starts with thePrefix then -- this rule is called by MailActOn, strip the prefix from the rule name
set calendarNameOffset to offset of theDelimiter in ruleName
set calendarName to (characters (calendarNameOffset + 2) thru -1 of ruleName) as string
else -- MailActOn is installed, but this is not a MailActOn rule, use the complete rule name as calendar name
set calendarName to ruleName
end if
set calendarName to my stripOddChars(calendarName)
set mailCal to my checkForCalendar(calendarName)
else -- MailActOn is not installed, use the saved calendar as target
set mailCal to my checkForCalendar(calendarName)
end if
if createToDo then
my generateToDos(allMessages, mailCal) -- rule name suggests todos as targets, so generate the todos
end if
-- note, that this is not an else clause. Messages can be converted into events and todos in one run
if createEvent then
my generateEvents(allMessages, mailCal) -- rule name suggests events as targets, so generate the events
end if
on error theError number theNumber from theOffender -- something went wrong
my errorHandler(theError, theNumber, theOffender)
end try
end perform mail action with messages
end using terms from
(* next, we deal with manual calls to the script, such as from the AppleScript menu *)
on run
set gRunMode to "menu"
set AppleScript's text item delimiters to ""
set theCalendarName to my readPreference(pPrefsFileName, "DefaultCalendar")
set mailCal to my checkForCalendar(theCalendarName) -- look for the target calendar, signal we are called manually
tell application "Mail"
try -- fix a bug that occurs when there is no message viewer visible
if (count of message viewers) is 0 then
set theViewer to make new message viewer at beginning of message viewers
end if
if (count of selected messages of message viewer 1) is 0 then -- there are no target messages. Check if this is intentionally, as to reset the defaults
display alert "No messages selected" message "Please select some messages to export or click 'Reset' to set new defaults" buttons {"Reset", "OK"} default button 2 giving up after 15
copy result as list to {theButton}
if theButton is "Reset" then -- the user wants to set new defaults
set mailCal to my chooseCalendar()
my setDueDate()
end if
else
set allMessages to selected messages of message viewer 1 -- allMessages contains all user-selected messages, which we will next add to the target calendar
set theReply to display dialog "Turn messages into" buttons {"Cancel", "ToDo items", "Events"} default button "Events"
set theButton to button returned of theReply
if theButton is "Events" then
my generateEvents(allMessages, mailCal)
else if theButton is "ToDo items" then
my generateToDos(allMessages, mailCal)
else if theButton is "Cancel" then
return
end if
end if
on error theError number theNumber from theOffender
if theNumber is not -128 then -- clicking Cancel will be repported as an error
my errorHandler(theError, theNumber, theOffender) -- an unexpected error occured, allow user feedback
end if
end try
end tell
end run
(* this handler checks, if there is a default calendar to write events to *)
on checkForCalendar(calendarName)
if calendarName is "" then
set calendarName to my readPreference(pPrefsFileName, "DefaultCalendar")
if calendarName is "" then -- something went wrong, use failsafe
set calendarName to "Mail2iCal"
end if
end if
tell application "iCal"
try
set mailCal to calendar calendarName -- does the calendar still exist?
on error theError number theNumber from theOffender
if theNumber is 1 then -- no calendar with this name, create a new one
if gRunMode is "rule" then -- rule execution does not allow for user interaction, go auto
set mailCal to my createCalendar(calendarName) -- create calendar with default name
else -- we are running manually, ask for a calendar
set mailCal to my chooseCalendar()
end if
else
my errorHandler(theError, theNumber, theOffender) -- some other error occured, handle this
return ""
end if
end try
end tell
return mailCal
end checkForCalendar
(* this handler lets the user choose his default target calendar or asks for the name of a new calendar *)
on chooseCalendar()
tell application "iCal"
set allCals to title of calendars whose writable is true -- get titles of existing calendars
end tell
activate
set theCal to choose from list allCals with prompt "Export to which calendar" default items {"Email"} cancel button name "New" with empty selection allowed without multiple selections allowed
if theCal is false or (count of theCal) is 0 then -- the user clicked "New" or selected none of the existing calendars
display dialog "Name your calendar" default answer "Email" buttons {"Cancel", "OK"} default button 2 -- get the name of the new calendar
copy the result as list to {theName, theButton}
if theButton is not "Cancel" then
set theReply to my writePreference(pPrefsFileName, "DefaultCalendar", theName) -- store the name of the new default calendar
if theReply is -1 then
set theReply to display alert "Error in saving preferences" message "Your new default calendar could not be saved. Reason unknown. I could try to remove the preference file." buttons {"Remove it", "Leave it alone"} default button "Leave it alone" as critical giving up after 10
set theButton to button returned of theReply
if theButton is "Remove it" then
set prefsFile to ((path to preferences folder from user domain as Unicode text) & pPrefsFileName)
tell application "Finder"
delete file prefsFile
end tell
end if
end if
else
return -- user changed his mind halfway
end if
set mailCal to my createCalendar(theName) -- create a new calendar with the desired name
else -- the user selected one of the existing calendars
set theName to item 1 of theCal -- store the name of the new default calendar
set theReply to my writePreference(pPrefsFileName, "DefaultCalendar", theName) -- store the name of the new default calendar
if theReply is -1 then
set theReply to display alert "Error in saving preferences" message "Your new default calendar could not be saved. Reason unknown. I could try to remove the preference file." buttons {"Remove it", "Leave it alone"} default button "Leave it alone" as critical giving up after 10
set theButton to button returned of theReply
if theButton is "Remove it" then
set prefsFile to ((path to preferences folder from user domain as Unicode text) & pPrefsFileName)
try
tell application "Finder"
delete file prefsFile
end tell
end try
end if
end if
tell application "iCal"
set mailCal to calendar theName -- and get a reference to the selected calendar
end tell
end if
return mailCal
end chooseCalendar
(* this handler creates a new calendar in iCal *)
on createCalendar(calendarName)
if calendarName is "" then
set calendarName to "Email"
end if
tell application "iCal"
set mailCal to make new calendar at the end of calendars
tell mailCal
set title to calendarName
end tell
end tell
return mailCal
end createCalendar
(* this handler asks the user for a default due date *)
on setDueDate()
set theDueDate to my readPreference(pPrefsFileName, "DefaultDueDate")
display dialog "Set due date for ToDo items (in hours from arrival of mail)" default answer theDueDate buttons "Set" default button 1
copy result as list to {theText, theButton}
set theReply to writePreference(pPrefsFileName, "DefaultDueDate", (theText as integer))
if theReply is -1 then
set theReply to display alert "Error in saving preferences" message "Your new default due date could not be saved. Reason unknown. I could try to remove the preference file." buttons {"Remove it", "Leave it alone"} default button "Leave it alone" as critical giving up after 10
set theButton to button returned of theReply
if theButton is "Remove it" then
set prefsFile to ((path to preferences folder from user domain as Unicode text) & pPrefsFileName)
tell application "Finder"
delete file prefsFile
end tell
end if
end if
end setDueDate
(* this handler converts the handled messages into calendar events *)
on generateEvents(allMessages, mailCal)
tell application "Mail"
repeat with curMessage in allMessages -- step through all messages
set theSender to sender of curMessage -- get sender of the received message
set senderName to extract name from theSender
set senderAddress to extract address from theSender
set theSubject to subject of curMessage -- get message subject, this will be the events summary
set theBody to content of curMessage -- get message body, this will be the events description
set theDate to date sent of curMessage -- get sent date, this will be the event's start date
if theBody starts with "When: " then (* we're an Exchange Meeting Request *)
if theSubject starts with "Updated:" then
set theSummary to text 10 thru -1 of theSubject
else
set theSummary to theSubject
end if
set theDay to word 3 of paragraph 1 of theBody
set theMonth to word 4 of paragraph 1 of theBody
set theYear to word 5 of paragraph 1 of theBody
set StartHours to (word 6 of paragraph 1 of theBody)
set StartMins to (word 7 of paragraph 1 of theBody)
set EndHours to (word 8 of paragraph 1 of theBody)
set EndMins to (word 9 of paragraph 1 of theBody)
set startDate to text (theMonth & " " & theDay & " " & theYear & " " & StartHours & ":" & StartMins) as date
set endDate to text (theMonth & " " & theDay & " " & theYear & " " & EndHours & ":" & EndMins) as date
if (offset of "Where:" in theBody) > 1 then
set start to the (offset of "Where: " in theBody) + 7
set loc_end to (offset of "*~*~*~*~*~*~*~*~*~*" in theBody) - 3 -- strip the carriage returns
set theLocation to text start thru loc_end of theBody
else
set theLocation to ""
end if
try
set start to the offset of (word 1 in text ((offset of "*~*~*~*~*~*~*~*~*~*" in theBody) + 19) thru -1 of theBody) in theBody
set theDescription to text start thru -1 of theBody
on error
set theDescription to ""
end try
else
set startDate to theDate
set endDate to ((theDate + minutes) as date)
set theDescription to theBody
set theLocation to ""
end if
try
set theURL to first item of my findURLs(theBody)
on error
set theURL to ""
end try
tell application "iCal"
set newEvent to (make new event at the end of events in mailCal)
tell newEvent
set start date to startDate
set end date to endDate
set summary to theSubject
set description to theDescription
set location to theLocation
set url to theURL
-- make new display alarm at the end of display alarms with properties {trigger interval:3 * days / minutes} -- alarm time is in seconds after (positive interval value) or before (negative) event start date
try
set theAttendees to {}
using terms from application "Mail"
set theAttendees to theAttendees & to recipients of curMessage
set theAttendees to theAttendees & cc recipients of curMessage
set theAttendees to theAttendees & bcc recipients of curMessage
using terms from application "iCal"
set newAttendee to make new attendee at the end of attendees in newEvent
tell newAttendee
set display name to senderName
set email to senderAddress
end tell
end using terms from
repeat with curAttendee in theAttendees
set curName to name of curAttendee
set curAddress to address of curAttendee
using terms from application "iCal"
set newAttendee to make new attendee at the end of attendees in newEvent
tell newAttendee
set display name to name of curAttendee -- curName
set email to address of curAttendee --curAddress
end tell
end using terms from
end repeat
end using terms from
end try
end tell
end tell
end repeat
end tell
end generateEvents
(* this handler generates the ToDo items from the handled messages' properties *)
on generateToDos(allMessages, mailCal)
tell application "Mail"
repeat with curMessage in allMessages -- traverse all handed messages
set curText to reply to of curMessage & ", " & subject of curMessage -- sender and subject form the ToDo's summary
set curBody to content of curMessage -- message's body forms the ToDo's description
set theHeaders to all headers of curMessage -- look for additional info in message's headers
set hasPrio to offset of "X-Priority:" in theHeaders -- e.g priority will be converted (kind of, the scales differ massively)
if hasPrio is not 0 then
try
set xPrio to (character (hasPrio + 12) of theHeaders) as integer -- read the priority value from the message
if xPrio is 1 then set calPrio to 1 -- find appropriate iCal priority
if xPrio is 2 then set calPrio to 4
if xPrio is 3 then set calPrio to 0
if xPrio is 4 then set calPrio to 7
if xPrio is 5 then set calPrio to 9
on error
set calPrio to 0
end try
else
set calPrio to 0 -- in iCal, 0 is standard priority
end if
set theDueDate to my readPreference(pPrefsFileName, "DefaultDueDate")
if theDueDate is "" then
set theDueDate to 0
end if
tell application "iCal"
set newTodo to make new todo at the end of todos of mailCal -- create the new ToDo item
tell newTodo -- fill the properties with the extracted information
set summary to curText
set description to curBody
set due date to ((current date) + (theDueDate as integer) * hours)
set priority to calPrio
-- make new display alarm at the end of display alarms with properties {trigger interval:3 * days / minutes} -- alarm time is in seconds after (positive interval value) or before (negative) event start date
end tell
end tell
end repeat
end tell
end generateToDos
(* this handler looks for URLs in the message content and returns them *)
on findURLs(theSource)
set theURLs to {} -- no URLs for starters
set theSource to my unifyWhitespace(theSource) -- get rid of tabs and line feeds
set AppleScript's text item delimiters to "http" -- look for the http signature
set theTokens to text items of theSource
if theSource does not start with "http" then
set theTokens to items 2 thru -1 of theTokens
end if
set AppleScript's text item delimiters to " " -- now, starting from the current http position, select all contiguous text i.e. everything up to the next space
repeat with curToken in theTokens
set theURLs to theURLs & ("http" & first text item of curToken) -- add the http signature since the offset of the found URL starts after the signature
end repeat
set AppleScript's text item delimiters to ""
return theURLs
end findURLs
(* this handler removes usuitable characters from strings. Mainly used to create acceptable calendar names *)
on stripOddChars(theString)
set oddChars to {" "}
set newString to ""
set theChars to characters of theString
repeat with theChar in theChars
if theChar is not in oddChars then
set newString to newString & theChar
end if
end repeat
return newString as string
end stripOddChars
(* this handler transforms whitespace characters such as tabs, spaces and line feeds to single spaces *)
on unifyWhitespace(theSource)
set AppleScript's text item delimiters to "
"
set theTokens to text items of theSource
set AppleScript's text item delimiters to " "
set theSource to theTokens as string
set AppleScript's text item delimiters to " "
set theTokens to text items of theSource
set AppleScript's text item delimiters to " "
set theSource to theTokens as string
set AppleScript's text item delimiters to ""
return theSource
end unifyWhitespace
(* this handler sets the preference theName in the preference file theFile to the value theValue *)
on writePreference(theFile, theName, theValue)
try
if checkForPrefs(theFile) is -1 then
return -1
end if
set thePlistFile to (path to preferences folder from user domain as Unicode text) & theFile
tell application "System Events"
set thePreferenceFile to property list file thePlistFile
set theProperties to contents of thePreferenceFile
set value of property list item theName of theProperties to theValue
end tell
on error
return -1
end try
return 0
end writePreference
(* this handler reads the preference theName from the preference file theFile and returns it as a string*)
on readPreference(theFile, theName)
set theValue to ""
try
if checkForPrefs(theFile) is -1 then
return theValue
end if
set thePlistFile to (path to preferences folder from user domain as Unicode text) & theFile
tell application "System Events"
set thePreferenceFile to property list file thePlistFile
set theProperties to contents of thePreferenceFile
set theValue to value of property list item theName of theProperties
end tell
end try
return theValue
end readPreference
(* this handler checks for the existence of the preferences file and creates one if necessary *)
on checkForPrefs(fileName)
set prefsFilePath to (path to preferences folder from user domain as Unicode text)
tell application "Finder" to set isThere to exists file (prefsFilePath & fileName)
if not (isThere) then
try
-- set sourceFile to ((path to me as Unicode text) & "Contents:Resources:" & pPrefsFileName)
-- tell application "Finder" to duplicate file sourceFile to prefsFilePath
set sourceFile to (path to resource pPrefsFileName)
tell application "Finder" to duplicate sourceFile to prefsFilePath
on error theError number theNumber from theOffender
return -1
end try
end if
return 0
end checkForPrefs
(* this handler asks the user if he wishes to report an error if it occurrs *)
on errorHandler(theError, theNumber, theOffender)
if gRunMode is "rule" then
say "An error occurred. Please run this script manually."
my writeLog(theError)
else
set theReply to display alert "Error " & theNumber & " occurred" message theError as critical buttons {"Report", "OK"} default button "OK" giving up after 15
-- set theReply to display dialog "Error " & theNumber & " occurred: " & theError buttons {"Report", "OK"} default button "OK" giving up after 15
if button returned of theReply is "Report" then
tell application "Mail"
set systemInfo to system info
set theOS to system version of systemInfo
set theCPU to CPU type of systemInfo
set theMem to physical memory of systemInfo
set theReport to make new outgoing message at beginning of outgoing messages with properties {subject:pScriptVersion & " error report", content:"Error message: " & theError & return & "Error number: " & theNumber & return & return & "System information (this may help finding the bug, but please remove it if you feel uncomfortable with sharing this information)" & return & "OS Version: " & theOS & ", CPU: " & theCPU & ", Memory: " & theMem & return & return & "Please describe the actions that resulted in this error:" & return}
tell theReport
set theReceiver to make new to recipient at beginning of to recipients with properties {address:"contact@kleinware.net", name:"KleinWare Contact"}
end tell
set visible of theReport to true
activate
end tell
end if
end if
set AppleScript's text item delimiters to ""
end errorHandler
on writeLog(logEntry)
set theLog to ((path to desktop) as text) & pScriptVersion & " Error Log.txt"
try
open for access file theLog with write permission
write (logEntry & return) to file theLog starting at eof
close access file theLog
on error
try
close access file theLog
end try
end try
end writeLog
