'From Squeak3.2gamma of 15 January 2002 [latest update: #4827] on 5 May 2002 at 6:24:48 pm'!
"Change Set:		MailDB-Web
Date:			5 May 2002
Author:			ajr (Aaron Jon Reichow)

A spiffy little Comanche module to web-enable your Celeste MailDB.  See the class comment in MailDBModule for information on how to use it. 
"!

Object subclass: #MailDBModule
	instanceVariableNames: 'mailDB '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Network-Mail Reader'!

!MailDBModule commentStamp: 'ajr 5/5/2002 15:45' prior: 0!
MailDBModule is a Comanche module for browsing a MailDB, used by Celeste for
storing email. I developed it under Squeak 3.2gamma and Comanche 4.9, but it
should work in older and newer versions.  For authorization support, you do need
DictionaryHttpAuthorizationModule, which I obtained from:
<http://minnow.cc.gatech.edu/swiki/77>.

Usage Examples:
"Is you want authorization..."
| s m users |
s := ComancheNetService named: 'celesteDB' onPort: 9898.
users := Dictionary new.
users at: 'username' put: 'password'. 		"more than one user is possible!!"
m := DictionaryHttpAuthorizationModule
		module: (MailDBModule newOn: (MailDB openOn: 'EMAIL'))
		realm: 'maildb'
		users: users.
s module: m; start.


"Without any authorization..."
| s |
s := ComancheNetService named: 'celesteDB' onPort: 9898.
s module: (MailDBModule newOn: (MailDB openOn: 'EMAIL')); start.!


!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 00:39'!
categoryListTable
	| s |
	s _ WriteStream on: String new.
	s 	nextPutAll: '
		<center><b>Available Categories</b></center>
		<table cellpadding=4 bgcolor="#FFFFFF" width="100%"><tr><td><ul>'.
	mailDB allCategories do: [ :c |
		s 	nextPutAll: '<li><a href="/';
			nextPutAll: c;
			nextPutAll: '">';
			nextPutAll: c;
			nextPutAll: '</a></li>' ].
	s nextPutAll: '</ul></td></tr></table>'.
	^ s contents! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 00:04'!
defaultResponse
	^ (self standardHtmlHeader: 'Error!!'), 
'Error in request.
<a href="/">Start over.</a>
</body>
</html>'! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 16:54'!
frontPage
	| s |
	s _ WriteStream on: String new.
	s 	nextPutAll:
			(self standardHtmlHeader: ('Categories in "', mailDB rootFilename, '"'));
		nextPutAll: '<center><h2>MailDB Access</h2></center>';
		nextPutAll: self categoryListTable;
		nextPutAll: self searchFieldTable;
		nextPutAll: '</body></html>'.
	^ s contents! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/4/2002 20:02'!
mailDB
	^ mailDB! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/4/2002 20:02'!
mailDB: aMailDB
	mailDB _ aMailDB! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 18:12'!
messagesIn: cat
	| s |
	s _ WriteStream on: String new.
	s	nextPutAll:
			(self standardHtmlHeader: ('Messages in ', cat));
		nextPutAll: '
		<center><b>Available Categories</b></center>
		<table bgcolor="#FFFFFF" cellpadding=4 width="100%">
		<tr><td bgcolor="#000000"><font color="#FFFFFF">MsgID</font></td>
			<td bgcolor="#000000"><font color="#FFFFFF">From</font></td>
			<td bgcolor="#000000"><font color="#FFFFFF">Subject</font></td></tr>';cr.
	(mailDB messagesIn: cat) do: [ :msgId |
		s 	nextPutAll: '<tr><td><a href="/';
			nextPutAll: cat;
			nextPutAll: '/';
			nextPutAll: msgId asString;
			nextPutAll: '">';
			nextPutAll: msgId asString;
			nextPutAll: '</a></td>';
			nextPutAll: '<td>';
			nextPutAll: (mailDB getMessage: msgId) subject;
			nextPutAll: '</td>';
			nextPutAll: '<td>';
			nextPutAll: (mailDB getMessage: msgId) from;
			nextPutAll: '</td></tr>' ].
	s nextPutAll: '</table></body></html>'.
	^ s contents! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 15:48'!
