Mail Rule - AutoFile messages

Sorry had taken copy of DevonThink Pro’s Mail Rule and Just started editing so the headers had copy right as all rights reserved.


-- Mail Rule - AutoFile messages
-- Created by Devang Bhatt on Fri February 14 2014.
-- No Strings Attached License

(*

PURPOSE: Integrate Contacts with Emails

Plan for Contacts Management: Store iPhone contacts on iCloud, and Store Contacts used for Email filing on Mac Server / Local Computer

Check if it is a message from me or my managers
	If it is then get the first TO, CC or BCC recipient name and email details who is not me or my managers and process further.

Check if the email address belongs to anyone in our Contacts
	Check if it is the email address registered to a company
		For this to work the company card should exist in our address book with work url set to domain name without http://
		If the Company does not have a domain but uses one single email address that email address should be in company's list of emails
		If the senders mailbox exists within the Company Mailbox then use that.
		Else irrespective of the sender the mail is filed to the Company Mailbox
	
	Check if Sender exists in Contacts
		Check if the sender's company is set in contact card and company mailbox exists
			If the sender's email is work email and company is set then try to file by that company name (Currently is in reverse)
	

	Check if the sender's full display name mailbox exists
		If the sender's email is any other type of email then try to file by that sender's full display name
	
Check if the domain mailbox exists

Check if the Email Display Named Mailbox exists

Check if the Email's Username Mailbox exists

Check if the Full Email mailbox exists

If No folder exists and Option_No_Folder_Folder is defined move the message there.


WIP: 
	Need to cache mailboxes for faster processing.				DONE.
	Need to cache contact lookups for faster processing.
	Need to sort by from for faster processing.
	
*)




tell application "Mail"
	--set myMessages to messages of mailbox "AutoFile"
	--set myMessages to visible messages of message viewer 1
	set myMessages to selected messages of message viewer 1
	tell me to perform mail action with messages myMessages for rule "Mail Rule - AutoFile Messages"
end tell


