Option Public
Option Declare

%REM
iCalBasic LotusScript library
version 1.0

Copyright (c) 2008 Julian Robichaux, http://www.nsftools.com
This code is licensed under the terms of the MIT License,
shown at the end of this comment section and available at
http://www.opensource.org/licenses/mit-license.php

===============================

Creates a basic iCalendar feed, for import into calendar applications. 
Example usage:

	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim dc As NotesDocumentCollection
	Dim doc As NotesDocument
	
	Dim item As NotesItem
	Dim created As NotesDateTime, modified As NotesDateTime
	Dim startTime As NotesDateTime, endTime As NotesDateTime
	
	Dim calItem As iCalItem
	Dim calFeed As New iCalFeed
	
	Set db = session.CurrentDatabase
	Set dc = db.UnprocessedDocuments
	Set doc = dc.GetFirstDocument()
	
	Do Until (doc Is Nothing)
		Set calItem = New iCalItem
		Call calItem.setUid(doc.Universalid)
		
		Set created = New NotesDateTime(doc.Created)
		Set modified = New NotesDateTime(doc.LastModified)
		Set startTime = New NotesDateTime(doc.GetItemValue("startDate")(0))
		Set endTime = New NotesDateTime(doc.GetItemValue("endDate")(0))
		Call calItem.setTimes(starttime, endtime, created, modified)
		
		Set item = doc.GetFirstItem("Body")
		Call calItem.setContent(doc.Location(0), doc.Subject(0), item.Text)
		
		Call calFeed.addItem(calItem)
		Set doc = dc.GetNextDocument(doc)
	Loop
	
	Dim filePath As String
	Dim fileNum As Integer
	filePath = "c:\temp\icaltest.ics"
	fileNum = FreeFile()
	
	Open filePath For Output As fileNum%
	Print #fileNum, calFeed.toString()
	Close fileNum

===============================

