Skip to content

Commit e5aa151

Browse files
dalehenrichdalehenrich
committed
checkpoint ... restructuring superDoit and GsDevKit_SuperDoit directories
1 parent 21a1381 commit e5aa151

File tree

352 files changed

+3376
-1
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

352 files changed

+3376
-1
lines changed

‎bin/defSUPERDOIT_PATH.env

+1-1
Original file line numberDiff line numberDiff line change
@@ -8,5 +8,5 @@ pushd "$( dirname "${BASH_SOURCE[0]}" )" >& /dev/null
88
export GS_HOME=`pwd`
99
popd >& /dev/null
1010
# put tests in the path for the near term ... remove before general release
11-
export PATH="$GS_HOME/superdoit_devkit/bin":"$GS_HOME/superdoit_devkit/examples":"$GS_HOME/superdoit_devkit/utils":"$GS_HOME/superdoit_devkit/tests":"$GS_HOME/bin":$PATH
11+
export PATH="$GS_HOME/bin":"$GS_HOME/shared/gemstone/bin":"$GS_HOME/shared/gemstone/repos/superDoit/bin":$PATH
1212

‎shared/gemstone/bin/contexttest

+35
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
%
4+
usage
5+
-----
6+
USAGE $basename [--help | -h] [stoneName]
7+
8+
DESCRIPTION
9+
Script to test working with environments and stone contexts (groups of environment variables)
10+
11+
OPTIONS
12+
-h, --help display usage message
13+
--debug display debugging messages
14+
15+
EXAMPLES
16+
$basename --help
17+
$basename --debug myStone
18+
-----
19+
%
20+
method
21+
testContext
22+
self stderr nextPutAll: 'PWD: ', (System gemEnvironmentVariable: 'PWD') asString; cr.
23+
%
24+
method
25+
stoneContext
26+
27+
%
28+
method
29+
findLocalStone
30+
"Search from PWD up through the directory tree to find info.stone"
31+
%
32+
doit
33+
self testContext.
34+
self noResult
35+
%

‎shared/gemstone/bin/newextent