using terms from application "Mail"
	on perform mail action with messages theMessages for rule theRule
		
		tell application "Mail"
			
			
			set Option_File_Sent_Messages_By_To to true -- File my Messages and my Managers Messages in the Mailbox of the person who is addressed to 
			
			set Option_File_By_Contact_Name to true -- Required for Enabling Integration with Mac OS X Address Book - AKA Contacts
			
			
			-- Options for Generic Filing.
			set Option_File_By_Display_Name to false -- Someone <s@where.com> -> Someone
			set Option_File_By_Domain_Name to false -- UserName@Email.co.in -> Email
			set Option_File_By_User_Name to false -- UserName@Email.com -> UserName
			
			
			-- WIP Start
			
			-- Sort by senders domain name if it is a company domain, even if senders folder is existing
			-- Set Company's work url to domain from emails, this is because some companies have different email and web domains
			set Option_File_By_CompanyDomain to true
			
			-- Sort my bosses emails with the person they are replying to
			set Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox to my GetMyManagersEmailAddresses()
			
			-- WIP END
			
			set Option_File_Multi_To_Recipients_By_First_To_Recipient_Only to true -- false is not supported since it will result to duplicates
			
			set Option_My_Contact_Card_Emails to my GetMyEmailAddresses() as string
			
			set Option_No_Folder_Folder to missing value -- (get mailbox "ZZZ-No Folders") -- to missing value
			
			-- Reset the Cache of MailBoxes
			set ListOfAllMailBoxes to {}
			set ListOfAllMailBoxNames to {}
			
			
			repeat with theMessage in theMessages -- Iteriate over the messages
				set bMoved to false
				
				if the account of mailbox of theMessage is missing value then -- If the message is not in an IMAP MailBox then
					try
						set OldDelimiters to AppleScript's text item delimiters
						set theEmail to missing value
						
						set theSender to sender of theMessage
						
						try
							set AppleScript's text item delimiters to {"<", ">"}
							set theName to my TrimText(the first text item of theSender)
							set theEmail to my ChangeToLowerCase(my TrimText(the second text item of theSender))
							set theContactName to my GetContactNameFromEmailAddress(theEmail)
							set AppleScript's text item delimiters to OldDelimiters
						on error
							set theName to theSender
							set theEmail to my ChangeToLowerCase(theSender) as string
							set theContactName to my GetContactNameFromEmailAddress(theEmail)
							set AppleScript's text item delimiters to OldDelimiters
						end try
						
						-- First Check If it is a message that I sent.
						-- Then change the Generic Sender's Details to Recipient's Details
						if ((Option_File_Sent_Messages_By_To is equal to true) and (Option_My_Contact_Card_Emails contains theEmail)) then
							set theRecipients to every to recipient of theMessage
							if (count of theRecipients) is equal to 0 then
								set theRecipients to every cc recipient of theMessage
							end if
							if (count of theRecipients) is equal to 1 then
								try
									set theNameOfRecipient to name of the first item of theRecipients as string
									set theName to my TrimText(name of the first item of theRecipients as string)
									set theEmail to my ChangeToLowerCase(my TrimText(address of the first item of theRecipients as string))
									set theContactName to my GetContactNameFromEmailAddress(theEmail)
								end try
							else if Option_File_Multi_To_Recipients_By_First_To_Recipient_Only is equal to true then
								repeat with theRecipient in theRecipients
									set CheckRecipientAddress to the address of theRecipient as string
									if Option_My_Contact_Card_Emails does not contain theEmail then -- Ignore my emails to myself
										if (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is missing value) or ((Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is not missing value) and (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox does not contain CheckRecipientAddress)) then -- Ignore my emails to my boss
											try
												set theNameOfRecipient to name of theRecipient as string
												set theName to my TrimText(name of theRecipient as string)
												set theEmail to my ChangeToLowerCase(my TrimText(address of theRecipient as string))
												set theContactName to my GetContactNameFromEmailAddress(theEmail)
												exit repeat
											end try
										end if
									end if
								end repeat
							else
								-- probably draft message 
							end if
						end if
						
						-- Second Check If it is a message that my Boss sent.
						-- Then change the Generic Sender's Details to Recipient's Details
						if (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is not missing value) and (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox contains theEmail) then
							set theRecipients to every to recipient of theMessage
							if (count of theRecipients) is equal to 0 then
								set theRecipients to every cc recipient of theMessage
							end if
							if (count of theRecipients) is equal to 1 then
								try
									set theNameOfRecipient to name of the first item of theRecipients as string
									set theName to TrimText(name of the first item of theRecipients as string)
									set theEmail to ChangeToLowerCase(TrimText(address of the first item of theRecipients as string))
									set theContactName to GetContactNameFromEmailAddress(theEmail)
								end try
							else if Option_File_Multi_To_Recipients_By_First_To_Recipient_Only is equal to true then
								
								repeat with theRecipient in theRecipients
									set CheckRecipientAddress to the address of theRecipient as string
									
									if (Option_My_Contact_Card_Emails does not contain theEmail) then -- It wasnt me.. ;-)
										if (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is missing value) or ((Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is not missing value) and (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox does not contain CheckRecipientAddress)) then
											try
												set theNameOfRecipient to name of theRecipient as string
												set theName to my TrimText(name of theRecipient as string)
												set theEmail to my ChangeToLowerCase(my TrimText(address of theRecipient as string))
												set theContactName to my GetContactNameFromEmailAddress(theEmail)
												exit repeat
											end try
										end if
									end if
								end repeat
							else
								-- probably corroupted message leave it for manually filing
							end if
							
						end if
						
						--display dialog theName & "<" & theEmail & ">" & " - " & theContactName
						try
							set AppleScript's text item delimiters to {"@"}
							set theUsername to text item 1 of theEmail as string
							set theFullDomain to text item 2 of theEmail as string
							set theDomain to my GetOnlyDomainName(theFullDomain) as string
							
							set AppleScript's text item delimiters to OldDelimiters
						on error
							set AppleScript's text item delimiters to OldDelimiters
						end try
						
						set targetFolder to missing value
						
						if Option_File_By_CompanyDomain is equal to true then
							-- Check if the Email is comming from an Official domain of a Company
							set theSenderCompany to my TrimText(my GetCompanyNameFromDomain(theFullDomain))
							set targetFolder to my FindMailBox(theSenderCompany)
						end if
						
						-- First Try to find folder by sender's full contact name
						if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Contact_Name is equal to true)) then
							try
								if theContactName is not equal to "" or theContactName is not missing value or theContactName is not null then
									set targetFolder to my FindMailBox(theContactName)
								end if
							end try
						end if
						
						if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Contact_Name is equal to true)) then
							try
								if theContactName is not equal to "" and (theContactName is not missing value or theContactName is not null) then
									-- Check if the ContactName has Company Details and if the MailBox exists
									set theSenderCompany to my GetContactCompanyNameFromPersonName(theContactName)
									set targetFolder to my FindMailBox(theSenderCompany)
								end if
							end try
						end if
						
						-- display dialog name of targetFolder as string
						-- display dialog theContactName
						
						-- Next try to find folder by sender's full display name
						if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Display_Name is equal to true)) then
							try
								set targetFolder to my FindMailBox(theName)
							end try
						end if
						
						-- Next try to find folder by domain name without .com etc
						if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Domain_Name is equal to true)) then
							try
								set targetFolder to my FindMailBox(theDomain)
							end try
						end if
						
						-- Next try to find folder by sender's username i.e. email front portion
						if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_User_Name is equal to true)) then
							try
								set targetFolder to my FindMailBox(theUsername)
							end try
						end if
						
						try
							if (targetFolder is not missing value and targetFolder is not null) then
								if the (count of theMessages) is equal to 1 then
									
									display dialog "Move to folder? " & my GetImapMailBoxPathFromFolder(targetFolder, "/")
									if the button returned of the result is equal to "Ok" then
										move theMessage to targetFolder
										set bMoved to true
									end if
								else
									move theMessage to targetFolder
								end if
							else if Option_No_Folder_Folder is not null or Option_No_Folder_Folder is not missing value then
								move theMessage to Option_No_Folder_Folder
								set bMoved to true
							else
								if theContactName is not "" or theContactName is not missing value or theContactName is not null then
									log ("No Folder for: " & theContactName)
								end if
							end if
						end try
						
						if ((bMoved is false) and ((count of theMessages) is equal to 1)) then
							-- Not Moved - Show help
							display dialog "Please create a contact called '" & theName & "' OR by the name of the folder in which you want to move this message AND assign it work email as '" & theEmail & "' OR work url as '" & theFullDomain & "'."
						end if
						
					on error errMsg
						if (count of theMessages) is equal to 1 then
							display dialog "Main Try Errored: " & errMsg
						end if
					end try
				end if
			end repeat
			
		end tell
		
	end perform mail action with messages
