[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] CGI enabled STT
|
From: |
Markus Fritsche |
|
Subject: |
[Help-smalltalk] CGI enabled STT |
|
Date: |
Sun, 05 Jan 2003 10:11:18 +0100 |
|
User-agent: |
Mozilla/5.0 (Windows; U; Windows NT 5.0; en-US; rv:1.3a) Gecko/20021212 |
Hi!
I've attached some code for GNU Smalltalk that enables a bit of "CGI
processing" in GNU Smalltalk (feedback appreciated). How it's used?
FileIn loadCGI.st (no package definition yet, since it is more a draft
version):
This loads:
SystemAdd.st
STTRef.st (this is STT from /net/httpd/ without the STTServlet stuff)
Cookie.st
CGI.st
HTMLSupport.st
And adds the namespace MFCGI.
configure your httpd (for example, like this):
ScriptAlias /scripts/ /home/user/path_to_image/
and chmod the image to be executable. Put test.stt somewhere within your
webserver. Point your browser to:
http://webserver/scripts/gst.im/path_to_test.stt/test.stt?test=It+works!
If I forgot something (that means, you do not see "Hello World it
works", let me know.
Also, I'd like to have some proposals for some higher level CGI
processing in GNU Smalltalk. What about processing
"multipart/form-data"? Is this needed?
Regards, Markus
--
http://reauktion.de/archer/
Object subclass: #CGI
instanceVariableNames: 'cgidata mystream htmlentities mimeType cookie
redirect'
classVariableNames: 'Instance'
poolDictionaries: ''
category: 'MFCGI-Utilities'!
CGI comment: '
Copyright (c) 2003 Markus Fritsche
'!
CGI class methodsFor: 'get-Singleton'!
instance
"Store an instance"
^ Instance
! !
CGI class methodsFor: 'auto-startup'!
beNotifiedOnStartUp
"add to ObjectMemory dependants"
ObjectMemory addDependent: self.
ObjectMemory snapshot
! !
CGI class methodsFor: 'notify'!
update: aspect
"be notified on startup"
((aspect == #returnFromSnapshot) and:
[ (Smalltalk getenv: 'GATEWAY_INTERFACE') isNil not ]) ifTrue:
[ self processCGI ]
! !
CGI class methodsFor: 'instance-creation'!
processCGI
"make an instance an process the query"
Instance := self new.
Instance processCGI.
^ Instance
! !
CGI methodsFor: 'processing'!
processCGI
"look which data we got"
| qrystring contenttype f stt |
qrystring := Smalltalk getenv: 'QUERY_STRING'.
qrystring isNil ifFalse:
[ self decodeQuery: qrystring ] ifTrue:
[ contenttype := Smalltalk getenv: 'CONTENT_TYPE'.
contenttype = 'x-www-form-urlencoded' ifTrue:
[ qrystring := stdin next: (Smalltalk getenv: 'CONTENT_LENGTH')
asInteger ] ifFalse:
[ 'multipart/form-data' = contenttype ifTrue:
[ self handleUpload: (stdin next: (Smalltalk getenv:
'CONTENT_LENGTH') asInteger). ] ifFalse:
[ self error: 'Couldn''t decode request' ].
]
].
(File exists: self sttName) ifTrue:
[ f := File name: self sttName.
stt := f readStream contents.
self output: ((STTTemplate on: stt) evaluateOn: self)
] ifFalse: [ CGI output: 'schade' ].
ObjectMemory quit.
!
decodeQuery: aString
"decode of an URL encoded string"
| pairs unescaped pair |
cgidata := Dictionary new.
unescaped := NetClients.URL decode: aString.
pairs := unescaped substrings: $&.
pairs do: [ :pairStr |
pair := pairStr substrings: $=.
cgidata at: (pair at: 1) put: (pair at: 2)]
! !
CGI methodsFor: 'accessing'!
cgidata
^ cgidata
!
varget: name
^ cgidata at: name ifAbsent: []
!
instance
^ self class instance
!
redirect: aString
redirect := aString
!
mimeType
^ mimeType
!
mimeType: aString
mimeType := aString
!
stream: aStream
mystream := aStream
!
stream
^ mystream ifNil: [ mystream := stdout ]
! !
CGI methodsFor: 'output'!
output: aString
self stream nextPutAll: aString.
!
outHtmlEscaped: aString
self stream nextPutAll: aString asHtmlString
!
outputStream: aStream
"output the contents of a stream"
self stream nextPutAll: aStream contents.
!
crlf
self stream nextPut: Character cr; nextPut: Character lf
! !
CGI methodsFor: 'information'!
sttName
^Smalltalk getenv: 'PATH_TRANSLATED'
!
scriptpath
| scriptadr c |
scriptadr := Smalltalk getenv: 'PATH_INFO'.
c := (scriptadr substrings: $/) removeLast.
c do: [ :s | scriptadr := scriptadr, '/', s ].
^ scriptadr
!
pathinfo
^Smalltalk getenv: 'PATH_INFO'
!
scriptadr
^((Smalltalk getenv: 'SCRIPT_NAME'), (self pathinfo))
! !
CGI methodsFor: 'http-out'!
httpHeader
self output: 'Content-Type: '.
mimeType isNil ifFalse:
[ self output: mimeType ] ifTrue:
[ self output: 'text/html'; crlf ].
cookie ifNotNil:
[ self output: 'Set-Cookie: ';
output: cookie asString; crlf ].
redirect ifNotNil:
[ self output: 'Location ';
output: redirect; crlf ].
self crlf; yourself
! !
NameSpace current: MFCGI!
Object subclass: #Cookie
instanceVariableNames: 'name value expires path secure domain'
classVariableNames: ''
poolDictionaries: ''
category: 'MFCGI-Utilities'!
Cookie comment: '
Copyright (c) 2003 Markus Fritsche
'!
Cookie class methodsFor: 'decoding'!
get: aString
"get the value of a cookie identified by aString"
| cookieStr cookies |
cookieStr := (Smalltalk getenv: 'HTTP_COOKIE'), ';'.
cookies := cookieStr substrings: $;.
cookies do: [ :cookie | (cookie startsWith: aString) ifTrue: [
^ NetClients.URL decode: ((cookie substrings: $=) at: 2)]].
^ ''!
!
Cookie methodsFor: 'accessing'!
name: aString
name := aString
!
value: aString
value := aString
!
expires: aDateTime
"set the expiry date for a cookie"
expires := aDateTime asUTC
!
path: aString
path := aString
!
domain: aString
domain := aString
!
secure: aString
secure := aString
!
asString
"output the cookie as a string"
| str dateStr |
str := WriteStream on: String new.
((value isNil) or: [ name isNil ]) ifTrue: [ ^ '' ].
str nextPutAll: name; nextPut: $=; nextPutAll: (NetClients.URL encode:
value).
expires ifNotNil: [ :asd |
dateStr := WriteStream on: String new.
dateStr nextPutAll: expires dayName; nextPutAll: ', ';
nextPutAll: expires day printString; nextPut: $-;
nextPutAll: expires month printString; nextPut: $-;
nextPutAll: expires year printString; nextPut: $ ;
nextPutAll: expires hour24 printString; nextPut: $:;
nextPutAll: expires minute printString; nextPut: $:;
nextPutAll: expires second printString; nextPutAll: ' GMT'.
str nextPutAll: (self pvtoptional: dateStr contents what: 'expires')].
str nextPutAll: (self pvtoptional: path what: 'path').
str nextPutAll: (self pvtoptional: domain what: 'domain').
str nextPutAll: (self pvtoptional: secure what: 'secure').
^ str contents
!
asHttpEquiv
"to set a cookie within the html page after the HTTPHeader is written"
| str |
str := WriteStream on: String new.
str nextPutAll: '<meta http-equiv="Set-Cookie" content="';
nextPutAll: self asString; nextPut: $";
nextPut: $>; cr; nextPut: Character lf.
^ str contents
!
!
Cookie methodsFor: 'private'!
pvtoptional: aString what: secString
"private"
aString ifNotNil: [ :asd |
^ ('; ', secString, '=', aString)].
^ ''
! !
Object subclass: #HTML
instanceVariableNames: 'tag params data'
classVariableNames: ''
poolDictionaries: ''
category: 'MFCGI-Utilities'!
HTML comment: '
I am a simple evaluate and transform class. My usage is not as simple as
it should be!
Example:
HTML a: {''href''->''http://reauktion.de/archer'' . ''Markus Fritsche ''}
evaluates to:
Markus Fritsche
HTML br: ''
'!
HTML class methodsFor: 'proxiing'!
doesNotUnderstand: aMessage
| inst arg |
inst := self new.
inst tag: aMessage selector allButLast.
aMessage arguments first isString ifTrue:
[ arg := aMessage arguments ] ifFalse:
[ arg := aMessage arguments first ifNil: [ {nil} ]].
arg do: [ :i |
(i isKindOf: Association) ifTrue: [
inst params add: i
] ifFalse: [
inst data add: i
]
].
^ inst asString
! !
HTML methodsFor: 'conversion'!
asString
| stream |
stream := WriteStream on: String new.
stream nextPut: $<; nextPutAll: tag.
(self params size > 0) ifTrue:
[ self params keysAndValuesDo: [ :k :v |
stream nextPut: $ ; nextPutAll: k;
nextPutAll: '="'; nextPutAll: v;
nextPut: $"
]
].
(data first isNil) ifFalse: [
stream nextPut: $>.
data do: [ :e | stream nextPutAll: e asString ].
stream nextPutAll: '. ] ifTrue: [
stream nextPutAll: ' />' ].
^stream contents
! !
HTML class methodsFor: 'instance-creation'!
new
^super new initialize
! !
HTML methodsFor: 'initialize-release'!
initialize
params := Dictionary new.
data := OrderedCollection new
! !
HTML methodsFor: 'accessing'!
tag: aString
tag := aString
!
tag
^tag
!
data: anObject
data := anObject
!
data
^ data
!
params
^params
!
params: anObject
params := anObject
! !
"=====================================================================
|
| Smalltalk templates
|
|
======================================================================"
"======================================================================
|
| Copyright 2002 Federico G. Stilman
| Porting by Markus Fritsche and Paolo Bonzini
| Integration with the web server framework by Paolo Bonzini.
|
| This file is part of GNU Smalltalk.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
|
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
| General Public License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.
|
======================================================================"
Object subclass: #STTTemplate
instanceVariableNames: 'sttCode cache asStringSelector'
classVariableNames: ''
poolDictionaries: ''
category: 'Web-STT'!
STTTemplate comment:
'This class implements template à la JSP, PHP, ASP (ugh!), and so on.
Smalltalk code is included between {% and %} tags. The only caution
is not to include comments between a period or an open parentheses
of any kind, and the closing %}.
For example
%{ "Comment" 1 to: 5 do: [ %} yes<br> %{ ] %} is valid
%{ 1 to: 5 do: [ "Comment" %} yes<br> %{ ] %} is not valid
This restriction might be removed in the future.
The template is evaluated by sending #evaluateOn: or #evaluateOn:stream:
and returns the output stream (available to the code as the variable `out'').
The first (or only) argument of these two methods is available to the
code as `self'').'!
!STTTemplate methodsFor: 'caching'!
cache
"Returns the receiver's cached object"
^cache!
cache: anObject
"Save anObject in the receiver's cache"
cache := anObject!
initializeCache
"Initialize the receiver's cache"
cache := nil.!
isCached
"Tell if the receiver is cached or not. In the future
this will consider the fact that a cached object may
become old after some time, and that means that the
object is NOT cached anymore."
^self cache notNil! !
!STTTemplate methodsFor: 'private'!
asSmalltalkCodeOn: anObject
"Returns the equivalent version of the receiver as a Smalltalk
CompiledMethod"
| method stream |
self isCached ifTrue: [ ^self cache ].
stream := String new writeStream.
self writeSmalltalkCodeOn: stream.
method := anObject class compileString: stream contents.
self cache: method.
anObject class removeSelector: method selector.
^method
!
writeSmalltalkCodeOn: stream
"Write the equivalent version of the receiver as Smalltalk code
on the given stream"
| sttOpenIndex sttCloseIndex lastIndex sttCodeIndex smalltalkExpression |
stream
nextPutAll: 'STT_Cache';
print: self asOop;
nextPutAll: ': out';
nl.
lastIndex := 1.
[ (sttOpenIndex := self sttCode
indexOfSubCollection: '{%' startingAt: lastIndex) > 0] whileTrue: [
self
writeOutputCodeFor: (self sttCode copyFrom: lastIndex to:
sttOpenIndex - 1)
on: stream.
sttCloseIndex := self sttCode
indexOfSubCollection: '%}'
startingAt: sttOpenIndex
ifAbsent: [ ^ self error: 'Missing closing tag' ].
sttCodeIndex := sttOpenIndex + 2.
(sttCode at: sttOpenIndex + 2) = $=
ifTrue: [
stream nextPutAll: 'out nextPutAll: ('.
sttCodeIndex := sttCodeIndex + 1 ].
smalltalkExpression := sttCode copyFrom: sttCodeIndex to: sttCloseIndex
- 1.
smalltalkExpression := smalltalkExpression trimSeparators.
stream nextPutAll: smalltalkExpression.
(sttCode at: sttOpenIndex + 2) = $=
ifTrue: [
stream nextPutAll: ') ', self asStringSelector asString.
sttCodeIndex := sttCodeIndex + 1.
].
('|[({.' includes: smalltalkExpression last)
ifFalse: [ stream nextPut: $. ].
stream nl.
lastIndex := sttCloseIndex + 2.
].
self
writeOutputCodeFor: (self sttCode copyFrom: lastIndex to: sttCode size)
on: stream.
stream
nextPutAll: '^out'.
!
writeOutputCodeFor: aString on: aStream
"Writes on aStream the required Smalltalk code for outputing aString on
'out'"
aStream
nextPutAll: 'out nextPutAll: ''';
nextPutAll: aString;
nextPutAll: '''.';
nl! !
!STTTemplate methodsFor: 'evaluating'!
evaluateOn: anObject
"Evaluates the receiver to anObject"
^(self evaluateOn: anObject stream: String new writeStream) contents
!
evaluateOn: anObject stream: out
"Evaluates the receiver to anObject"
^anObject perform: (self asSmalltalkCodeOn: anObject) with: out
! !
!STTTemplate methodsFor: 'accessing'!
sttCode
"Returns the receiver's Smalltalk Template code"
^sttCode!
asStringSelector
"Returns the selector used to show objects as Strings on the receiver"
^asStringSelector!
asStringSelector: aSymbol
"Sets the selector used to show objects as Strings on the receiver"
asStringSelector := aSymbol! !
!STTTemplate methodsFor: 'initializing'!
initializeOn: aString asStringSelector: aSymbol
sttCode := aString.
asStringSelector := aSymbol.
self initializeCache.! !
!STTTemplate class methodsFor: 'unit testing'!
test
| sttTest |
sttTest := '
<html>
<head><title>{%= self class %}</title></head>
<body>
<table>
{% self to: 10 do: [ :each | %}
<tr>
<td>{%= each printString %}</td>
<td>{%= (each * 2) printString %}</td>
</tr>
{% ] %}
</table>
</body>
</html>'.
^(STTTemplate on: sttTest) evaluateOn: 1!
test2
| sttTest |
sttTest := '
<html>
<head><title>{%= self class %}</title></head>
{%
out nextPutAll: ''This is another test''; nl.
1 to: 15 do: [:x |
out nextPutAll: ''<p>This paragraph was manually sent out
'',
(self * x) printString, ''</p>''; nl ].
out nextPutAll: ''After all this ST code goes the final HTML
closing tag''.
%}
</html>'.
^(STTTemplate on: sttTest) evaluateOn: 3! !
!STTTemplate class methodsFor: 'instance creation'!
on: aString
"Creates an instance of the receiver on aString"
^self on: aString asStringSelector: self defaultAsStringSelector!
on: aString asStringSelector: aSymbol
"Creates an instance of the receiver on aString"
^self new initializeOn: aString asStringSelector: aSymbol! !
!STTTemplate class methodsFor: 'defaults'!
defaultAsStringSelector
^#displayString! !
!STTResponse class methodsFor: 'responding'!
respondTo: aRequest with: aSTTTemplate
self new
stt: aSTTTemplate;
respondTo: aRequest! !
String methodsFor: 'conversion'!
asHtmlString
"convert the String to an HTML escaped string"
| d stream |
stream := WriteStream on: String new.
d := Dictionary new.
d at: Character cr put: ' ';
at: Character lf put: ' ';
at: Character tab put: '	';
at: $& put: '&';
at: $ put: ' ';
at: $< put: '<';
at: $> put: '>';
at: $" put: '"'.
self do: [ :c |
stream nextPutAll: (d at: c ifAbsent: [String with: c])].
^stream contents
! !
String methodsFor: 'copying'!
allButLast
^ self copyFrom: 1 to: self size - 1
! !
Smalltalk addSubspace: #MFCGI.
#(
'CGI.st'
'Cookie.st'
'STTRef.st'
) do: [ :file | FileStream fileIn: file ].
ObjectMemory addDependent: CGI!
Namespace current: Smalltalk!
{% self httpHeader %}
Hello World
{%= (self varget: 'test') %}
- [Help-smalltalk] CGI enabled STT,
Markus Fritsche <=