Copyright (c) 2008 Julian Robichaux (http://www.nsftools.com)

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

%END REM



'/**
' *  iCalItem represents a single iCalendar event that can be added 
' *  to an iCalendar feed. The only thing you HAVE to do is set times, 
' *  although it's always nice to have at least a description too. 
' *  See the comments on the various "set" methods for more info 
' *  on the different types of content you can add.
' *  <p>
' *  Note that this does not come close to supporting every single 
' *  thing that iCalendar can do; it is just a simple class for 
' *  generating an iCalendar appointment that should be importable 
' *  by most iCalendar applications.
' */
Class iCalItem
	crlf As String			'** always Chr(13)+Chr(10)
	uid As String			'** unique identifier
	dtStart As NotesDateTime
	dtEnd As NotesDateTime
	dtCreated As NotesDateTime
	dtModified As NotesDateTime
	allDayEvent As Boolean
	location As String
	summary As String
	description As String	'** no HTML, text only
	htmlDescription As String	
	organizer As String		'** only for "group" activities, not single-user events
	categories As String	'** comma-separated values
	classType As String		'** PUBLIC or PRIVATE
	sequence As Integer	'** zero or higher (just use zero)
	
	
	Public Sub New ()
		crlf = Chr(13) + Chr(10)
		classType = "PUBLIC"
		uid = Mid$(CStr(Rnd), 3)
	End Sub
	
	
	'/**
	' *  REQUIRED: Unique identifier for this entry. In Notes, this is 
	' *  normally a document UNID if there is an actual document 
	' *  associated with this event. This value is used not only 
	' *  to uniquely identify an event, but also for matching up 
	' *  an event that needs to be modified or deleted. It is also 
	' *  important for recurring events, which we don't deal with here.
	' */
	Public Sub setUid (uid As String)
		Me.uid = uid
	End Sub
	
	
	Public Function getUid () As String
		getUid = Me.uid
	End Function
	
	
	'/**
	' *  REQUIRED: Set all of these times. Start and end time are the 
	' *  start and end of the event itself. Created is when the event 
	' *  was originally created (either "now", or the doc.created date of 
	' *  a Notes document this came from). Modified is when the event 
	' *  was last updated (either "now", or the doc.lastModified date of 
	' *  a Notes document this came from).
	' *  <p>
	' *  For an all-day or a multi-day event, set the startTime as the 
	' *  first day of the event and the endTime as the day AFTER(!) the 
	' *  day the event ends; then be sure to call the setAllDay() method.
	' *  <p> 
	' *  Note that the date values are copied into the iCalItem object, 
	' *  not referenced.
	' */
	Public Sub setTimes (startTime As NotesDateTime, endTime As NotesDateTime, _
	createDate As NotesDateTime, lastModified As NotesDateTime)
		Set Me.dtStart = New NotesDateTime(startTime.Lslocaltime)
		Set Me.dtEnd = New NotesDateTime(endTime.Lslocaltime)
		Set Me.dtCreated = New NotesDateTime(createDate.Lslocaltime)
		Set Me.dtModified = New NotesDateTime(lastModified.Lslocaltime)
	End Sub
	
	
	'/**
	' *  Set this as an "all day" event, either a single day or multiple 
	' *  days. Remember that iCalendar applications seem to require that 
	' *  the end date for an all-day or multi-day event should be 
	' *  the day AFTER the event ends -- so, if you have a three day 
	' *  event, the end date is three days after the start date, not two.
	' */
	Public Sub setAllDay ()
		Me.allDayEvent = True
	End Sub
	
	
	'/**
	' *  OPTIONAL BUT RECOMMENDED: These are strings that describe the 
	' *  calendar event. For maximum compatibility they should be plain 
	' *  text, not HTML.
	' */
	Public Sub setContent (location As String, summary As String, description As String)
		Me.location = location
		Me.summary = summary
		Me.description = description
	End Sub
	
	
	'/**
	' *  OPTIONAL: An HTML description of the event. This should be 
	' *  formatted like a full web page (i.e. starts with <html>, has 
	' *  a <head> and <body> section, ends with a closing </html> tag). 
	' *  No guaranteed compatibility with all mail/calendar systems -- for 
	' *  example, Lotus Notes seems to ignore this -- so make sure you 
	' *  also have a plain-text description from setContent() 
	' *  to fall back on.
	' */
	Public Sub setHtmlContent (html As String)
		me.htmlDescription = html
	End Sub
	
	
	'/**
	' *  OPTIONAL, NOT NORMALLY REQUIRED: This is for "group" events 
	' *  like meetings, where there is a chair/organizer who controls 
	' *  the event. For single-user calendar entries (reminders, 
	' *  appointments, etc.) don't set this property.
	' */
	Public Sub setOrganizer (commonName As String, internetEmail As String)
		Me.organizer = |CN="| + commonName + |":mailto:| + internetEmail
	End Sub
	
	
	'/**
	' *  OPTIONAL: A comma-separated string indicating the category 
	' *  labels to be used for this event (i.e. "BIRTHDAY,FAMILY").
	' */
	Public Sub setCategories (categories As String)
		Me.categories = categories
	End Sub
	
	
	'/**
	' *  OPTIONAL: Mark this as a "private" event rather than a "public" one.
	' */
	Public Sub setPrivate ()
		classType = "PRIVATE"
	End Sub
	
	
	'/**
	' *  OPTIONAL: For new or unchanged events, this is zero (the default). 
	' *  For updated events, this is greater than zero. You are responsible 
	' *  for keeping the number of changes and the sequence number in sync.
	' */
	Public Sub setSequence (sequence As Integer)
		Me.sequence = sequence
	End Sub
	
	
	'/**
	' *  Output this event as an iCalendar-formatted entry, to be included 
	' *  in a full iCalendar feed. Note that if you are only creating a single 
	' *  event, you still need to wrap this in a full iCalendar feed.
	' */
	Public Function toString () As String
		Dim s As String
		
		s = s + |BEGIN:VEVENT| + crlf							'** REQUIRED
		s = s + |UID:| + escapeLine(me.uid) + crlf				'** REQUIRED
		s = s + |DTSTAMP:| + dateToString(me.dtCreated) + crlf	'** REQUIRED
		s = s + |LAST-MODIFIED:| + dateToString(me.dtModified) + crlf
		
		If (me.allDayEvent = True) Then
			s = s + |DTSTART;VALUE=DATE:| + StrLeft(dateToString(me.dtStart), "T") + crlf
			s = s + |DTEND;VALUE=DATE:| + StrLeft(dateToString(me.dtEnd), "T") + crlf
		Else
			s = s + |DTSTART:| + dateToString(me.dtStart) + crlf
			s = s + |DTEND:| + dateToString(me.dtEnd) + crlf
		End If
		
		s = s + |SEQUENCE:| + CStr(me.sequence) + crlf
		s = s + |CLASS:| + me.classType + crlf
		
		If (me.location <> "") Then s = s + |LOCATION:| + escapeLine(me.location) + crlf
		If (me.summary <> "") Then s = s + |SUMMARY:| + escapeLine(me.summary) + crlf
		If (me.description <> "") Then s = s + |DESCRIPTION:| + escapeLine(me.description) + crlf
		If (me.organizer <> "") Then s = s + |ORGANIZER;| + escapeLine(organizer) + crlf		'** the semi-colon is not a mistake
		If (me.categories <> "") Then s = s + |CATEGORIES:| + escapeLine(me.categories) + crlf
		
		If (me.htmlDescription <> "") Then s = s + |X-ALT-DESC;FMTTYPE=text/html:| + escapeLine(me.htmlDescription) + crlf
		
		s = s + |END:VEVENT| + crlf
		
		toString = s
	End Function
	
	
	'/**
	' *  Utility function for converting a NotesDateTime value to 
	' *  the date format that iCalendar likes.
	' */
	Public Function dateToString (dt As NotesDateTime) As String
		If Not (dt Is Nothing) Then
			dateToString = Format$(dt.Lsgmttime, "yyyymmddThhnnssZ")
		End If
	End Function
	
	
	'/**
	' *  Utility function for escaping characters and splitting long 
	' *  lines into the multi-line format that iCalendar likes.
	' */
	Public Function escapeLine (ByVal s As String) As String
		s = Replace(s, "\", "\\")
		s = Replace(s, ";", "\;")
		s = Replace(s, ",", "\,")
		s = Replace(s, crlf, "\n")
		s = Replace(s, Chr(10), "\n")
		s = Replace(s, Chr(13), "\n")
		
		Dim returnString As String
		While (Len(s) > 75)
			returnString = returnString + Left(s, 75) + crlf + " "
			s = Mid$(s, 76)
		Wend
		returnString = returnString + s
		
		escapeLine = returnString
	End Function
End Class



'/**
' *  iCalFeed is an object that can be used to create an iCalendar feed 
' *  with one or more iCalItem events. Note that if you are only creating 
' *  a single event, you still need to wrap it in a full iCalendar feed.
' */
Class iCalFeed
	items List As iCalItem
	prodID As String	'** name of the product that generated this feed
	version As String	'** pretty much always "2.0" right now
	scale As String		'** always "GREGORIAN"
	method As String	'** always "PUBLISH" for our purposes
	crlf As String		'** always Chr(13)+Chr(10)
		
	
	Public Sub New ()
		Dim session As New NotesSession
		crlf = Chr(13) + Chr(10)
		
		'** the RFC doesn't specify a prodID format, but it seems 
		'** to always be a format like: -//Company//Product//EN
		prodID = |-//Custom iCal//IBM Lotus Notes | + _
		StrLeft(session.Notesversion, "|") + |//EN|
		
		version = "2.0"
		scale = "GREGORIAN"
		method = "PUBLISH"
	End Sub
	
	
	'/**
	' *  Add an iCalItem to this feed.
	' */
	Public Sub addItem (item As iCalItem)
		Set items( item.getUid ) = item
	End Sub
	
	
	'/**
	' *  Output a full iCalendar feed, including all iCalItems that 
	' *  have been added.
	' *  <p>
	' *  IMPORTANT NOTE: the iCalendar standard indicates that the 
	' *  encoding should be (but doesn't specifically have to be) UTF-8. 
	' *  The Lotus Notes client seems to use the platform character set 
	' *  to determine encoding, in my limited tests. Apple iCal didn't 
	' *  seem to care either. So you probably don't have to worry about 
	' *  the output encoding of this string.
	' *  <p>
	' *  However, if you want to force UTF-8 output from agents, you can 
	' *  specify a character set in the Open command when you create a file. 
	' *  For web output from an agent, try:
	' *  <p>
	' *  Print "Content-type: text/calendar;charset=utf-8"
	' *  Print ""
	' *  Print myICalFeed.toString()
	' */
	Public Function toString () As String
		Dim s As String
		Dim formatter As New iCalItem()
		
		s = s + |BEGIN:VCALENDAR| + crlf
		s = s + |PRODID:| + formatter.escapeLine(me.prodID) + crlf
		s = s + |VERSION:| + me.version + crlf
		s = s + |CALSCALE:| + me.scale + crlf
		s = s + |METHOD:| + me.method + crlf
		
		ForAll item In items
			s = s + item.toString()
		End ForAll
		
		s = s + |END:VCALENDAR| + crlf
		
		toString = s
	End Function
End Class