end using terms from

-- Functions ---

property ListOfAllMailBoxes : {}
property ListOfAllMailBoxNames : {}



on FindMailBox(strName)
	tell application "Mail"
		set strName to my FormatMailBoxName(my TrimText(my ChangeToLowerCase(strName)))
		
		--or (count of (get mailboxes)) is not equal to LastCountOfMailBoxes
		if (my ListOfAllMailBoxes is {} or my ListOfAllMailBoxNames is {}) then
			set my ListOfAllMailBoxes to every item in (get mailboxes)
			repeat with i from 1 to count of my ListOfAllMailBoxes
				copy (my FormatMailBoxName(my ChangeToLowerCase(name of (item i of my ListOfAllMailBoxes) as string))) to the end of the my ListOfAllMailBoxNames
			end repeat
			-- display dialog "Got List of Mail Boxes!"
		end if
		
		repeat with i from 1 to count of my ListOfAllMailBoxNames
			set theMailBoxNameCheck to item i of my ListOfAllMailBoxNames
			if theMailBoxNameCheck is equal to strName then
				if my FormatMailBoxName(my ChangeToLowerCase(the (name of item i of my ListOfAllMailBoxes) as string)) is equal to strName then
					return (item i of my ListOfAllMailBoxes)
				else
					return null
				end if
			end if
		end repeat
		
		return null
	end tell
end FindMailBox

property Option_Replace_Folder_Name_Content_With_Space : {".", "-", "_"}
property Option_Ignore_Folder_Name_Content_Between : {"[", "]"} -- Should be in Pairs of Open Tag Character and Close Tag Characters

