1: ================================================================================
2:
3: Smalltalk.KSU defineClass: #ShellInterface
4: superclass: #{External.ExternalInterface}
5: indexedType: #none
6: private: false
7: instanceVariableNames: 'commandString pipedProcess '
8: classInstanceVariableNames: 'beingRegistry '
9: imports: '
10: private KSU.ShellInterfaceDictionary.*
11: '
12: category: 'KSU-Shell'
13: attributes: #(
14: #(#includeFiles #('defines.h' 'prototypes.h' 'typedefs.h'))
15: #(#includeDirectories #('../../src' '../../src' '../../src'))
16: #(#libraryFiles #('ShellInterface.dylib'))
17: #(#libraryDirectories #('./'))
18: #(#beVirtual false)
19: #(#optimizationLevel #full))
20:
21: ================================================================================
22:
23: KSU.ShellInterface method for 'pipe operation'
24:
25: closeErrorPipe
26:
27: self closePipe: (self pipedProcess memberAt: #error)
28:
29: ------------------------------------------------------------
30:
31: KSU.ShellInterface method for 'pipe operation'
32:
33: closeInputPipe
34:
35: self closePipe: (self pipedProcess memberAt: #input)
36:
37: ------------------------------------------------------------
38:
39: KSU.ShellInterface method for 'pipe operation'
40:
41: closeOutputPipe
42:
43: self closePipe: (self pipedProcess memberAt: #output)
44:
45: ------------------------------------------------------------
46:
47: KSU.ShellInterface method for 'procedures'
48:
49: closePipe: fileDescriptor
50: <C: void closePipe(int fileDescriptor)>
51: ^self externalAccessFailedWith: _errorCode
52:
53: ------------------------------------------------------------
54:
55: KSU.ShellInterface method for 'accessing'
56:
57: commandString
58:
59: ^commandString
60:
61: ------------------------------------------------------------
62:
63: KSU.ShellInterface method for 'accessing'
64:
65: commandString: aString
66:
67: commandString := aString
68:
69: ------------------------------------------------------------
70:
71: KSU.ShellInterface method for 'interface'
72:
73: createProcess: aString
74:
75: | aPipedProcess |
76: aPipedProcess := self startProcess: aString.
77: self defaultProcessManagerClass register: aPipedProcess.
78: ^aPipedProcess
79:
80: ------------------------------------------------------------
81:
82: KSU.ShellInterface method for 'defaults'
83:
84: defaultEncoding
85:
86: ^#UTF_8
87:
88: ------------------------------------------------------------
89:
90: KSU.ShellInterface method for 'defaults'
91:
92: defaultProcessManagerClass
93:
94: ^KSU.ShellProcessManager
95:
96: ------------------------------------------------------------
97:
98: KSU.ShellInterface method for 'defaults'
99:
100: defaultReadSize
101:
102: ^1024
103:
104: ------------------------------------------------------------
105:
106: KSU.ShellInterface method for 'procedures'
107:
108: exitProcess: aProcess
109: <C: int exitProcess(PipedProcess * aProcess)>
110: ^self externalAccessFailedWith: _errorCode
111:
112: ------------------------------------------------------------
113:
114: KSU.ShellInterface method for 'procedures'
115:
116: exitProcessWithoutWait: aProcess
117: <C: void exitProcessWithoutWait(PipedProcess * aProcess)>
118: ^self externalAccessFailedWith: _errorCode
119:
120: ------------------------------------------------------------
121:
122: KSU.ShellInterface method for 'finalization'
123:
124: finalize
125:
126: self pipedProcess: nil.
127: self defaultProcessManagerClass garbageCollect
128:
129: ------------------------------------------------------------
130:
131: KSU.ShellInterface method for 'initialize-release'
132:
133: initialize
134:
135: commandString := nil.
136: pipedProcess := nil
137:
138: ------------------------------------------------------------
139:
140: KSU.ShellInterface method for 'interface'
141:
142: input: inputString
143:
144: self writeTo: (self pipedProcess memberAt: #input)
145: with: (inputString asCStringEncoding: self defaultEncoding)
146:
147: ------------------------------------------------------------
148:
149: KSU.ShellInterface method for 'accessing'
150:
151: isActive
152:
153: ^self pipedProcess isNil not
154:
155: ------------------------------------------------------------
156:
157: KSU.ShellInterface method for 'interface'
158:
159: output
160:
161: | aCollection isTerminal aBoolean byteArray outputString |
162: aCollection := OrderedCollection new.
163: isTerminal := false.
164: aBoolean := true.
165: [aBoolean] whileTrue:
166: [| aPointer temporaryArray |
167: aPointer := self readFrom: (self pipedProcess memberAt: #output) with: self defaultReadSize.
168: aPointer isNull
169: ifTrue:
170: [isTerminal := true.
171: aBoolean := false]
172: ifFalse:
173: [temporaryArray := aPointer primCopyCStringFromHeap: aPointer datum pointerKind: aPointer type.
174: temporaryArray isEmpty ifTrue: [aBoolean := false] ifFalse: [aCollection addAll: temporaryArray]]].
175: byteArray := ByteArray new: aCollection size.
176: aCollection doWithIndex: [:aByte :anIndex | byteArray at: anIndex put: aByte].
177: outputString := (byteArray withEncoding: self defaultEncoding) readStream contents.
178: (outputString isEmpty and: [isTerminal]) ifTrue: [^nil].
179: ^outputString
180:
181: ------------------------------------------------------------
182:
183: KSU.ShellInterface method for 'interface'
184:
185: outputCompletely
186:
187: | aStream aBoolean outputString |
188: aStream := String new writeStream.
189: aBoolean := true.
190: [aBoolean] whileTrue:
191: [self output
192: ifNil: [aBoolean := false]
193: ifNotNil:
194: [:temporaryString |
195: aStream nextPutAll: temporaryString.
196: Processor yield]].
197: outputString := aStream contents.
198: aStream close.
199: ^outputString
200:
201: ------------------------------------------------------------
202:
203: KSU.ShellInterface method for 'accessing'
204:
205: pipedProcess
206:
207: ^pipedProcess
208:
209: ------------------------------------------------------------
210:
211: KSU.ShellInterface method for 'types'
212:
213: PipedProcess
214: <C: typedef struct {
215: int processId, input, output, error;
216: } PipedProcess>
217:
218: ------------------------------------------------------------
219:
220: KSU.ShellInterface method for 'accessing'
221:
222: pipedProcess: aProcess
223:
224: pipedProcess := aProcess
225:
226: ------------------------------------------------------------
227:
228: KSU.ShellInterface method for 'procedures'
229:
230: readCharFrom: fileDescriptor
231:
232: <C: const unsigned char * readCharFrom(int fileDescriptor)>
233: ^self externalAccessFailedWith: _errorCode
234:
235: ------------------------------------------------------------
236:
237: KSU.ShellInterface method for 'procedures'
238:
239: readFrom: fileDescriptor with: length
240:
241: <C: const unsigned char * readFrom(int fileDescriptor, int length)>
242: ^self externalAccessFailedWith: _errorCode
243:
244: ------------------------------------------------------------
245:
246: KSU.ShellInterface method for 'procedures'
247:
248: returnNull
249:
250: <C: int * returnNull(void)>
251: ^self externalAccessFailedWith: _errorCode
252:
253: ------------------------------------------------------------
254:
255: KSU.ShellInterface method for 'procedures'
256:
257: sendEOF: fileDescriptor
258:
259: <C: int sendEOF(int fileDescriptor)>
260: ^self externalAccessFailedWith: _errorCode
261:
262: ------------------------------------------------------------
263:
264: KSU.ShellInterface method for 'procedures'
265:
266: startProcess: aString
267:
268: <C: PipedProcess * startProcess(const unsigned char * aString)>
269: ^self externalAccessFailedWith: _errorCode
270:
271: ------------------------------------------------------------
272:
273: KSU.ShellInterface method for 'procedures'
274:
275: touchFile: filename
276:
277: <C: void startProcess(const unsigned char * filename)>
278: ^self externalAccessFailedWith: _errorCode
279:
280: ------------------------------------------------------------
281:
282: KSU.ShellInterface method for 'procedures'
283:
284: writeTo: fileDescriptor with: aString
285: <C: void writeTo(int fileDescriptor, const unsigned char * aString)>
286: ^self externalAccessFailedWith: _errorCode
287:
288: ================================================================================
289:
290: KSU.ShellInterface class
291: instanceVariableNames: 'beingRegistry '
292:
293: ================================================================================
294:
295: KSU.ShellInterface class method for 'instance creation'
296:
297: command: aString
298:
299: | anInterface aPipedProcess |
300: anInterface := (super new)
301: initialize;
302: commandString: aString;
303: yourself.
304: beingRegistry ifNil: [beingRegistry := WeakDictionary new].
305: beingRegistry at: anInterface hash put: anInterface.
306: aPipedProcess := anInterface createProcess: anInterface commandString.
307: ^anInterface
308: pipedProcess: aPipedProcess;
309: yourself
310:
311: ================================================================================
This document was generated by KSU.TextDoclet on 2013/02/22 at 01:01:06.