'Create RSS Feed: 

Option Public
Option Explicit



Sub Initialize
	'** Create an RSS feed containing the Lotusphere sessions.
	'** If you've marked any sessions with a primary or alternate
	'** interest (in the "Session Interest" view, you can also choose
	'** to just export the sessions that you (or someone else) is
	'** interested in.
	'** This contains almost all the session-related information in each 
	'** entry, so if you dump all the sessions you'll have a pretty
	'** "heavyweight" feed. Just so you know...
	On Error Goto processError
	
	Dim categoryViewName As String
	categoryViewName = "Session Interest\By Day and Time"
	
	'** figure out which category to export (if there's more than one)
	Dim workspace As New NotesUIWorkspace
	Dim catList As Variant
	Dim category As String
	Dim dbColumn As String
	dbColumn = |@Unique(@DbColumn(""; ""; "| & ReplaceSubstring(categoryViewName, "\", "\\") & |"; 1))|
	catList = Evaluate( dbColumn )
	
	If (Ubound(catList) > 0) Then
		category = workspace.Prompt(PROMPT_OKCANCELLIST, "Choose A Category", _
		"Please choose the category of sessions you would like to export to RSS:", _
		catList(Ubound(catList)), catList)
	Else
		category = catList(0)
	End If
	
	If (category = "") Then
		Exit Sub
	End If
	
	'** prompt for a file name
	Dim fileName As String
	Dim fileNum As Integer
	Dim fileArray As Variant
	fileArray = workspace.SaveFileDialog(False, "Export File Name", "RSS Files|*.rss", "", "LSSessions.rss")
	
	If Isempty(fileArray) Then
		Exit Sub
	Else
		fileName = fileArray(0)
	End If
	
	'** open the categorized view and the file, and start exporting
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim doc As NotesDocument
	Dim view As NotesView
	Dim crlf As String
	Dim desc As String
	Dim speakers As Variant
	Dim dateTime As String
	Dim lastDateTime As String
	Dim gotItems As Integer
	
	Set db = session.CurrentDatabase
	Set view = db.GetView(categoryViewName)
	Set doc = view.GetDocumentByKey(category)
	
	crlf = Chr(13) & Chr(10)
	lastDateTime = "This is a bogus value"
	
	fileNum = Freefile()
	Open fileName For Output As fileNum
	Print #fileNum, GetRSSHeader("Lotusphere Sessions: " & category)
	
	'** here's a little trick to figure out when we've hit the next category
	Dim nextCatDoc As NotesDocument
	Dim idx As Variant
	idx = Arraygetindex(catList, category)
	If (idx < Ubound(catList)) Then
		Set nextCatDoc = view.GetDocumentByKey(catList(idx+1))
	End If
	
	Do Until (doc Is nextCatDoc)
		speakers = Evaluate(|@Implode(Speaker; ", ")|, doc)
		desc = "<b>" & doc.SessionTitle(0) & "</b><br>" & crlf & _
		"Speaker: " & speakers(0) & "<br>" & crlf & _
		doc.SessionID(0) & " - " & doc.SessionDate(0) & "  " & doc.SessionTime(0) & "<p>" & crlf & _
		"<blockquote>" & doc.SessionAbstract(0) & "</blockquote><p>" & crlf
		
		'** hack to make &lt; and &gt; references work in many feedreaders
		desc = ReplaceSubstring(desc, "&lt;", "&amp;lt;")
		desc = ReplaceSubstring(desc, "&gt;", "&amp;gt;")
		
		'** we're going to cram all the sessions for a common day and time into one entry,
		'** to try to keep things under control
		dateTime = GetDateTime(doc)
		If (dateTime = lastDateTime) Then
			'** same as before, so just append the description
			Print #fileNum, "<hr>"
			Print #fileNum, desc
		Else
			'** close the previous item (if any) and start a new one
			If gotItems Then
				Print #fileNum, "]]></description>"
				Print #fileNum, "	</item>"
				Print #fileNum, ""
			End If
			
			Print #fileNum, "	<item>"
			Print #fileNum, "		<pubDate>" & dateTime & "</pubDate>"
			Print #fileNum, "		<title>" & doc.SessionDate(0) & ", " & doc.SessionTime(0) & "</title>"
			'** add a <p> at the start of the CDATA block for stupid newsreaders that don't recognize
			'** CDATA blocks
			Print #fileNum, "		<description><![CDATA[<p>" & desc
			
			gotItems = True
			lastDateTime = dateTime
		End If
		
		Set doc = view.GetNextDocument(doc)
	Loop
	
	'** when we're all done, close out the file
	If gotItems Then
		Print #fileNum, "]]></description>"
		Print #fileNum, "	</item>"
		Print #fileNum, ""
	End If
	
	Print #fileNum, "</channel>"
	Print #fileNum, "</rss>"
	Close fileNum
	
	Print "Finished writing information to " & fileName
	Exit Sub
	