on FormatMailBoxName(theMailBoxName)
	
	set strReturn to theMailBoxName
	-- Replace each character in Option_Replace_Folder_Name_Content_With_Space with space i.e. replace . - and _ with space
	repeat with TextItem from 1 to count of my Option_Replace_Folder_Name_Content_With_Space
		set strReturn to my ReplaceText(strReturn, item TextItem of my Option_Replace_Folder_Name_Content_With_Space as string, " ")
	end repeat
	
	-- Ignore Content Between Defined Characters i.e. Company Name [Person Name] or Person Name [Company Name]
	-- The text between [] is ignored
	repeat with TextItem from 1 to count of my Option_Ignore_Folder_Name_Content_Between
		if TextItem mod 2 is equal to 1 then
			set strReturn to my Delete_Text_Between_Chars(strReturn, item TextItem of my Option_Ignore_Folder_Name_Content_Between, item (TextItem + 1) of my Option_Ignore_Folder_Name_Content_Between)
		end if
	end repeat
	
	set strReturn to my ReplaceText(strReturn, "  ", " ")
	
	return my TrimText(strReturn) as string
end FormatMailBoxName

on Delete_Text_Between_Chars(SourceText, StartingChar, EndingChar)
	set Clean_Text to ""
	set Copy_Flag to true
	repeat with this_char in SourceText
		set this_char to the contents of this_char
		if this_char is StartingChar then
			set the Copy_Flag to false
		else if this_char is EndingChar then
			set the Copy_Flag to true
		else if the Copy_Flag is true then
			set the Clean_Text to the Clean_Text & this_char as string
		end if
	end repeat
	return Clean_Text
end Delete_Text_Between_Chars

on GetOnlyDomainName(strFullDomain)
	if strFullDomain contains "." then
		set OldDelimiters to AppleScript's text item delimiters
		set AppleScript's text item delimiters to {"."}
		set strReturn to missing value
		set Counter to 1
		try
			repeat
				set strReturn to text item Counter of strFullDomain
				if strReturn is equal to "" then
					exit repeat
				end if
				set Counter to Counter + 1
			end repeat
		on error
			set strReturn to text item (Counter - 2) of strFullDomain
			if strReturn is equal to "co" or strReturn is equal to "com" then
				set strReturn to text item (Counter - 3) of strFullDomain
			end if
		end try
		set AppleScript's text item delimiters to OldDelimiters
		return strReturn
	else
		return strFullDomain
	end if
end GetOnlyDomainName

on GetOnlyFolderName(strFolderHirerkey)
	if strFolderHirerkey contains "/" then
		set OldDelimiters to AppleScript's text item delimiters
		set AppleScript's text item delimiters to {"/"}
		set strReturn to missing value
		set Counter to 1
		try
			repeat
				set strReturn to text item Counter of strFolderHirerkey
				if strReturn is equal to "" then
					exit repeat
				end if
				set Counter to Counter + 1
			end repeat
		on error
			set strReturn to text item (Counter - 1) of strFolderHirerkey
		end try
		set AppleScript's text item delimiters to OldDelimiters
		return strReturn
	else
		return strFolderHirerkey
	end if
end GetOnlyFolderName

on GetImapMailBoxPathFromFolder(theMailBox, theDelimiter)
	if theDelimiter is null or theDelimiter is missing value then
		set theDelimiter to "/"
	end if
	tell application "Mail"
		set fldContainer to theMailBox
		set strReturn to name of the fldContainer
		try
			repeat
				set fldContainer to container of fldContainer
				set strReturn to name of the fldContainer & theDelimiter & strReturn
			end repeat
		end try
		return strReturn
	end tell
end GetImapMailBoxPathFromFolder

on ChangeToLowerCase(|SourceText|)
	set CharList to id of |SourceText|
	repeat with i from 1 to the count of CharList
		if item i of CharList > 64 and item i of CharList < 91 then
			set item i of CharList to ((item i of CharList) + 32)
		end if
	end repeat
	return (string id CharList) as text
end ChangeToLowerCase

