[Seaside] An absolutely trivial GOODS browser

C. David Shaffer cdshaffer at acm.org
Thu May 13 19:39:02 CEST 2004


Attached are two .st files (load Components first) which comprise a very 
simple GOODS database browser.  I don't like the CGI-based one included 
with GOODS and thought maybe others didn't either.  Anyway, use it, 
change it, ignore it, whatever :-)

Keep in mind that the view of the DB isn't refreshed unless you press 
the refresh link.  Also keep in mind that the inspector's "path" might 
be holding on to a bogus object after a refresh.  It is often wise to go 
back to the root at that point.  Maybe in my next release I'll try to 
make that smarter...

Requires Seaside 2.5a2 since it subclasses a decoration.

-------------- next part --------------
WAComponent subclass: #SCLoginView
	instanceVariableNames: 'username password '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SC-Components'!

!SCLoginView methodsFor: 'rendering' stamp: 'cds 5/12/2004 12:59'!
renderContentOn: html 
	html
		form: [html
				table: [html
						tableRow: [html tableData: 'Username/e-mail address:'.
							html
								tableData: [html textInputOn: #username of: self]].
					html
						tableRow: [html tableData: 'Password:'.
							html
								tableData: [html
										passwordInputWithCallback: [:aString | self password: aString]]].
					html
						tableRow: [html tableData: ' '.
							html
								tableData: [html
										submitButtonWithAction: [self login]]]]]! !


!SCLoginView methodsFor: 'actions' stamp: 'cds 5/13/2004 12:34'!
login
	self validate ifTrue: [self answer: username -> password]! !

!SCLoginView methodsFor: 'actions' stamp: 'cds 5/13/2004 12:36'!
validate
	^ username notNil
		and: [password notNil
				and: [username notEmpty
						and: [password notEmpty]]]! !


!SCLoginView methodsFor: 'accessing' stamp: 'cds 5/9/2004 19:35'!
password: aString
	password _ aString! !

!SCLoginView methodsFor: 'accessing' stamp: 'cds 5/9/2004 19:37'!
username
	^username! !

!SCLoginView methodsFor: 'accessing' stamp: 'cds 5/9/2004 19:35'!
username: aString
	username _ aString! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SCLoginView class
	instanceVariableNames: ''!

!SCLoginView class methodsFor: 'seaside' stamp: 'cds 5/9/2004 19:36'!
canBeRoot
	^true! !
-------------- next part --------------
WATask subclass: #SCDatabaseInspectorTask
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SC-DatabaseInspector'!
!SCDatabaseInspectorTask commentStamp: 'cds 5/13/2004 13:32' prior: 0!
A Seaside task for inspecting a GOODS database.  You may want to look at the following methods:

	skipLogin
	username
	password!


!SCDatabaseInspectorTask methodsFor: 'actions' stamp: 'cds 5/13/2004 12:30'!
connect
	^KKDatabase onHost: 'localhost' port: 6100.! !

!SCDatabaseInspectorTask methodsFor: 'actions' stamp: 'cds 5/13/2004 13:30'!
login
	| view auth |
	self skipLogin
		ifTrue: [^ self connect].
	view _ SCLoginView new.
	auth _ self call: view.
	auth
		ifNil: [^ nil].
	^ (auth key = self username
			and: [auth value = self password])
		ifTrue: [self connect]! !

!SCDatabaseInspectorTask methodsFor: 'actions' stamp: 'cds 5/13/2004 13:30'!
password
	^'put your password here'! !

!SCDatabaseInspectorTask methodsFor: 'actions' stamp: 'cds 5/13/2004 13:29'!
skipLogin
	"During development it is easier to not have to log in each time.  Answer true here if you want to skip the login process, false otherwise."
	^ true! !

!SCDatabaseInspectorTask methodsFor: 'actions' stamp: 'cds 5/13/2004 13:30'!
username
	^ 'put your username here'! !


!SCDatabaseInspectorTask methodsFor: 'rendering' stamp: 'cds 5/13/2004 13:14'!
go
	| db insp decor |
	self
		isolate: [[(db _ self login) isNil]
				whileTrue: [self inform: 'Invalid login, try again.'].
			insp _ WAInspector on: db root.
			decor _ SCDatabaseWindowDecoration new title: 'Database inspector'; database: db.
			insp
				addDecoration: decor.
			self call: insp.
			db logout]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SCDatabaseInspectorTask class
	instanceVariableNames: ''!

!SCDatabaseInspectorTask class methodsFor: 'class initialization' stamp: 'cds 5/13/2004 13:28'!
initialize
	self registerAsApplication: 'databaseInspector'! !


!SCDatabaseInspectorTask class methodsFor: 'seaside' stamp: 'cds 5/13/2004 12:26'!
canBeRoot
	^true! !


WAWindowDecoration subclass: #SCDatabaseWindowDecoration
	instanceVariableNames: 'database '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SC-DatabaseInspector'!

!SCDatabaseWindowDecoration methodsFor: 'as yet unclassified' stamp: 'cds 5/13/2004 13:13'!
database: aDatabase
	database _ aDatabase! !

!SCDatabaseWindowDecoration methodsFor: 'as yet unclassified' stamp: 'cds 5/13/2004 13:13'!
refresh
	database refresh! !

!SCDatabaseWindowDecoration methodsFor: 'as yet unclassified' stamp: 'cds 5/13/2004 13:11'!
renderCloseButtonOn: html 
	html
		anchorWithAction: [self refresh]
		text: 'refresh'.
	html space.
	super renderCloseButtonOn: html! !

SCDatabaseInspectorTask initialize!


More information about the Seaside mailing list