"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
ApplicationModel subclass:#StoreProjectBrowser
instanceVariableNames:'dbInfo connection commentTextHolder packagesList
selectedVersionHolder versionsList selectedPackageHolder
packagesFilterHolder infoLabelHolder selectedBundleOrPackage
selectedVersion'
classVariableNames:''
poolDictionaries:''
category:'System-SourceCodeManagement'
!
Object subclass:#Pundle
instanceVariableNames:'name'
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
StoreProjectBrowser::Pundle subclass:#Package
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
StoreProjectBrowser::Pundle subclass:#Bundle
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
Object subclass:#PundleVersion
instanceVariableNames:'id pundle version user timestamp comment timestampInt commentId
isBundle'
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
!StoreProjectBrowser class methodsFor:'documentation'!
documentation
"
An experimental first attempt to access a Store database.
As I dont have (and dont want) access to a VW implementation for reference,
the layout and contents of the tables has been guessed.
The goal is to be able to read public domain code from a store DB.
"
!
examples
"
Starting the application:
[exBegin]
Tools::StoreProjectBrowser open
[exEnd]
more examples to be added:
[exBegin]
... add code fragment for
... executable example here ...
[exEnd]
"
! !
!StoreProjectBrowser class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::StoreProjectBrowser andSelector:#windowSpec
Tools::StoreProjectBrowser new openInterface:#windowSpec
Tools::StoreProjectBrowser open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'Tools::StoreProjectBrowser'
name: 'Tools::StoreProjectBrowser'
min: (Point 10 10)
max: (Point 1024 768)
bounds: (Rectangle 0 0 527 369)
menu: mainMenu
)
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'VariableHorizontalPanel1'
layout: (LayoutFrame 0 0 0 0 0 1 -30 1)
snapMode: both
handlePosition: right
component:
(SpecCollection
collection: (
(ViewSpec
name: 'Box1'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Bundles and Packages:'
name: 'Label1'
layout: (LayoutFrame 0 0 0 0 0 1 30 0)
translateLabel: true
adjust: left
)
(InputFieldSpec
name: 'PackageFilterEntryField'
layout: (LayoutFrame 2 0 30 0 -2 1 58 0)
model: packagesFilterHolder
immediateAccept: true
acceptOnReturn: true
acceptOnTab: true
acceptOnLostFocus: true
acceptOnPointerLeave: false
)
(SequenceViewSpec
name: 'PackageList'
layout: (LayoutFrame 0 0 60 0 0 1 0 1)
model: selectedPackageHolder
menu: packageListMenu
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
valueChangeSelector: packageSelectionChanged
useIndex: true
sequenceList: packagesList
)
)
)
)
(ViewSpec
name: 'Box3'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Versions:'
name: 'Label2'
layout: (LayoutFrame 0 0 0 0 0 1 30 0)
translateLabel: true
adjust: left
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0 30 0 0 1 0 1)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'VersionsList'
model: selectedVersionHolder
menu: versionsListMenu
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
valueChangeSelector: versionSelectionChanged
useIndex: true
sequenceList: versionsList
)
(ViewSpec
name: 'Box2'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Comment:'
name: 'Label3'
layout: (LayoutFrame 0 0 0 0 0 1 30 0)
translateLabel: true
adjust: left
)
(TextEditorSpec
name: 'CommentTextEditor'
layout: (LayoutFrame 0 0 30 0 0 1 -1 1)
model: commentTextHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
)
)
)
)
)
)
handles: (Any 0.5 1.0)
)
)
)
)
)
)
handles: (Any 0.5 1.0)
)
(LabelSpec
name: 'InfoLabel'
layout: (LayoutFrame 2 0 -28 1 -1 1 -1 1)
level: -1
translateLabel: true
labelChannel: infoLabelHolder
adjust: left
)
)
)
)
! !
!StoreProjectBrowser class methodsFor:'internationalization'!
resourcePackName
^ 'StoreProjectBrowser'
! !
!StoreProjectBrowser class methodsFor:'menu specs'!
mainMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::StoreProjectBrowser andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(Tools::StoreProjectBrowser mainMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'File'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Fileout As...'
itemValue: menuFileoutAs
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: menuUpdate
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Exit'
itemValue: closeRequest
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Connection'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Connect'
itemValue: menuConnect
translateLabel: true
isVisible: notConnectedHolder
)
(MenuItem
label: 'Disconnect'
itemValue: menuDisconnect
translateLabel: true
isVisible: isConnectedHolder
)
)
nil
nil
)
)
(MenuItem
label: 'Help'
translateLabel: true
startGroup: right
submenu:
(Menu
(
(MenuItem
label: 'Documentation'
itemValue: openDocumentation
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'About this Application...'
itemValue: openAboutThisApplication
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
!
packageListMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::StoreProjectBrowser andSelector:#packageListMenu
(Menu new fromLiteralArrayEncoding:(Tools::StoreProjectBrowser packageListMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Update'
itemValue: menuUpdatePackageList
translateLabel: true
)
)
nil
nil
)
!
versionsListMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::StoreProjectBrowser andSelector:#versionsListMenu
(Menu new fromLiteralArrayEncoding:(Tools::StoreProjectBrowser versionsListMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Load'
itemValue: versionsListMenuLoad
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: versionsListMenuUpdate
translateLabel: true
)
)
nil
nil
)
! !
!StoreProjectBrowser class methodsFor:'startup'!
openOn:aDBInfo
|newApp|
newApp := self new.
newApp allButOpen.
newApp dbInfo:aDBInfo.
newApp open.
^ newApp
! !
!StoreProjectBrowser methodsFor:'actions'!
packageSelectionChanged
|newest|
self withReadCursorDo:[
selectedBundleOrPackage := packagesList value at:(selectedPackageHolder value).
self updateVersionsListFor:selectedBundleOrPackage.
versionsList value notEmptyOrNil ifTrue:[
newest := versionsList value first.
self updateCommentFor:newest
]
].
!
versionSelectionChanged
|selIndex selectedItem|
selIndex := selectedVersionHolder value.
selIndex isNil ifTrue:[
self commentTextHolder value:nil
] ifFalse:[
selectedItem := versionsList value at:selIndex.
self withReadCursorDo:[
self updateBlessingCommentFor:selectedItem
].
]
! !
!StoreProjectBrowser methodsFor:'aspects'!
commentTextHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
commentTextHolder isNil ifTrue:[
commentTextHolder := '' asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ commentTextHolder addDependent:self.
"/ commentTextHolder onChangeSend:#commentTextHolderChanged to:self.
].
^ commentTextHolder.
!
infoLabelHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
infoLabelHolder isNil ifTrue:[
infoLabelHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ infoLabelHolder addDependent:self.
"/ infoLabelHolder onChangeSend:#infoLabelHolderChanged to:self.
].
^ infoLabelHolder.
!
isConnected
^ connection notNil and:[ connection isConnected ].
!
isConnectedHolder
^ [ self isConnected ]
!
notConnectedHolder
^ [ self isConnected not ]
!
packagesFilterHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
packagesFilterHolder isNil ifTrue:[
packagesFilterHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ packagesFilterHolder addDependent:self.
"/ packagesFilterHolder onChangeSend:#packagesFilterHolderChanged to:self.
].
^ packagesFilterHolder.
!
packagesList
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
packagesList isNil ifTrue:[
packagesList := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ packagesList addDependent:self.
"/ packagesList onChangeSend:#packagesListChanged to:self.
].
^ packagesList.
!
selectedPackageHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedPackageHolder isNil ifTrue:[
selectedPackageHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ selectedPackageHolder addDependent:self.
"/ selectedPackageHolder onChangeSend:#selectedPackageHolderChanged to:self.
].
^ selectedPackageHolder.
!
selectedVersionHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedVersionHolder isNil ifTrue:[
selectedVersionHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ selectedVersionHolder addDependent:self.
"/ selectedVersionHolder onChangeSend:#selectedVersionHolderChanged to:self.
].
^ selectedVersionHolder.
!
versionsList
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
versionsList isNil ifTrue:[
versionsList := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ versionsList addDependent:self.
"/ versionsList onChangeSend:#versionsListChanged to:self.
].
^ versionsList.
! !
!StoreProjectBrowser methodsFor:'db access'!
getBlob:id
|item cursor row blobType blobData|
item := Set new.
cursor := connection
execute:'SELECT blobtype,blobdata FROM tw_blob where primarykey = ',id printString,';'
release:false.
cursor next notNil ifTrue:[
row := cursor rowAsArray.
blobType := (row at:1).
blobData := Base64Coder decode:(row at:2).
].
cursor release.
blobType == 1 ifTrue:[
"binary"
^ blobData
].
blobType == 2 ifTrue:[
"string"
^ blobData asString
].
blobType == 3 ifTrue:[
"2-byte string"
self halt.
^ nil
].
self halt.
^ nil
!
getBundles
|items cursor row|
items := Set new.
cursor := connection
execute:'SELECT DISTINCT name FROM tw_bundle;'
release:false.
[cursor next notNil] whileTrue:[
row := cursor rowAsArray.
Transcript showCR:row.
items add:(Bundle new name:(row at:1)).
].
cursor release.
^ items asOrderedCollection sort:[:a :b| a name < b name]
!
getConnection
|session|
dbInfo isNil ifTrue:[
self askForDatabaseInfo
].
session := SQL::ODBCSession new.
session
connectWithUsername:(dbInfo userName)
password:(dbInfo password)
dbname:(dbInfo dbName).
(session isConnected) ifFalse:[
^ nil.
].
^ session.
!
getPackages
|items cursor row|
items := Set new.
cursor := connection
execute:'SELECT DISTINCT name FROM tw_package;'
release:false.
[cursor next notNil] whileTrue:[
row := cursor rowAsArray.
Transcript showCR:row.
items add:(Package new name:(row at:1)).
].
cursor release.
^ items asOrderedCollection sort:[:a :b| a name < b name]
!
getVersionsForBundle:aBundle
^ self getVersionsForBundleOrPackage:aBundle isBundle:true
!
getVersionsForBundleOrPackage:aBundle isBundle:isBundle
|items cursor row table|
connection isNil ifTrue:[^ #() ].
table := isBundle ifTrue:'tw_bundle' ifFalse:'tw_package'.
items := Set new.
cursor := connection
execute:'SELECT version,username,timestamp,commentid,primarykey
FROM ',table,' WHERE name = ''',aBundle name,''';'
release:false.
[cursor next notNil] whileTrue:[
|v|
row := cursor rowAsArray.
Transcript showCR:row.
v := PundleVersion new.
v pundle:aBundle version:(row at:1) user:(row at:2).
v timestampInt:(row at:3) commentId:(row at:4).
v id:(row at:5).
v isBundle:isBundle.
items add:v.
].
cursor release.
^ items asOrderedCollection sort:[:a :b| a isVersionAfter: b]
!
getVersionsForPackage:aPackage
^ self getVersionsForBundleOrPackage:aPackage isBundle:false
!
updateBlessingCommentFor:aPundleVersion
|versionId commentId user comment cursor row recType|
versionId := aPundleVersion id.
recType := aPundleVersion isBundle ifTrue:'B' ifFalse:'P'.
cursor := connection
execute:'SELECT username,commentid FROM tw_blessing
WHERE pkgid = ',versionId printString,' AND rectype = ''',recType,''';'
release:false.
cursor isNil ifTrue:[
commentId :=0
] ifFalse:[
row := cursor next rowAsArray.
cursor release.
user := row at:1.
commentId := row at:2.
].
commentId == 0 ifTrue:[
comment := 'No comment' allItalic
] ifFalse:[
comment := self getBlob:commentId.
comment := comment asCollectionOfSubCollectionsSeparatedBy:Character return.
comment := comment asStringCollection asString.
].
self commentTextHolder value:comment.
!
updateCommentFor:aPundleVersion
|comment id|
id := aPundleVersion commentId.
id == 0 ifTrue:[
comment := 'No comment' allItalic
] ifFalse:[
comment := self getBlob:(aPundleVersion commentId).
].
self commentTextHolder value:comment.
!
updatePackagesList
|bundles packages|
connection isNil ifTrue:[^ self ].
self withReadCursorDo:[
bundles := self getBundles.
packages := self getPackages.
].
packagesList value:(bundles , packages).
!
updateVersionsListFor:aBundleOrPackage
|items|
aBundleOrPackage isBundle ifTrue:[
items := self getVersionsForBundle:aBundleOrPackage
] ifFalse:[
items := self getVersionsForPackage:aBundleOrPackage
].
self selectedVersionHolder value:nil.
versionsList value:items.
! !
!StoreProjectBrowser methodsFor:'help'!
aboutThisApplicationText
^ super aboutThisApplicationText ,
'\\Written by Claus Gittinger, eXept Software AG.' withCRs
! !
!StoreProjectBrowser methodsFor:'initialization & release'!
dbInfo:aDBInfo
|session|
dbInfo := aDBInfo.
session := self getConnection.
(session notNil) ifFalse:[
^ self.
].
connection := session.
self updateInfo.
^ self
!
postOpenWith:aBuilder
super postOpenWith:aBuilder.
self updatePackagesList.
!
release
connection notNil ifTrue:[
connection disconnect.
connection := nil.
]
!
updateInfo
self isConnected ifTrue:[
self window label:('Store Browser: ',dbInfo dbName).
self infoLabelHolder value:('Connected to ',dbInfo dbName).
] ifFalse:[
self window label:'Store Browser'.
self infoLabelHolder value:nil.
]
! !
!StoreProjectBrowser methodsFor:'menu actions'!
askForDatabaseInfo
|defaultInfo|
defaultInfo := StoreSourceCodeManager defaultDBInfo.
defaultInfo dbName isNil ifTrue:[
defaultInfo := StoreSourceCodeManager repositoryInfoPerModule firstIfEmpty:nil.
].
dbInfo := defaultInfo
!
menuConnect
|session|
connection isNil ifTrue:[
session := self getConnection.
(session notNil) ifFalse:[
^ self.
].
connection := session.
self updateInfo.
self updatePackagesList.
]
!
menuDisconnect
connection notNil ifTrue:[
connection disconnect.
connection := nil.
self updateInfo.
]
!
menuFileoutAs
"automatically generated by UIPainter ..."
"*** the code below performs no action"
"*** (except for some feedback on the Transcript)"
"*** Please change as required and accept in the browser."
"action to be added ..."
Transcript showCR:self class name, ': menu action for menuFileoutAs ...'.
!
menuOpen
"This method was generated by the Browser.
It will be invoked when the menu-item 'open' is selected."
"/ change below and add any actions as required here ...
self warn:'no action for ''open'' available.'.
!
menuUpdate
self updatePackagesList
!
openDocumentation
"This method was generated by the Browser.
It will be invoked when the menu-item 'help-documentation' is selected."
"/ change below as required ...
"/ to open an HTML viewer on some document (under 'doc/online/<language>/' ):
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'.
"/ add application-specific help files under the 'doc/online/<language>/help/appName'
"/ directory, and open a viewer with:
"/ HTMLDocumentView openFullOnDocumentationFile:'help/<MyApplication>/TOP.html'.
! !
!StoreProjectBrowser::Pundle methodsFor:'accessing'!
name
^ name
!
name:something
name := something.
! !
!StoreProjectBrowser::Pundle methodsFor:'printing'!
displayString
^ name
! !
!StoreProjectBrowser::Pundle methodsFor:'testing'!
isBundle
^ false
!
isPackage
^ false
! !
!StoreProjectBrowser::Package methodsFor:'testing'!
isPackage
^ true
! !
!StoreProjectBrowser::Bundle methodsFor:'printing'!
displayString
^ name ,' (Bundle)'
! !
!StoreProjectBrowser::Bundle methodsFor:'testing'!
isBundle
^ true
! !
!StoreProjectBrowser::PundleVersion methodsFor:'accessing'!
commentId
^ commentId
!
id
^ id
!
id:something
id := something.
!
isBundle
^ isBundle
!
isBundle:aBoolean
isBundle := aBoolean
!
isPackage
^ isBundle not
!
pundle
^ pundle
!
pundle:pundleArg version:versionArg user:userArg
pundle := pundleArg.
version := versionArg.
user := userArg.
!
timestamp
|deltaSeconds|
timestamp isNil ifTrue:[
"/ to compute the timestamp, we have to do this:
"/ the timestampInt are seconds since 1993 + 10d + 19min + 47sec"
"/ can anyone explain this ????
deltaSeconds := 23*365 * 24*60*60. "/ 23 years
deltaSeconds := deltaSeconds + (233*24*60*60). "/ 10 days
deltaSeconds := deltaSeconds + (19*60). "/ 19 minutes
deltaSeconds := deltaSeconds + (47). "/ 47 seconds
timestamp := Timestamp secondsSince1970:(timestampInt + deltaSeconds).
].
^ timestamp
!
timestampInt:timestampIntArg commentId:commentIdArg
timestampInt := timestampIntArg.
commentId := commentIdArg.
!
user
^ user
!
version
^ version
! !
!StoreProjectBrowser::PundleVersion methodsFor:'comparing'!
isVersionAfter:anotherVersion
|myMajor othersMajor myMinor othersMinor|
myMajor := self majorVersion.
othersMajor := anotherVersion majorVersion.
myMajor > othersMajor ifTrue:[^ true].
myMajor < othersMajor ifTrue:[^ false].
myMinor := self minorVersion.
othersMinor := anotherVersion minorVersion.
myMinor > othersMinor ifTrue:[^ true].
myMinor < othersMinor ifTrue:[^ false].
^ version > anotherVersion version
!
majorVersion
^ Integer readFrom:(version upTo:$:)
!
minorVersion
^ Integer readFrom:((version restAfter:$.) upTo:$.)
! !
!StoreProjectBrowser::PundleVersion methodsFor:'printing'!
displayString
^ version , ' (',user,') ' , self timestamp printString
! !
!StoreProjectBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools__StoreProjectBrowser.st,v 1.9 2009-09-19 14:50:15 cg Exp $'
! !