processError:
	Dim errMsg As String
	errMsg = "Oops! We got an error " & Err & " at line " & Erl & ": " & Error$
	Messagebox errMsg
	Print errMsg
	Reset
	Exit Sub
	
End Sub


Function GetRSSHeader (title As String) As String
	Dim header As String
	Dim timeNow As New NotesDateTime(Now)
	
	header = |<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="0.92">
<channel>
	<language>en-us</language>
	<lastBuildDate>| & Format(timeNow.LSGMTTime, "ddd, dd mmm yyyy hh:mm:ss") & | GMT</lastBuildDate>
	<title>| & title & |</title>
	<description>Lotusphere 2004 Session Export</description>
	<link>http://www.geniisoft.com/showcase.nsf/LS2004_SessionsDB</link>
	<image>
	    <title>Lotusphere Home Page</title>
	    <url>http://www-136.ibm.com/i/tile_lotusphere04.jpg</url>
	    <link>http://www.ibm.com/lotus/lotusphere</link>
	</image>|
	
	GetRssHeader = header
	
	'** make sure we have real Windows linefeeds, to make the XML easy to look at
	If (Instr(GetRSSHeader, Chr(13)) = 0) Then
		GetRSSHeader = ReplaceSubstring(GetRSSHeader, Chr(10), Chr(13) & Chr(10))
	End If
End Function


Function GetDateTime (doc As NotesDocument) As String
	'** convert the special date and time formats for the sessions
	'** to an RFC-822 compliant string
	On Error Goto processError
	
	Dim dateString As String
	Dim timeString As String
	
	Select Case Lcase(Trim(doc.SessionDate(0)))
	Case "saturday" : 
		dateString = "Sat, 24 Jan 2004"
	Case "sunday" : 
		dateString = "Sun, 25 Jan 2004"
	Case "monday" : 
		dateString = "Mon, 26 Jan 2004"
	Case "tuesday" : 
		dateString = "Tue, 27 Jan 2004"
	Case "wednesday" : 
		dateString = "Wed, 28 Jan 2004"
	Case "thursday" : 
		dateString = "Thu, 29 Jan 2004"
	Case "friday" : 
		dateString = "Fri, 30 Jan 2004"
	Case Else : 
		Goto processError
	End Select
	
	timeString = Format(Timevalue(Trim(Strleft(doc.SessionTime(0), "-"))), "hh:mm:ss")
	
	GetDateTime = dateString & " " & timeString & " EST"
	Exit Function
	
processError:
	'** if we got an error, just make up a date/time so our feed will still validate
	GetDateTime = "Fri, 30 Jan 2004 12:00:00 EST"
	Exit Function
	
End Function


Function ReplaceSubstring (fullString As String, oldString As String, newString As String) As String
	Dim pos As Integer
	Dim tempString As String
	
	pos = Instr(fullString, oldString)
	tempString = fullString
	
	Do While pos > 0
		tempString = Left$(tempString, pos - 1) & newString & Mid$(tempString, pos + Len(oldString))
		pos = Instr(pos + Len(newString), tempString, oldString)
	Loop
	
	ReplaceSubstring = tempString
End Function