#BUGFIX by cg
class: AbstractFileBrowser
changed: #currentFileNameHolder
endless loop if file not present.
"{ 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 blessingLevel'
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
Object subclass:#StoreProjectChangeSetReader
instanceVariableNames:'browser dbConnection bundleOrPackage version changeSet'
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:'image specs'!
bundleImage
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self bundleImage inspect
ImageEditor openOnClass:self andSelector:#bundleImage
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:'Tools::StoreProjectBrowser class bundleImage'
ifAbsentPut:[(Depth8Image new) width: 17; height: 16; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BP$IBP$IBP$IBP$IBP@@@@@INS$9A!!\$BQ$YFRDI@@@@@@$9KSX?MP4IFP@*K0$@@@@@BS$C
E@PIEP$YJ#0VBP@@@@@IA!!PDBQ$IBSL<LP8I@@@@@@$WI@4IFQ$3N \XI $@@@@@BS SGP$@J!!DGL!!@^BP@@@@@IAQ,%BRDIBTMDN3\I@@@@@@%AH2,ABQHI
JS,(K $@@@@@BT@4OP(Z@ $*LB@''BP@@@@@IJ00\KC8KBRH_C4HI@@@@@@$IBP$IBP$IBP$IBP$@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@b') ; colorMapFromArray:#[229 232 255 221 221 160 202 203 179 252 253 186 222 223 196 240 241 213 247 248 218 219 223 255 255 255 255 0 0 0 216 216 156 200 201 178 209 210 185 219 220 194 192 194 214 178 181 214 209 214 255 224 226 255 212 211 153 240 241 177 249 249 184 217 217 192 194 196 214 245 246 217 214 219 255 241 243 255 212 212 153 235 236 173 206 207 183 216 217 192 186 189 214 181 184 214 194 200 255 227 229 255 199 204 255 231 231 169 245 245 181 214 214 190 189 192 214 178 182 214 199 205 255 231 233 255 227 230 255 226 225 164 204 205 181 255 255 189 180 184 214 196 198 214 198 205 255 219 222 255 215 218 255 240 241 255 225 226 164 245 245 180 253 252 187 183 187 214 243 244 215 249 249 219 223 226 255 204 209 255 223 227 255 221 220 160 202 202 179 250 249 184 235 237 208 238 239 211 176 180 214 215 219 255 210 214 255]; mask:((Depth1Image new) width: 17; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@A?@@A?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?@@A?@@A?') ; yourself); yourself]
!
packageImage
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self packageImage inspect
ImageEditor openOnClass:self andSelector:#packageImage
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:'Tools::StoreProjectBrowser class packageImage'
ifAbsentPut:[(Depth8Image new) width: 17; height: 16; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BL#H2L#H2L#@@@@@@@@@@@#ECPRHB0CDQ #@@@@@@@@H20,KB0,KB0XH"L@@@@@@BLT
A@,''KCLJG0T)H0@@@@@#K!!PTEB TEAP[AR<#@@@@@BLYE18%GQ@IJ2$ECBL@@@@@H24ALPD]@PDHMPTZH0@@@@@#I"P$IA4OIAXSARL@@@@@@BL2@B(0GP\N
A2D#@@@@@@@@H0H\M!!T]CPX6H0@@@@@@@@@@H2L#H2L#H2L@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@b') ; colorMapFromArray:#[185 185 131 197 197 141 211 212 153 238 239 175 253 253 187 109 109 109 180 180 127 184 185 132 197 198 141 202 203 146 234 234 172 250 249 185 155 155 108 179 180 128 184 185 131 191 191 137 203 202 146 235 235 171 250 250 185 154 155 109 255 255 255 179 179 128 191 190 136 203 202 145 232 232 170 249 249 184 149 149 105 173 172 122 180 179 128 136 136 136 202 202 146 231 231 169 247 247 182 149 150 104 172 172 122 0 0 0 191 191 136 202 202 145 230 231 169 246 246 181 194 194 194 167 167 118 185 185 132 203 203 145 165 165 165 241 241 177 255 255 189 160 160 113 185 184 131 197 197 142 221 221 160 238 238 175 253 253 188 161 161 113 180 180 128]; mask:((Depth1Image new) width: 17; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@A?@@A?@?1?A?9?C?9?G?9?O?9?O?9?O?9?O?1?O?!!?O?A?G>A?@@A?@@A?@@A?') ; yourself); yourself]
! !
!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: 'Browse'
itemValue: versionsListMenuBrowse
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|
selIndex := selectedVersionHolder value.
selIndex isNil ifTrue:[
self commentTextHolder value:nil.
selectedVersion := nil.
] ifFalse:[
selectedVersion := versionsList value at:selIndex.
self withReadCursorDo:[
self updateBlessingCommentFor:selectedVersion
].
]
! !
!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
^ self getBlob:id withPrefix:nil
!
getBlob:id withPrefix:prefixOrNil
|item cursor row blobType blobData rawData|
item := Set new.
cursor := connection
execute:('SELECT blobtype,blobdata FROM tw_blob where primarykey = %1;' bindWith:id)
release:false.
cursor next notNil ifTrue:[
row := cursor rowAsArray.
blobType := (row at:1).
rawData := (row at:2).
blobData := Base64Coder decode:rawData.
].
cursor release.
blobType < 0 ifTrue:[
"/ this data is a prefix...
self halt.
^ self getBlob:(blobType negated) withPrefix:blobData
].
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.
SQL::ODBCError handle:[:ex |
^ nil.
] do:[
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 name,version,username,timestamp,commentid,primarykey,blessinglevel
FROM ',table,
"/ ' WHERE name = ''',aBundle name,''' ',
';'
release:false.
[cursor next notNil] whileTrue:[
|v name version username timestamp commentid primarykey blessinglevel|
row := cursor rowAsArray.
Transcript showCR:row.
name := row at:1.
version := row at:2.
username := row at:3.
timestamp := row at:4.
commentid := row at:5.
primarykey := row at:6.
blessinglevel := row at:7.
name = aBundle name ifTrue:[
v := PundleVersion new.
v pundle:aBundle version:version user:username.
v timestampInt:timestamp commentId:commentid.
v blessingLevel:blessinglevel.
v id:primarykey.
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'.
!
versionsListMenuBrowse
|reader changeSet environment|
reader := StoreProjectChangeSetReader new.
reader
browser:self dbConnection:connection
bundleOrPackage:selectedBundleOrPackage version:selectedVersion.
changeSet :=reader changeSet.
ChangeSetBrowser openOn:changeSet.
self halt.
environment := StoreProjectEnvironment for:selectedVersion connection:connection.
SystemBrowser
openOn:environment
label:(resources string:'%1' with:selectedBundleOrPackage name , ' ' , selectedVersion version)
!
versionsListMenuLoad
self halt.
!
versionsListMenuUpdate
self halt.
! !
!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'!
blessingLevel
^ blessingLevel
!
blessingLevel:something
blessingLevel := something.
!
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::StoreProjectChangeSetReader methodsFor:'accessing'!
browser:browserArg dbConnection:dbConnectionArg bundleOrPackage:bundleOrPackageArg version:versionArg
browser := browserArg.
dbConnection := dbConnectionArg.
bundleOrPackage := bundleOrPackageArg.
version := versionArg.
! !
!StoreProjectBrowser::StoreProjectChangeSetReader methodsFor:'reading'!
allClassesDo:aBlock
|packageId cursor row entries classes|
packageId := bundleOrPackage id.
entries := OrderedCollection new.
cursor := dbConnection
execute:('SELECT classref,metaclassref,definitionorder FROM tw_pkgclasses WHERE packageref = %1'
bindWith:packageId)
release:false.
[cursor next notNil] whileTrue:[
row := cursor rowAsObject.
entries add:row.
].
cursor release.
classes := entries collect:[:entry |
|records classRecord metaclassRecord|
"/ entry classref
"/ entry metaclassref
"/ entry definitionorder
cursor := dbConnection
execute:('SELECT name,definitionid,commentid,environmentstring,superclass
FROM tw_classrecord WHERE primarykey = %1'
bindWith:entry classref)
release:false.
records := OrderedCollection new.
[cursor next notNil] whileTrue:[
row := cursor rowAsObject.
records add:row.
].
cursor release.
self assert:(records size == 1).
classRecord := records first.
cursor := dbConnection
execute:('SELECT name,definitionid,commentid,environmentstring,superclass
FROM tw_classrecord WHERE primarykey = %1'
bindWith:entry metaclassref)
release:false.
records := OrderedCollection new.
[cursor next notNil] whileTrue:[
row := cursor rowAsObject.
records add:row.
].
cursor release.
self assert:(records size == 1).
metaclassRecord := records first.
{ classRecord. metaclassRecord. entry definitionorder }
].
!
changeSet
"build a changeSet from the bundle or package
Return the changeSet."
changeSet := ChangeSet new.
self fetchClassDefinitions.
"/ changesFromStream:aStream
"/ for:changeSet
"/ reader:(ChangeFileReader new)
"/ do:[:aChange :lineNumberOrNil :posOrNil |
"/ changeSet add:aChange.
"/ (aConditionBlock value:aChange) ifFalse:[^ changeSet].
"/ ].
^ changeSet
!
fetchClassDefinitions
|packageId cursor row entries classes change|
packageId := version id.
entries := OrderedCollection new.
cursor := dbConnection
execute:('SELECT classref,metaclassref,definitionorder FROM tw_pkgclasses WHERE packageref = %1'
bindWith:packageId)
release:false.
[cursor next notNil] whileTrue:[
row := cursor rowAsObject.
entries add:row.
].
cursor release.
classes := entries collect:[:entry |
|records classRecord metaclassRecord definitionString|
"/ entry classref
"/ entry metaclassref
"/ entry definitionorder
cursor := dbConnection
execute:('SELECT name,definitionid,commentid,environmentstring,superclass
FROM tw_classrecord WHERE primarykey = %1'
bindWith:entry classref)
release:false.
records := OrderedCollection new.
[cursor next notNil] whileTrue:[
row := cursor rowAsObject.
records add:row.
].
cursor release.
self assert:(records size == 1).
classRecord := records first.
cursor := dbConnection
execute:('SELECT name,definitionid,commentid,environmentstring,superclass
FROM tw_classrecord WHERE primarykey = %1'
bindWith:entry metaclassref)
release:false.
records := OrderedCollection new.
[cursor next notNil] whileTrue:[
row := cursor rowAsObject.
records add:row.
].
cursor release.
self assert:(records size == 1).
metaclassRecord := records first.
change := ClassDefinitionChange new.
definitionString := browser getBlob:(classRecord definitionid).
change source:definitionString.
change className:classRecord name.
"/ change superClassName:metaclassRecord name.
change package:bundleOrPackage name.
changeSet add:change.
{ classRecord. metaclassRecord. entry definitionorder }
].
! !
!StoreProjectBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools__StoreProjectBrowser.st,v 1.13 2009-09-21 21:29:29 cg Exp $'
! !