on GetMyManagersEmailAddresses()
	set strReturn to ""
	using terms from application "Contacts"
		tell application "Contacts"
			set MyCard to get my card
			set MyRelations to related names of MyCard
			repeat with thisRelation in MyRelations
				if label of thisRelation as string is equal to "manager" then
					set ManagerCards to (people whose name contains (value of thisRelation as string))
					set theManager to item 1 of ManagerCards
					-- repeat with theManager in ManagerCards  -- Not repeating since it gets wife's email addresses also
					set theManagersEmails to get emails of theManager
					repeat with theEmail in theManagersEmails
						set strReturn to strReturn & "," & value of theEmail as string
					end repeat
					-- end repeat
				end if
			end repeat
			return text 2 thru -1 of strReturn
		end tell
	end using terms from
end GetMyManagersEmailAddresses

on GetMyEmailAddresses()
	using terms from application "Contacts"
		tell application "Contacts"
			set MyCard to my card
			set Option_My_Contact_Card_Emails to ""
			set MyEmails to (email of MyCard)
			repeat with theEmail from 1 to count of MyEmails
				set Option_My_Contact_Card_Emails to Option_My_Contact_Card_Emails & "," & (value of item theEmail of MyEmails) as text
			end repeat
			return text 2 thru (length of Option_My_Contact_Card_Emails) of Option_My_Contact_Card_Emails
		end tell
	end using terms from
end GetMyEmailAddresses

on GetContactNameFromEmailAddress(|theEmailAddress|)
	using terms from application "Contacts"
		tell application "Contacts"
			set ListOfPeople to {}
			set ListOfPeople to name of people whose value of emails contains |theEmailAddress|
			
			--display dialog (emailAddress & ": " & (count of ListOfPeople))
			
			if ListOfPeople is not {} then
				set RetVar to " " & item 1 of ListOfPeople
				
				set RetVar to my ReplaceText(RetVar, " Mr. ", "")
				set RetVar to my ReplaceText(RetVar, " Mr ", "")
				set RetVar to my ReplaceText(RetVar, " Mrs. ", "")
				set RetVar to my ReplaceText(RetVar, " Mrs ", "")
				set RetVar to my ReplaceText(RetVar, " Miss. ", "")
				set RetVar to my ReplaceText(RetVar, " Miss ", "")
				
				set RetVar to my ReplaceText(RetVar, " Ms. ", "")
				set RetVar to my ReplaceText(RetVar, " Ms ", "")
				
				set RetVar to my ReplaceText(RetVar, " Dr. ", "")
				set RetVar to my ReplaceText(RetVar, " Dr ", "")
				
				set RetVar to my ReplaceText(RetVar, " Late Shri ", "")
				set RetVar to my ReplaceText(RetVar, " Late Shree ", "")
				
				return my TrimText(RetVar)
			else
				return ""
			end if
		end tell
	end using terms from
end GetContactNameFromEmailAddress

on GetCompanyNameFromDomain(|theDomain|)
	using terms from application "Contacts"
		tell application "Contacts"
			set ListOfCompanies to {}
			set ListOfCompanies to people whose value of urls contains |theDomain| and company is true
			
			if ListOfCompanies is not {} then
				repeat with theCompany in ListOfCompanies
					set ListOfURLs to urls of theCompany
					repeat with theUrl in ListOfURLs
						if |theDomain| is equal to value of theUrl and label of theUrl is equal to "work" then
							-- display dialog label of theUrl & ": " & value of theUrl
							return my TrimText(name of theCompany)
						end if
					end repeat
				end repeat
			else
				return ""
			end if
		end tell
	end using terms from
end GetCompanyNameFromDomain
on TrimText(|SourceText|)
	repeat until |SourceText| does not start with " "
		set |SourceText| to text 2 thru -1 of |SourceText|
	end repeat
	
	repeat until |SourceText| does not end with " "
		set |SourceText| to text 1 thru -2 of |SourceText|
	end repeat
	
	return |SourceText|
end TrimText

to ReplaceText(|SourceText|, |SearchText|, |ReplacemetText|)
	set {DTID, AppleScript's text item delimiters} to {AppleScript's text item delimiters, |SearchText|}
	try
		set {TextItems, AppleScript's text item delimiters} to {every text item of |SourceText|, |ReplacemetText|}
		set {|SourceText|, AppleScript's text item delimiters} to {TextItems as text, DTID}
	on error errorMessage number errorNumber -- oops
		set AppleScript's text item delimiters to DTID
		error errorMessage number errorNumber -- pass it on
	end try
	return |SourceText|
end ReplaceText