src/core/external.slate

   1 "The interface and abstract framework on which all external interaction
   2 libraries depend."
   3
   4 prototypes define: #ExternalResource &parents: {Cloneable} &slots:
   5  {#parentResource. "The parent external resource which spawned this resource, or Nil if a root resource."
   6   #handle.      "An ID number perhaps for the struct or the actual low-level object itself."
   7   #readStream.  "What object has read-capabilities for this resource."
   8   #writeStream. "What object has write-capabilities for this resource."
   9   #locator     "An identifying locator for the connection so that it may be closed and re-opened with persistent identity."}.
  10 "Abstract object for representing resources used by the system but
  11 maintained outside of it, such as external storage and network resources."
  12
  13 "The set of resources currently open or that need to be recovered on startup."
  14 ExternalResource traits openResources ::= IdentitySet new.
  15
  16 r@(ExternalResource traits) schedule
  17 "Topologically schedule the resources according to their designated parent resource."
  18 [| schedule children workList |
  19   children := IdentityDictionary new.
  20   workList := Stack new.
  21   r openResources do:
  22     [| :resource |
  23       resource parentResource
  24         ifNil:
  25           [workList push: resource]
  26         ifNotNilDo:
  27           [| :parent |
  28             (children at: parent ifAbsentPut: [IdentitySet new])
  29               include: resource]].
  30   schedule := ExtensibleArray new.
  31   [workList isEmpty]
  32     whileFalse:
  33       [| resource |
  34         resource := workList pop.
  35         schedule addLast: resource.
  36         children at: resource
  37           ifPresent:
  38             [| :children | children do: #(workList push: _) `er]].
  39   schedule
  40 ].
  41
  42 r@(ExternalResource traits) resetStreams
  43 "Resets all the stream connections to and from the resource."
  44 [
  45   r readStream ifNotNilDo: [| :s | s resource := Nil].
  46   r writeStream ifNotNilDo: [| :s | s resource := Nil].
  47   r readStream := r writeStream := Nil.
  48 ].
  49
  50 r@(ExternalResource traits) startup
  51 "The action to be performed to recover the resource on startup.
  52 The default is to open the resource after getting rid of the old handle."
  53 [
  54   r handle := Nil.
  55   r open
  56 ].
  57
  58 r@(ExternalResource traits) shutdown
  59 "The action to be performed to cleanup a resource on shutdown.
  60 The default is to close the resource."
  61 [r close].
  62
  63 r@(ExternalResource traits) enable
  64 "Creates the external resource represented and assigns the handle."
  65 [overrideThis].
  66
  67 r@(ExternalResource traits) open
  68 "Resets/removes any stale I/O objects and then sets up the resource anew."
  69 [
  70   r isOpen
  71     ifTrue: [r connectionFailure]
  72     ifFalse: [r enable. r openResources include: r].
  73   r
  74 ].
  75
  76 r@(ExternalResource traits) reopen
  77 [r isOpen ifFalse: [r enable]].
  78
  79 r@(ExternalResource traits) disable
  80 "Override this method as necessary to destroy an external resource. The default
  81 does nothing."
  82 [].
  83
  84 r@(ExternalResource traits) close
  85 "Disable the resource connection and clear the handle."
  86 [
  87   r isOpen
  88     ifTrue: [r disable.
  89              r handle := Nil.
  90              r openResources remove: r]
  91     ifFalse: [r signalClosed].
  92   r
  93 ].
  94
  95 r@(ExternalResource traits) ensureClosed
  96 "Avoid throwing an error if it is already closed. The caller just wants to
  97 know that it's closed once this is done."
  98 [
  99   r isOpen ifTrue: [r close]
 100 ].
 101
 102 r@(ExternalResource traits) commit
 103 "Commit all pending write-out information to the resource."
 104 [r].
 105
 106 r@(ExternalResource traits) isOpen
 107 "Whether there is considered to be a working connection with the peer."
 108 [
 109   r handle isNotNil
 110 ].
 111
 112 r@(ExternalResource traits) isActive
 113 "Whether both the system and the peer agree that the connection is working."
 114 [
 115   r isOpen
 116 ].
 117
 118 r@(ExternalResource traits) sessionDo: block
 119 "Calls the block with the resource object as input, opening and closing it
 120 transparently in an error-tolerant way. Nesting is handled by detecting
 121 if the resource was open beforehand and not cycling it if so.
 122 The return value of the block is answered if it completes without error."
 123 [| wasOpen |
 124   wasOpen := r isOpen.
 125   [wasOpen ifFalse: [r open].
 126    block applyWith: r]
 127      ensure: [r isOpen ifTrue:
 128        [r commit. wasOpen ifFalse: [r close]]]
 129 ].
 130
 131 r@(ExternalResource traits) restart
 132 "Restart the resource if already active."
 133 [
 134   r isActive ifTrue: [r open]
 135 ].
 136
 137 r@(ExternalResource traits) defaultBufferSize
 138 "The size that a Stream should use for an interaction buffer."
 139 [overrideThis].
 140
 141 r@(ExternalResource traits) read: n from: handle into: array startingAt: start
 142 "The primitive for external input: read N bytes from the resource's handle
 143 at the given start position, placing them in the array (starting at 0)."
 144 [overrideThis].
 145
 146 r@(ExternalResource traits) read: n into: array &startingAt: start
 147 [
 148   r isOpen ifFalse: [r signalClosed].
 149   r read: n from: r handle into: array startingAt: (start ifNil: [0])
 150 ].
 151
 152 r@(ExternalResource traits) write: n to: handle from: array startingAt: start
 153 "The primitive for external output: write N bytes to the resource's handle
 154 at the given start position, taking them from the array (starting at 0)."
 155 [overrideThis].
 156
 157 r@(ExternalResource traits) write: n from: array &startingAt: start
 158 [
 159   r isOpen ifFalse: [r signalClosed].
 160   r write: n to: r handle from: array startingAt: (start ifNil: [0])
 161 ].
 162
 163 ExternalResource traits define: #Stream &parents: {Stream} &slots:
 164   {#resource -> ExternalResource clone.
 165    #indexOfLastDirtyElement -> 0}.
 166 "A Stream used on an ExternalResource."
 167
 168 r@(ExternalResource traits) reader
 169 "This defers access control to the one object that has been handed original
 170 access."
 171 [
 172   r readStream `defaultsTo: (r ReadStream newOn: r)
 173 ].
 174
 175 r@(ExternalResource traits) ASCIIReader
 176 "eventually use 'x reader &encoding: ASCIIEncoding' instead."
 177 [
 178   r readStream `defaultsTo: (r ASCIIReadStream newOn: r)
 179 ].
 180
 181 r@(ExternalResource traits) writer
 182 "This defers access control to the one object that has been handed original
 183 access."
 184 [
 185   r writeStream `defaultsTo: (r WriteStream newOn: r)
 186 ].
 187
 188 r@(ExternalResource traits) interactor
 189 "Provides a ReadWriteStream for working with the resource. It can't be an
 190 iterator since those provide synchronized (ie the reading and writing modify
 191 the same contents) access.
 192 This also defers access control to the one object that has been handed original
 193 access."
 194 [
 195   r readStream := (r writeStream := r ReadWriteStream newOn: r)
 196 ].
 197
 198 r@(ExternalResource traits) iterator
 199 "This defers access control to the one object that has been handed original
 200 access."
 201 [
 202   r readStream := (r writeStream := r ReadWriteStream newOn: r)
 203 ].
 204
 205 s@(ExternalResource Stream traits) on: r
 206 [
 207   s resource := r.
 208   s indexOfLastDirtyElement := 0.
 209   s
 210 ].
 211
 212 s@(ExternalResource Stream traits) terminal [s resource].
 213
 214 s@(ExternalResource Stream traits) elementType
 215 [
 216   Integer
 217 ].
 218
 219 s@(ExternalResource Stream traits) collectionType
 220 [
 221   ByteArray
 222 ].
 223
 224 s@(ExternalResource Stream traits) open
 225 [s resource open].
 226
 227 s@(ExternalResource Stream traits) reopen
 228 [s resource reopen].
 229
 230 s@(ExternalResource Stream traits) isOpen
 231 [s resource isNotNil /\ [s resource isOpen]].
 232
 233 s@(ExternalResource Stream traits) isDirty
 234 "Whether the Stream's writing buffer has elements which should be committed."
 235 [
 236   s indexOfLastDirtyElement > 0
 237 ].
 238
 239 s@(ExternalResource Stream traits) flushWriteBuffer
 240 "A hook for subtypes to hold a buffer for pending elements queued for when the
 241 ExternalResource is opened."
 242 [].
 243
 244 s@(ExternalResource Stream traits) flush
 245 "Flushes any unwritten elements."
 246 [
 247   s isDirty ifTrue:
 248     [s resource isActive ifFalse: [s open].
 249      s flushWriteBuffer.
 250      s indexOfLastDirtyElement := 0].
 251   s
 252 ].
 253
 254 s@(ExternalResource Stream traits) commit
 255 "Commit differs from flush in that the latter can make use of implicit
 256 buffering in the low-level implementation, while commit ensures that the data
 257 is actually sent to the peer."
 258 [
 259   s flush.
 260   s resource commit.
 261   s
 262 ].
 263
 264 s@(ExternalResource Stream traits) close
 265 [
 266   s resource isOpen ifTrue: [s resource close]
 267 ].
 268
 269 s@(ExternalResource Stream traits) sessionDo: block
 270 "Calls the block with the stream object as input, opening and closing it
 271 transparently in an error-tolerant way. Nesting is handled by detecting
 272 if the resource was open beforehand and not cycling it if so.
 273 The return value of the block is answered if it completes without error."
 274 [| wasOpen |
 275   wasOpen := s isOpen.
 276   [wasOpen ifFalse: [s open].
 277    block applyWith: s]
 278      ensure: [s isOpen ifTrue:
 279        [s commit. wasOpen ifFalse: [s close]]]
 280 ].
 281
 282 ExternalResource traits define: #ReadStream
 283                         &parents: {ExternalResource Stream. ReadStream}.
 284
 285 s@(ExternalResource ReadStream traits) nextLine
 286 [
 287   s upTo: $\n
 288 ].
 289
 290 s@(ExternalResource ReadStream traits) next: n putInto: seq startingAt: start
 291 [
 292   overrideThis
 293 ].
 294
 295 s@(ExternalResource ReadStream traits) next: n putInto: bytes@(ByteArray traits) startingAt: start
 296 "Returns the number of bytes read. Should not signal errors on exhaustion here (return 0)."
 297 [
 298   s read: n into: bytes &startingAt: start
 299 ].
 300
 301 s@(ExternalResource ReadStream traits) read: n into: bytes@(ByteArray traits) &startingAt: start
 302 "This is a low-level protocol to avoid delegation issues if
 303 next:putInto:startingAt: is overridden on ER subtypes."
 304 [
 305   s resource read: n into: bytes &startingAt: start
 306 ].
 307
 308 ExternalResource traits define: #WriteStream
 309                         &parents: {ExternalResource Stream. WriteStream}.
 310
 311 s@(ExternalResource WriteStream traits) nextPut: obj
 312 "fixme warn people not to use this too much"
 313 [s nextPutAll: ((s collectionType new &capacity: 1) `>> [at: 0 put: obj. ])].
 314
 315 _@(ExternalResource WriteStream traits) nextPut: _@(String traits)
 316 [
 317   error: 'Strings cannot be single elements for ExternalResource streams.'
 318 ].
 319
 320 s@(ExternalResource WriteStream traits) next: n putAll: seq startingAt: start
 321 [
 322   overrideThis
 323 ].
 324
 325 s@(ExternalResource WriteStream traits) next: n putAll: bytes@(ByteArray traits) startingAt: start
 326 [s write: n from: bytes &startingAt: start].
 327
 328 s@(ExternalResource WriteStream traits) write: n from: bytes@(ByteArray traits) &startingAt: start
 329 "This is a low-level protocol to avoid delegation issues if
 330 next:putAll:startingAt: is overridden on ER WriteStream subtypes."
 331 [s resource write: n from: bytes &startingAt: start].
 332
 333 source@(ReadStream traits) >> sink@(ExternalResource WriteStream traits)
 334 [source copyTo: sink].
 335
 336 ExternalResource traits define: #ReadWriteStream
 337   &parents: {ExternalResource ReadStream. ExternalResource WriteStream}.
 338 ExternalResource traits define: #SeriousCondition
 339                         &parents: {SeriousCondition} &slots: {#resource}.
 340
 341 ExternalResource traits define: #Closed
 342                         &parents: {ExternalResource SeriousCondition}.
 343 "A condition where I/O is attempted on a closed resource."
 344
 345 r@(ExternalResource traits) signalClosed
 346 [r Closed new `>> [resource := r. signal]].
 347
 348 r@(ExternalResource Closed traits) describeOn: out
 349 [
 350   out ; 'External resource is closed.'
 351 ].
 352
 353 ExternalResource Closed traits define: #OpenResource
 354                                &parents: {Restart}.
 355 "Try to open the resource."
 356
 357 r@(ExternalResource Closed OpenResource traits) defaultHandler
 358 [r condition resource open].
 359
 360 ExternalResource traits define: #ConnectionFailed
 361                         &parents: {ExternalResource SeriousCondition}.
 362 "A condition where a connection attempt fails."
 363
 364 r@(ExternalResource traits) connectionFailure
 365 [r ConnectionFailed new `>> [resource := r. signal]].
 366
 367 r@(ExternalResource ConnectionFailed traits) describeOn: out
 368 [
 369   out ; 'Could not connect to ' ; (r resource locator as: String)
 370 ].
 371
 372 ExternalResource traits define: #Locator &parents: {Cloneable}.
 373 "An empty abstract type of object for filenames and other resource-locating
 374 structures."
 375
 376 l@(ExternalResource Locator traits) locator
 377 "This makes #locator idempotent - calling it on a file or locator always
 378 yields a/the locator."
 379 [l].
 380
 381 l@(ExternalResource Locator traits) type
 382 "Override this so that Locators know what kind of objects they're specifying."
 383 [ExternalResource].
 384
 385 l@(ExternalResource Locator traits) newResource
 386 "Create and answer a new ExternalResource object of the appropriate type with
 387 the argument as its location specifier.
 388 Override this as the constructor method changes."
 389 [l type newNamed: l].