"SimpleTCP -- a simple TCP server class"

Namespace current addSubspace: #SimpleTCP!
Namespace current: SimpleTCP!

"A simple TCP server"
Object subclass: #Server
  instanceVariableNames: 'serverSocket socketHandler'
  classVariableNames: ''
  poolDictionaries: ''
  category: ''!

!Server class methodsFor: 'instance creation'!

new: aServerSocket handler: aHandler
  | simpleServer |
  simpleServer := super new.
  simpleServer socket: aServerSocket.
  simpleServer handler: aHandler.
  simpleServer init.
  ^simpleServer
!!

!Server methodsFor: 'initialization'!

init
  ^self
!!

!Server methodsFor: 'accessing'!

socket
  ^serverSocket
!

socket: aServerSocket
  serverSocket := aServerSocket.
  ^self
!

handler
  ^socketHandler
!

handler: aHandler
  socketHandler := aHandler.
  ^self
!!

!Server methodsFor: 'running'!

run
  | s |
  [
    serverSocket waitForConnection.
    s := (serverSocket accept).
    self handle: s
  ] repeat
!

!Server methodsFor: 'handling'!

handle: aSocket
  socketHandler handle: aSocket
!!

Namespace current: SimpleTCP superspace!