[Seaside] onAnswer: problems
C. David Shaffer
cdshaffer at acm.org
Mon Jun 21 08:04:52 CEST 2004
Colin Putney wrote:
> I too would like to see such a framework.
>
> My Nori templating framework provided a way of testing Seaside
> components, but since templating is so passé, I've stopped developing
> it. I'm not sure how applicable it is to the current situation, but
> here's how it worked.
>
> 1. Instead of using HtmlRenderer, components generated a DOM tree
> which was then serialized to serve the page.
>
> 2. The tests would set up a component, render it, and then make
> assertions about the DOM tree. This would be stuff like "has a text
> node containing 'Copyright Evil Corporation 1976, all rights
> reserved'" or "has an anchor with the label 'Launch Nukes'" or
> "background color for a div with id #main is #ffffff".
>
> 3. Callbacks were implemented with MessageSends instead of blocks.
> This allowed them to be easily examined as well. So tests would also
> make assertions like "some element of the page is bound do
> #doSomething." That assertion would pass if there was an anchor or
> form button that triggered #doSomething when clicked. You could do
> similar assertions for value callbacks.
>
> 4. Testing of the callbacks themselves was done separately. A
> component would be set up, the callback invoked, the resulting
> component rendered and assertions made about the resulting DOM tree.
> So you could make assertions like #doSomething calls
> SomeOtherComponent, which then displays a page containing a link that
> calls #answer.
>
> The intent of all this was to make is simple to write tests that
> capture the spirit of the requirements that usually come up in web
> applications. Requests from users often take the form of "There should
> be a link on this page that will take me to a page that does X." So to
> test this, we can write two tests: one that asserts the link is
> present and calls a certain callback (ie, test the rendering), and
> another that asserts the callback does what it's supposed to (ie, test
> the behaviour).
>
> I wrote a fairly complex real-world application using this kind of
> testing (not in Seaside - Nori was a port of that system to Seaside),
> and I can't stress enough what a benefit it is to be able to test
> application workflow and response to specific user actions.
>
> So where do we go from here? I have some thoughts about how to
> implement a framework for testing Seaside apps that doesn't rely on a
> templating system the way Nori did.
>
> 1. For testing, we use a mock renderer instead of a genuine
> HtmlRenderer. The test would set up the MockRenderer with a set of
> expectations, which would capture the things we want to be true about
> the way the component is rendered. During the render, the MockRenderer
> would check each call by the component against its expectations and
> fail the test if they aren't met. In some cases, this would have to
> wait until the render is finished (such as certain things being
> present), but sometimes we could fail the test at the exact point the
> render goes wrong.
>
> 2. Analysing block callbacks is much trickier than MessageSends, but I
> think it could be done using the same sort of techniques that are in
> the RefactoringBrowser. We'd parse the source code to the block or
> decompile it's bytecodes into an AST which we could then examine. Even
> with an AST, it's pretty difficult to predict what code will do
> without running it, but I suspect that most blocks passed to the
> renderer are pretty simple, so it ought to be possible to use the same
> sort of convention that Nori did. We could assert that #doSomething
> gets called by the callback, or the value gets stored in an instance
> variable etc.
>
> 3. Alternatively we could modify HtmlRenderer to allow the use of
> messages or selectors in place of blocks. This makes rendering a bit
> more awkward, but it makes testing easier.
>
> 4. I'd like to tie into the halo system as well. There ought to be a
> halo that allows the user to view and edit the rendering assertions
> that get used in the component's tests, and run the tests. I'm
> imagining something a bit like FIT here; this would be aimed at
> allowing non-programmers to specify the rendering tests. Ideally this
> should be implemented in a way that allows for test-driven development
> - ie, we can create the rendering assertions before actually writing
> the rendering code.
>
> Thoughts?
>
> Colin
Great suggestions Colin. I enjoyed your talk on templating and testing
at last year's Smalltalk Solutions but some of your fundamental ideas
(above) didn't really sink in since I wasn't using Seaside. Over the
last couple of days I cobbled together some classes to help me start to
think about testing my Seaside components (while the more general web
testing conversation is interesting, I can't seem to motivate myself to
try to generalize this). At the simple component (no subcomponents)
level I'm usually happy to trigger a link or form submission and test
the effect on the component state or domain model state. For example,
did the component answer and was the answer what I expected? Did the
state of the component change as I would expect it to? etc. My guess
is that over time I'll find these tests difficult to maintain as I
modify my components, we'll see. This happens with my GUI tests as
well. I've never found a particularly robust way to test
interfaces...although now I'm certainly going to consider some of your
suggestions about presence of functionality. I attached the
code...please, think of this as a sketch rather than the final drawing.
Anyway, it seems to work in it's current state. I have three sample
components with several test cases but clearly I'm just beginning.
Here's one example (from SCSampleComponentTest):
testComponent2
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 1).
self assert: self component firstSent.
self deny: self component secondSent.
result _ self
followAnchor: (result anchorWithId: 'second').
self assert: self component firstSent.
self assert: self component secondSent
This example also shows two ways to get to anchors (their seaside
assigned number or their ID which is required to be unique by the
HTML/XHTML specs). Forms work similarly (I have a sample). Obviously
the "check the state of the component" part is usually not as trivial as
this example implies but I'm hoping it will map well to most of my
components. Also, I started thinking about the back button and
implemented a simple back method. Here's a sample which tests it:
testBack
| result |
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 1).
self assert: self component firstSent.
self deny: self component secondSent.
result _ self
followAnchor: (result anchorNumber: 1).
self backAndRefresh.
self assert: self component firstSent.
self deny: self component secondSent
So "self component" always answers the component used the render the
last request (although frankly I have no idea if my code for that is
correct). Anyway, I'm sure that you get the idea. I realize that this
kind of test is not designed to indicate static structure of the
rendered component but my GUI tests don't check how my GUI component was
painted either. I also understand that there are lots of tools that
need to go around this (to aid in test generation etc). If there is any
interest in this testing framework, I will fill in the gaps, clean it up
and put it on SqueakMap. I'd like to add support for a web-based test
runner as well but the core stuff still has a ways to go.
David
-------------- next part --------------
WADecoration subclass: #SCAnswerChecker
instanceVariableNames: 'hasAnswer answerValue '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCAnswerChecker methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:45'!
handleAnswer: anObject
(super handleAnswer: anObject)
ifFalse: [hasAnswer _ true.
answerValue _ anObject]
ifTrue: [^true].
^ false! !
!SCAnswerChecker methodsFor: 'accessing' stamp: 'cds 6/19/2004 20:47'!
answerValue
^answerValue! !
!SCAnswerChecker methodsFor: 'accessing' stamp: 'cds 6/19/2004 20:47'!
hasAnswer
^hasAnswer! !
TestCase subclass: #SCComponentTest
instanceVariableNames: 'app fakeMain requests '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 18:47'!
back
self requests removeLast! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 00:46'!
backAndRefresh
self back.
^self refresh! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 19:54'!
checkForSessionInUrl: aString
| a |
a _ SCSeasideAnchor fromHref: aString.
^a! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/18/2004 21:10'!
component
^ fakeMain component! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:48'!
componentAnswered: value
| checker |
checker _ fakeMain answerChecker.
^checker hasAnswer and: [checker answerValue = value]! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/18/2004 20:34'!
configureApplicationForComponent: aComponent
app preferenceAt: #deploymentMode put: true.
fakeMain _ SCFakeMainClass new.
app preferenceAt: #mainClass put: fakeMain! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/20/2004 20:51'!
establishSession
| req |
req := HttpRequest
readFromStream: (self httpGetRequestStreamFor: app baseUrl asString).
^SCParsedSeasideDocument
fromResponse: (self issueRequestUntilNotMoved: req)! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/20/2004 20:51'!
followAnchor: anAnchor
| req |
self assert: anAnchor notNil.
req := HttpRequest
readFromStream: (self httpGetRequestStreamFor: anAnchor asString).
^SCParsedSeasideDocument
fromResponse: (self issueRequestUntilNotMoved: req)! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:01'!
httpGetRequestStreamFor: url
^ ('GET ' , url , ' HTTP/1.0' , String crlf) readStream! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:34'!
httpPostRequestStreamForUrl: url data: postData
^ ('POST ' , url , ' HTTP/1.0 ' , String crlf , 'Content-Length: ' , postData size printString , String crlf , 'Content-type: application/x-www-form-urlencoded' , String crlf , String crlf , postData) readStream! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/18/2004 20:25'!
issueRequest: anHttpRequest
self requests add: anHttpRequest.
^WAKom default processHttpRequest: anHttpRequest! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/20/2004 20:51'!
issueRequestUntilNotMoved: anHttpRequest
| response req newUrl |
req := anHttpRequest.
[response := self issueRequest: req.
response status = #tempMoved]
whileTrue:
[self requests removeLast.
newUrl := response fields at: 'Location'.
self checkForSessionInUrl: newUrl.
req := HttpRequest readFromStream: (self httpGetRequestStreamFor: newUrl)].
^response! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/18/2004 20:51'!
newApplicationForComponent: aComponentClass
app _ SCTesterApplication path: aComponentClass name.
app configuration addAncestor: WARenderLoopConfiguration localConfiguration.
app preferenceAt: #rootComponent put: aComponentClass.
WADispatcher default registerEntryPoint: app at: aComponentClass name.
self configureApplicationForComponent: aComponentClass.
^ app! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 00:46'!
refresh
^self issueRequest: self requests last! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/18/2004 15:13'!
removeApplication
WADispatcher default removeEntryPoint: app.! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:36'!
setUp
requests _ OrderedCollection new! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:34'!
submitForm: form pressingButton: button
| req url |
self assert: form notNil.
url _ form actionUrl.
req _ HttpRequest
readFromStream: (self
httpPostRequestStreamForUrl: url
data: (form httpDataWithButton: button)).
^ SCParsedSeasideDocument
fromResponse: (self issueRequestUntilNotMoved: req)! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:25'!
tearDown
self removeApplication.
! !
!SCComponentTest methodsFor: 'accessing' stamp: 'cds 6/18/2004 20:24'!
requests
^requests ifNil: [requests _ OrderedCollection new]! !
WARenderLoopMain subclass: #SCFakeMainClass
instanceVariableNames: 'renderLoop checker '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCFakeMainClass methodsFor: 'hack' stamp: 'cds 6/18/2004 20:31'!
new
^self! !
!SCFakeMainClass methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:46'!
createRoot
| comp |
checker _ SCAnswerChecker new.
comp _ super createRoot.
comp addDecoration: checker.
^ comp! !
!SCFakeMainClass methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 18:43'!
start: aRequest
self session redirect.
(renderLoop _ SCRenderLoop new root: self createRoot) run! !
!SCFakeMainClass methodsFor: 'accessing' stamp: 'cds 6/19/2004 20:46'!
answerChecker
^checker! !
!SCFakeMainClass methodsFor: 'accessing' stamp: 'cds 6/19/2004 18:41'!
component
^ renderLoop root! !
WARenderLoop subclass: #SCRenderLoop
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCRenderLoop methodsFor: 'accessing' stamp: 'cds 6/19/2004 18:43'!
root
^root! !
SCComponentTest subclass: #SCSampleComponentTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:38'!
testAnswer
| result |
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 3).
self assert: (self componentAnswered: 1234)! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:36'!
testBack
| result |
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 1).
self assert: self component firstSent.
self deny: self component secondSent.
result _ self
followAnchor: (result anchorNumber: 1).
self backAndRefresh.
self assert: self component firstSent.
self deny: self component secondSent! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 19:59'!
testComponent1
| result |
self newApplicationForComponent: SCTestComponent1.
result := self establishSession.
self assert: result bodyElement contents first string = 'hello'! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 21:56'!
testComponent2
| result |
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 1).
self assert: self component firstSent.
self deny: self component secondSent.
result _ self
followAnchor: (result anchorWithId: 'second').
self assert: self component firstSent.
self assert: self component secondSent! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:19'!
testComponent3
| result form |
self newApplicationForComponent: SCTestComponent3.
result _ self establishSession.
form _ result forms first.
form inputWithId: 'field1' value: 'bob'.
form inputWithId: 'field2' value: 'jane'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self component field1 = 'bob'.
self assert: self component field2 = 'jane'! !
Object subclass: #SCSeasideStateMarker
instanceVariableNames: 'sessionId continuationId '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
continuationId
^continuationId! !
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
continuationId: anObject
continuationId := anObject! !
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
sessionId
^sessionId! !
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
sessionId: anObject
sessionId := anObject! !
SCSeasideStateMarker subclass: #SCSeasideAnchor
instanceVariableNames: 'fullUrl anchorNumber path '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCSeasideAnchor methodsFor: 'initialize' stamp: 'cds 6/19/2004 19:51'!
initializeFromHref: aString
| parts |
self fullUrl: aString.
parts _ aString findTokens: '?'.
parts isEmpty
ifTrue: [^ self].
self path: parts first.
parts size > 1
ifTrue: [(parts second findTokens: '&')
do: [:each | self variableFromString: each]]! !
!SCSeasideAnchor methodsFor: 'initialize' stamp: 'cds 6/19/2004 21:59'!
initializeFromXMLElement: anXMLElement
self
initializeFromHref: (anXMLElement attributeAt: 'href')! !
!SCSeasideAnchor methodsFor: 'initialize' stamp: 'cds 6/18/2004 14:19'!
variableFromString: aString
| parts |
parts _ aString findTokens: '='.
parts isEmpty
ifTrue: [^ nil].
parts size = 1
ifTrue: [^ self anchorNumber: parts first].
parts first = '_s'
ifTrue: [^ self sessionId: parts second].
parts first = '_k'
ifTrue: [^ self continuationId: parts second]! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:19'!
anchorNumber
^anchorNumber! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:19'!
anchorNumber: anObject
anchorNumber := anObject! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/19/2004 19:51'!
fullUrl: aString
fullUrl _ aString! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/19/2004 19:54'!
path: aString
path _ aString! !
!SCSeasideAnchor methodsFor: 'converting' stamp: 'cds 6/19/2004 19:52'!
asString
^ fullUrl! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SCSeasideAnchor class
instanceVariableNames: ''!
!SCSeasideAnchor class methodsFor: 'instance creation' stamp: 'cds 6/18/2004 13:23'!
fromHref: aString
^self new initializeFromHref: aString! !
!SCSeasideAnchor class methodsFor: 'instance creation' stamp: 'cds 6/19/2004 19:45'!
fromXMLElement: anXMLElement
^ self new initializeFromXMLElement: anXMLElement! !
WAComponent subclass: #SCTestComponent1
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCTestComponent1 methodsFor: 'rendering' stamp: 'cds 6/19/2004 20:26'!
renderContentOn: html
html text: 'hello'! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SCTestComponent1 class
instanceVariableNames: ''!
!SCTestComponent1 class methodsFor: 'seaside' stamp: 'cds 6/19/2004 00:31'!
canBeRoot
^true! !
WAComponent subclass: #SCTestComponent2
instanceVariableNames: 'firstSent secondSent thirdSent '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCTestComponent2 methodsFor: 'initialization' stamp: 'cds 6/19/2004 00:44'!
initialize
super initialize.
self session registerObjectForBacktracking: self.
firstSent _ false.
secondSent _ false.
thirdSent _ false! !
!SCTestComponent2 methodsFor: 'callbacks' stamp: 'cds 6/18/2004 14:45'!
sendFirst
firstSent _ true! !
!SCTestComponent2 methodsFor: 'callbacks' stamp: 'cds 6/18/2004 14:45'!
sendSecond
secondSent _ true! !
!SCTestComponent2 methodsFor: 'callbacks' stamp: 'cds 6/19/2004 20:39'!
sendThird
thirdSent _ true.
self answer: 1234! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:45'!
firstSent
^firstSent! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/19/2004 21:55'!
renderContentOn: html
self firstSent
ifFalse: [html
anchorWithAction: [self sendFirst]
text: 'first link'].
html text: 'hello'.
self secondSent
ifFalse: [html cssId: 'second'.
html
anchorWithAction: [self sendSecond]
text: 'second link'].
self thirdSent
ifFalse: [
html cssId: 'third'.
html
anchorWithAction: [self sendThird]
text: 'third link']! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:45'!
secondSent
^secondSent! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/19/2004 00:41'!
thirdSent
^thirdSent! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SCTestComponent2 class
instanceVariableNames: ''!
!SCTestComponent2 class methodsFor: 'seaside' stamp: 'cds 6/18/2004 21:18'!
canBeRoot
^true! !
WAComponent subclass: #SCTestComponent3
instanceVariableNames: 'field1 field2 button1WasPressed button2WasPressed '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:46'!
button1WasPressed
^button1WasPressed! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:46'!
button2WasPressed
^ button2WasPressed! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field1
^field1! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field1: anObject
field1 := anObject! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field2
^field2! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field2: anObject
field2 := anObject! !
!SCTestComponent3 methodsFor: 'rendering' stamp: 'cds 6/19/2004 22:47'!
renderContentOn: html
html
form: [html text: 'field1: '.
html textInputOn: #field1 of: self.
html br.
html text: 'field2: '.
html textInputOn: #field2 of: self.
html br.
html cssId: 'button1'.
html
submitButtonWithAction: [self button1Pressed].
html cssId: 'button2'.
html
submitButtonWithAction: [self button2Pressed]]! !
!SCTestComponent3 methodsFor: 'callbacks' stamp: 'cds 6/19/2004 22:46'!
button1Pressed
button1WasPressed _ true! !
!SCTestComponent3 methodsFor: 'callbacks' stamp: 'cds 6/19/2004 22:46'!
button2Pressed
button2WasPressed _ true! !
WAApplication subclass: #SCTesterApplication
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCTesterApplication commentStamp: 'cds 6/18/2004 20:46' prior: 0!
Just need to expose the session registry!
!SCTesterApplication methodsFor: 'accessing' stamp: 'cds 6/18/2004 20:46'!
handlerWithKey: aKey
^handlersByKey at: aKey ifAbsent: []! !
Object subclass: #SCXMLElementWrapper
instanceVariableNames: 'xmlElement '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/20/2004 18:16'!
allElementsIn: element addTo: result
result add: element.
element
elementsDo: [:subElement | self allElementsIn: subElement addTo: result]! !
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/20/2004 18:16'!
allElementsNamed: tagName in: element addTo: result
element name = tagName
ifTrue: [result add: element]
ifFalse:
[element elementsDo:
[:subElement |
self
allElementsNamed: tagName
in: subElement
addTo: result]]! !
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/20/2004 18:16'!
elementWithId: aString ifNone: aBlock
^self allElements
detect: [:each | (each
attributeAt: 'id'
ifAbsent: [])
= aString]
ifNone: aBlock! !
!SCXMLElementWrapper methodsFor: 'initialize' stamp: 'cds 6/20/2004 18:17'!
initializeFromXMLElement: anElement
xmlElement _ anElement! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SCXMLElementWrapper class
instanceVariableNames: ''!
!SCXMLElementWrapper class methodsFor: 'instance creation' stamp: 'cds 6/20/2004 18:17'!
fromXMLElement: anElement
^ self new initializeFromXMLElement: anElement! !
SCXMLElementWrapper subclass: #SCParsedSeasideDocument
instanceVariableNames: 'xmlDoc elements '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:19'!
allElements
| result |
result _ OrderedCollection new.
self allElementsIn: xmlElement addTo: result.
^ result! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 09:49'!
anchorNumber: number
| num |
num := number isString ifTrue: [number] ifFalse: [number asString].
^self anchors detect: [:each | each anchorNumber = num] ifNone: []! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/19/2004 21:55'!
anchorWithId: aString
^self
anchorWithId: aString
ifNone: []! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/19/2004 21:54'!
anchorWithId: aString ifNone: aBlock
| res |
res _ self elementWithId: aString ifNone: [].
^res ifNil: aBlock ifNotNil: [SCSeasideAnchor fromXMLElement: res]! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:18'!
anchors
| result |
result _ OrderedCollection new.
self
allElementsNamed: #a
in: xmlElement
addTo: result.
result _ result
select: [:each | each attributes includesKey: #href].
^ result
collect: [:each | SCSeasideAnchor fromXMLElement: each]! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:18'!
bodyElement
^ xmlElement
elementAt: #body! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/19/2004 23:05'!
formWithId: aString
^ self formWithId: aString ifNone: []! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:27'!
formWithId: aString ifNone: aBlock
| res |
res _ self
elementWithId: aString
ifNone: [].
^ res
ifNil: aBlock
ifNotNil: [SCSeasideForm fromXMLElement: res]! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:27'!
forms
| result |
result _ OrderedCollection new.
self
allElementsNamed: #form
in: xmlElement
addTo: result.
^ result
collect: [:each | SCSeasideForm fromXMLElement: each]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SCParsedSeasideDocument class
instanceVariableNames: ''!
!SCParsedSeasideDocument class methodsFor: 'instance creation' stamp: 'cds 6/18/2004 15:22'!
fromResponse: aResponse
aResponse contents reset.
^ self fromStream: aResponse contents! !
!SCParsedSeasideDocument class methodsFor: 'instance creation' stamp: 'cds 6/20/2004 18:21'!
fromStream: aStream
| xmlDoc |
xmlDoc _ XMLDOMParser parseDocumentFrom: aStream.
^ self fromXMLDoc: xmlDoc! !
!SCParsedSeasideDocument class methodsFor: 'instance creation' stamp: 'cds 6/20/2004 18:25'!
fromXMLDoc: aDoc
^ self
fromXMLElement: (aDoc elementAt: #html)! !
SCXMLElementWrapper subclass: #SCSeasideForm
instanceVariableNames: 'inputs buttons inputValues '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
!SCSeasideForm methodsFor: 'buttons' stamp: 'cds 6/20/2004 18:32'!
buttons
^buttons! !
!SCSeasideForm methodsFor: 'initialize' stamp: 'cds 6/21/2004 01:08'!
initializeFromXMLElement: anXMLElement
super initializeFromXMLElement: anXMLElement.
inputs _ OrderedCollection new.
self
allElementsNamed: #input
in: xmlElement
addTo: inputs.
buttons _ inputs
select: [:each | (each
attributeAt: 'type'
ifAbsent: [])
= 'submit'].
self initializeValuesFromCurrentInputs! !
!SCSeasideForm methodsFor: 'initialize' stamp: 'cds 6/21/2004 01:10'!
initializeValuesFromCurrentInputs
| id value |
inputs
do: [:each |
id _ each attributeAt: 'id'.
value _ each attributes
at: 'value'
ifAbsent: [].
value
ifNotNil: [self inputWithId: id value: value]]! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/20/2004 18:30'!
inputValues
^ inputValues
ifNil: [inputValues _ Dictionary new]! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/20/2004 18:54'!
inputWithId: stringId addValue: stringValue
(self inputValues at: stringId ifAbsentPut: [OrderedCollection new]) add: stringValue! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/20/2004 18:30'!
inputWithId: stringId value: stringValue
self inputValues at: stringId put: stringValue! !
!SCSeasideForm methodsFor: 'posting' stamp: 'cds 6/20/2004 21:08'!
actionUrl
^ xmlElement attributeAt: 'action'! !
!SCSeasideForm methodsFor: 'posting' stamp: 'cds 6/20/2004 22:25'!
httpDataWithButton: button
| resultStream |
resultStream _ WriteStream on: ''.
button attributes
at: 'name'
ifPresent: [:value | resultStream nextPutAll: value].
self inputValues notEmpty
ifTrue: [resultStream nextPut: $&].
self inputValues keys
do: [:key | self
writeHttpDataFor: key
value: (self inputValues at: key)
on: resultStream]
separatedBy: [resultStream nextPut: $&].
^ resultStream contents! !
!SCSeasideForm methodsFor: 'posting' stamp: 'cds 6/21/2004 01:35'!
writeHttpDataFor: key value: value on: stream
| name |
name := (self inputElementWithId: key) attributeAt: 'name'.
value isString
ifTrue:
[stream
nextPutAll: name;
nextPut: $=;
nextPutAll: value]
ifFalse:
[value do:
[:each |
self
writeHttpDataFor: key
value: each
on: stream]
separatedBy: [stream nextPut: $&]]! !
!SCSeasideForm methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:35'!
inputElementWithId: anId
^inputs detect: [:each | (each attributes at: 'id' ifAbsent: []) = anId]
ifNone: []! !
More information about the Seaside
mailing list