+109
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
gsListResult
4+
%
5+
usage
6+
-----
7+
USAGE $basename stone-name [snapshot-file] [mime-type]
8+
9+
DESCRIPTION
10+
Copy a new extent to the stones extent directory
11+
12+
OPTIONS
13+
-h, --help display usage message
14+
15+
EXAMPLES
16+
$basename --help
17+
$basename myStone
18+
$basename myStone /opt/snapshots/mySnapshop.dbf
19+
$basename myStone /opt/snapshots/mySnapshot.dbf.gz x-gzip
20+
-----
21+
%
22+
method
23+
newExtent
24+
| stream stoneDirectory extentFile |
25+
stream := self stderr.
26+
self positionalArgs size == 0 ifTrue: [
27+
^ Error signal: 'Wrong number of arguments (' , self positionalArgs size printString , ')' ].
28+
stoneDirectory := self gs_stoneDirectory.
29+
extentFile := stoneDirectory / 'extents' / 'extent0.dbf'.
30+
extentFile exists
31+
ifTrue: [ extentFile delete ].
32+
self mediaType = 'x-gzip'
33+
ifTrue: [ self gunzipSnapshotExtent: stoneDirectory ]
34+
ifFalse: [ self copySnapshotExtent: stoneDirectory ].
35+
36+
^ self noResult
37+
%
38+
method
39+
mediaType
40+
self positionalArgs size < 3 ifTrue: [ ^ 'octet-stream' ].
41+
^ self positionalArgs at: 3
42+
%
43+
method
44+
copySnapshotExtent: stoneDirectory
45+
"use copydbf, so that any corruption in the extent file can be found at the outset"
46+
47+
self copySnapshotExtent: self snapshotFile to: stoneDirectory for: self gsVers
48+
%
49+
method
50+
copySnapshotExtent: snapshotExtentFile to: stoneDirectory for: aGsVersionString
51+
"use copydbf, so that any corruption in the extent file can be found at the outset"
52+
53+
| extentFile argsArray cmdPath |
54+
self stderr nextPutAll: ('Copying extent file: ' , snapshotExtentFile pathString printString); cr.
55+
extentFile := stoneDirectory / 'extents' / 'extent0.dbf'.
56+
cmdPath := (aGsVersionString beginsWith: '2.4')
57+
ifTrue: [
58+
"cannot use copydbf to copy extent from product tree, so unconditionally use `cp`"
59+
'/bin/cp' ]
60+
ifFalse: [ (self gemstoneBin / 'copydbf') pathString ].
61+
argsArray := {(snapshotExtentFile pathString). (extentFile pathString)}.
62+
self stderr nextPutAll: (self runShellCommand: cmdPath args: argsArray); cr.
63+
OSProcess command: 'chmod +w "' , extentFile pathString, '"'
64+
%
65+
method
66+
gs_stonesDirectory
67+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/server/stones') asFileReference
68+
%
69+
method
70+
gs_stoneDirectory
71+
^ self gs_stonesDirectory / self stoneName
72+
%
73+
method
74+
stoneName
75+
^ self positionalArgs at: 1
76+
%
77+
method
78+
stoneInfoFilename
79+
^ 'info.ston'
80+
%
81+
method
82+
gs_binDirectory
83+
^ (System gemEnvironmentVariable: 'GEMSTONE'), '/bin/'
84+
%
85+
method
86+
gsListResult
87+
^ gsListResult ifNil: [ gsListResult := GsHostProcess execute: self gs_binDirectory, 'gslist -lc' ]
88+
%
89+
method
90+
doit
91+
"override doit method, because ChildError does not exist in 3.6.0"
92+
[
93+
self getAndVerifyOptions == self noResult
94+
ifTrue: [ ^ self noResult ].
95+
^ self theDoit
96+
]
97+
on: Error
98+
do: [ :ex |
99+
((self respondsTo: #'debug') and: [ self debug ])
100+
ifTrue: [ ex pass ].
101+
self
102+
exit: ((ex respondsTo: #stderr)
103+
ifTrue: [ ex stderr asString trimBoth ]
104+
ifFalse: [ ex messageText ])
105+
withStatus: 1 "does not return" ].
106+
%
107+
doit
108+
self newExtent
109+
%

‎shared/gemstone/bin/products

+69
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
installedProducts
4+
%
5+
usage
6+
-----
7+
USAGE $basename [--help | -h]
8+
9+
DESCRIPTION
10+
Provide information on the downloaded GemStone versions.
11+
12+
OPTIONS
13+
-h, --help display usage message
14+
15+
EXAMPLES
16+
$basename --help
17+
$basename
18+
-----
19+
%
20+
method
21+
produceProductsReport
22+
| stream |
23+
stream := self stderr.
24+
self installedProductsReportOn: stream
25+
%
26+
method
27+
installedProductsReportOn: stream
28+
stream
29+
nextPutAll: 'Installed Products:';
30+
cr.
31+
self installedProducts keys asSortedCollection
32+
do: [ :gsVers |
33+
stream
34+
tab;
35+
nextPutAll: gsVers;
36+
cr ]
37+
%
38+
method
39+
installedProducts
40+
installedProducts
41+
ifNil: [
42+
installedProducts := Dictionary new.
43+
self gs_productsDirectory directories
44+
do: [ :productDir |
45+
| dirName |
46+
dirName := productDir basename.
47+
(dirName indexOfSubCollection: 'GemStone64Bit') == 1
48+
ifTrue: [
49+
| productVersion dashIndex |
50+
dashIndex := dirName indexOf: $-.
51+
productVersion := dirName copyFrom: 'GemStone64Bit' size + 1 to: dashIndex - 1.
52+
installedProducts at: productVersion put: productDir ]
53+
ifFalse: [
54+
(dirName indexOfSubCollection: 'GemBuilderC') == 1
55+
ifTrue: [
56+
| productVersion dashIndex |
57+
dashIndex := dirName indexOf: $-.
58+
productVersion := dirName copyFrom: 'GemBuilderC' size + 1 to: dashIndex - 1.
59+
installedProducts at: productVersion put: productDir ] ] ] ].
60+
^ installedProducts
61+
%
62+
method
63+
gs_productsDirectory
64+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/shared/downloads/products') asFileReference
65+
%
66+
doit
67+
self produceProductsReport.
68+
^ self noResult
69+
%

‎shared/gemstone/bin/restartnetldi

+149
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,149 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
%
4+
usage
5+
-----
6+
USAGE: restartnetldi [-h] <stone-name>
7+
8+
DESCRIPTION
9+
Restart a running netldi process.
10+
11+
OPTIONS
12+
-h, --help display usage message
13+
14+
EXAMPLES
15+
$basename -h
16+
$basename myStoneName
17+
-----
18+
%
19+
method
20+
restartNetldi
21+
"If GemStone version if >= 3.3 netldi supports restarting with -r.
22+
Older version need to be stopped and then started using the same arguments used to start it the first time"
23+
24+
| result netldiArgs |
25+
self stderr nextPutAll: 'SESS_HOME: ', (System gemEnvironmentVariable: 'GS_SYS_SESSIONS').
26+
self stoneInfo gsVers >= '3.3.0' ifTrue: [
27+
result := GsHostProcess execute: (self gs_binDirectory / 'startnetldi ') fullPath asString, ' -r ', self sessionDescription netLDI.
28+
self stderr nextPutAll: result.
29+
] ifFalse: [
30+
result := GsHostProcess execute: (self gs_devKitBinDirectory / 'stopNetldi ') fullPath asString, ' ', self stoneName.
31+
self stderr nextPutAll: result.
32+
netldiArgs := self netldiArgsStringFromArray: self netldiArgs.
33+
result := GsHostProcess execute: (self gs_devKitBinDirectory / 'startNetldi ') fullPath asString, ' ', netldiArgs.
34+
self stderr nextPutAll: result.
35+
].
36+
%
37+
method
38+
netldiArgs
39+
| sess netldiArgs |
40+
sess := self sessionDescription.
41+
netldiArgs := OrderedCollection new.
42+
self netldiArgsOn: netldiArgs.
43+
(self scriptArgs size = 1 or: [ self scriptArgs size = 2 and: [ self privateRestart ] ])
44+
ifTrue: [
45+
self privateRestart ifTrue: [ netldiArgs add: '-r' ].
46+
sess netldiArgsOn: netldiArgs.
47+
]
48+
ifFalse: [
49+
netldiArgs
50+
addAll: (self scriptArgs copyFrom: 3 to: self scriptArgs size);
51+
add: sess netLDI
52+
].
53+
^ netldiArgs
54+
%
55+
method
56+
netldiArgsOn: netldiArgs
57+
| logDir |
58+
logDir := self gs_logDirectory.
59+
netldiArgs
60+
add: '-l';
61+
add: (logDir / 'netldi.log') fullPath asString
62+
%
63+
method
64+
netldiArgsStringFromArray: netldiArgsArray
65+
^ String streamContents: [ :stream |
66+
netldiArgsArray
67+
do: [ :item | stream nextPutAll: item asString ]
68+
separatedBy: [ stream space ]
69+
]
70+
%
71+
method
72+
sessionDescription
73+
^ self
74+
sessionDescriptionIfAbsent: [ :sessionDescriptionReference |
75+
Error signal:
76+
'Session description file ' , sessionDescriptionReference pathString printString , ' for ' , self stoneName printString
77+
, ' not found.' ]
78+
%
79+
method
80+
sessionDescriptionIfAbsent: absentBlock
81+
^self sessionDescriptionFor: self stoneName ifAbsent: absentBlock
82+
%
83+
method
84+
sessionDescriptionFor: aStoneName ifAbsent: absentBlock
85+
| sessionDescriptionReference |
86+
sessionDescriptionReference := self sessionDescriptionHome / aStoneName.
87+
sessionDescriptionReference exists
88+
ifFalse: [ ^ absentBlock value: sessionDescriptionReference ].
89+
^ TDSessionDescription importFrom: sessionDescriptionReference pathString
90+
%
91+
method
92+
sessionDescriptionHome
93+
^ (System gemEnvironmentVariable: 'GS_SYS_SESSIONS') asFileReference
94+
%
95+
method
96+
gs_binDirectory
97+
^ ((System gemEnvironmentVariable: 'GEMSTONE'), '/bin') asFileReference
98+
%
99+
method
100+
gs_logDirectory
101+
^ (System gemEnvironmentVariable: 'GEMSTONE_LOGDIR') asFileReference
102+
%
103+
method
104+
gs_stonesDirectory
105+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/server/stones') asFileReference
106+
%
107+
method
108+
gs_devKitBinDirectory
109+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/bin') asFileReference
110+
%
111+
method
112+
gs_stoneDirectory
113+
^ self gs_stonesDirectory / self stoneName
114+
%
115+
method
116+
stoneInfoClass
117+
^ GsDevKitStoneInfo
118+
%
119+
method
120+
stoneInfoFilename
121+
^ 'info.ston'
122+
%
123+
method
124+
stoneInfo
125+
^ self stoneInfoClass importFrom: self gs_stoneDirectory / self stoneInfoFilename
126+
%
127+
method
128+
stoneName
129+
^ self positionalArgs at: 1
130+
%
131+
method
132+
doit
133+
"override doit method, because ChildError does not exist in 3.6.0"
134+
[
135+
self getAndVerifyOptions == self noResult
136+
ifTrue: [ ^ self noResult ].
137+
^ self theDoit
138+
] on: Error do: [:ex |
139+
self debug ifTrue: [ ex pass ].
140+
self
141+
exit: ((ex respondsTo: #stderr)
142+
ifTrue: [ ex stderr asString trimBoth ]
143+
ifFalse: [ ex messageText ])
144+
withStatus: 1 "does not return" ].
145+
%
146+
doit
147+
self restartNetldi.
148+
^ self noResult
149+
%

0 commit comments

Comments
 (0)