process: request
	| chunks |
	chunks _ request url findTokens: '/'.
	(request url = '/') ifTrue: [ ^ self frontPage ].

	((chunks size = 1) and: [mailDB allCategories includes: chunks first]) ifTrue: [
		^ self messagesIn: chunks first ].

	((chunks size = 2) and: [chunks first = 'full']) ifTrue: [
		^ self showFull: chunks second asInteger].

	((chunks size = 2) and: [chunks first = 'search']) ifTrue: [
		^ self search: chunks second ].

	(chunks size = 2) ifTrue: [ ^ self showMessage: chunks second asInteger].

	(request url = '/search/') ifTrue: [ ^ self search: (request postFields at: 'search') ].

	^ self defaultResponse! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 18:12'!
search: searchStr
	| msgs matching s |
	msgs _ mailDB messagesIn: '.all.'.
	matching _ OrderedCollection new: 4.
	s _ WriteStream on: String new.
	s	nextPutAll:
			(self standardHtmlHeader: ('Messages matching ', searchStr));
		nextPutAll: '
		<center><b>Available Categories</b></center>
		<table bgcolor="#FFFFFF" cellpadding=4 width="100%">
		<tr><td bgcolor="#000000"><font color="#FFFFFF">MsgID</font></td>
			<td bgcolor="#000000"><font color="#FFFFFF">From</font></td>
			<td bgcolor="#000000"><font color="#FFFFFF">Subject</font></td></tr>';cr.

	msgs do: [ :msgId |
		 (searchStr match: (mailDB getText: msgId)) ifTrue: [
			matching add: msgId ] ].

	matching do: [ :msgId |
		s 	nextPutAll: '<tr><td><a href="/';
			nextPutAll: '.all.';
			nextPutAll: '/';
			nextPutAll: msgId asString;
			nextPutAll: '">';
			nextPutAll: msgId asString;
			nextPutAll: '</a></td>';
			nextPutAll: '<td>';
			nextPutAll: (mailDB getMessage: msgId) subject;
			nextPutAll: '</td>';
			nextPutAll: '<td>';
			nextPutAll: (mailDB getMessage: msgId) from;
			nextPutAll: '</td></tr>' ].
	s nextPutAll: '</table></body></html>'.
	^ s contents! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 16:51'!
searchFieldTable
	| s |
	s _ WriteStream on: String new.
	^ s 	nextPutAll: '
		<center><b>Search</b></center>
		<table cellpadding=4 bgcolor="#FFFFFF" width="100%"><tr><td>';
		nextPutAll: '<form method="POST"
			action="/search/"><input name=search><input type=submit></form>';
		nextPutAll: 'Use * and # as wildcards.  For example,
			to search for "squeak," enter "*squeak*" in the input field. </td></tr></table>';
		contents! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 00:11'!
showFull: msgID
	| s |
	s _ WriteStream on: String new.
	s	nextPutAll:
			(self standardHtmlHeader: ('Message #', msgID asString));
		nextPutAll: '<table><tr><td bgcolor="#FFFFFF" cellpadding=4><pre>';
		nextPutAll: (mailDB getMessage: msgID) text;
		nextPutAll: '</pre></td></tr></table></body></html>'.
	^ s contents! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/5/2002 18:13'!
showMessage: msgID
	| s |
	s _ WriteStream on: String new.
	s	nextPutAll:
			(self standardHtmlHeader: ('Message #', msgID asString));
		nextPutAll: '<table cellpadding=4 width="100%">
			<tr bgcolor="#BBBBEE"><td><b>From:</b> ';
		nextPutAll: (mailDB getMessage: msgID) from;
		nextPutAll: '</td></tr><tr bgcolor="#BBBBEE"><td><b>Subject:</b> ';
		nextPutAll: (mailDB getMessage: msgID) subject;
		nextPutAll: '</td></tr><tr bgcolor="#FFFFFF"><td><pre>';
		nextPutAll: (mailDB getMessage: msgID) body content "asUnHtml";
		nextPutAll: '</pre></td></tr></table>';
		nextPutAll: '<center><a href="/full/';
		nextPutAll: msgID asString;
		nextPutAll: '">See Raw Text</a></center>';
		nextPutAll: '</body></html>'.
	^ s contents! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/4/2002 23:42'!
standardHtmlHeader
	^ self standardHtmlHeader: ''! !

!MailDBModule methodsFor: 'kom' stamp: 'ajr 5/4/2002 23:56'!
standardHtmlHeader: title
	^ '<html><head>
		<title>', title, 
		'</title></head><body bgcolor="#9999BB">'! !


!MailDBModule class methodsFor: 'as yet unclassified' stamp: 'ajr 5/4/2002 20:01'!
newOn: aMailDB
	^ self new mailDB: aMailDB! !

MailDBModule removeSelector: #categoryList!
MailDBModule removeSelector: #showMessage!