NeoDPClient
NeoSharedObject
RcmpClient
neodp_remote_attach_object
neodp_remote_detach_object
neodp_remote_hello
NeoDPClient - an [incr tcl] class
NeoDPClient object
inherits
object hello
object attach_object
objType objName
object detach_object
objType objName
object connect
host port
#@package: NeoDPClient NeoDPClient
#
# NeoSoft Internet-distributed-database client
#
# $Id: rcmp.html,v 1.1.1.1 1997/01/15 23:54:55 kunkee Exp $
#
#
method hello {} {
dp_RPC $serverFP neodp_remote_hello
}
method attach_object {objType objName} {
dp_RPC $serverFP neodp_remote_attach_object $objType $objName
}
method detach_object {objType objName} {
dp_RPC $serverFP neodp_remote_detach_object $objType $objName
}
method connect {host port} {
set serverFP [dp_MakeRPCClient $host $port]
hello
}
protected serverFP
NeoSharedObject - an [incr tcl] class
NeoSharedObject object -defaultValues something -currentValues something
inherits
object configure
args
object slot-value
key
object destroy
object create-slot
slotName defaultValue
object setf
slot value
object getf
slot
object lappendf
slot value
#@package: NeoSharedObject NeoSharedObject
#
# NeoSharedObject - incr tcl class library to create objects
# capable of being distributed as distribued objects under
# Tcl-DP
#
# $Id: rcmp.html,v 1.1.1.1 1997/01/15 23:54:55 kunkee Exp $
#
# The constructor takes as optional arguments an arbitrary number
# of "-key value" pairs. These are created as slots which
# will be distributed and maintained as a shared object across
# all of the programs on the net that have attached the
# object.
#
# This format is specified by tcl-dp.
#
constructor {args} {
while {[llength $args] > 1} {
set args [lassign $args key value]
set key [string trimleft $key -]
create-slot $key $value
}
return ""
}
destructor {
}
# configure is required by tcl-dp.
# configure with no args lists all slots as "-key initial current"
# triples. With one argument, it returns the value associated with
# the specified slot. With more than two arguments, they are
# key-value pairs to be set into the specified slots.
#
method configure {args} {
if {$args == ""} {
if ![info exists defaultValues] {return ""}
foreach slotName [array names defaultValues] {
lappend result [list -$slotName $defaultValues($slotName) $currentValues($slotName)]
}
return $result
}
if {[llength $args] == 1} {
set key [string trimleft $args -]
if ![info exists defaultValues($key)] {
return ""
}
return "$args $defaultValues($key) $currentValues($key)"
}
while {[llength $args] > 1} {
set args [lassign $args key value]
set key [string trimleft $key -]
set currentValues($key) $value
}
return ""
}
# slot-value is required by tcl-dp.
# slot-value returns the value at the specified slot. Note that
# the leading dash is not specified as part of the key.
method slot-value {key} {
return $currentValues($key)
}
# destroy is required by tcl-dp and destroys the object.
method destroy {} {
$this delete
}
# create-slot creates slots in the object. All slots that are
# to be shared must be created before the object is served out,
# or they will not be seen... or worse.
method create-slot {slotName defaultValue} {
set currentValues($slotName) $defaultValue
set defaultValues($slotName) $defaultValue
}
method setf {slot value} {
dp_setf $this $slot $value
}
method getf {slot} {
return [dp_getf $this $slot]
}
method lappendf {slot value} {
set list [dp_getf $this $slot]
lappend list $value
dp_setf $this $slot $value
}
public defaultValues
public currentValues
RcmpClient - an [incr tcl] class
RcmpClient object -host something -rcmpPort 222
inherits
object configure
config
object disconnect
object connect
connectHost "" hostIP ""
object disk
object login
user password
object send
message responseVar "" multilineVar ""
#@package: rcmp-client-object RcmpClient
#
# Remote Computer Management Protocol (RCMP)
#
# Basic object-tcl client class for building RCMP clients.
#
# karl lehenbauer 10/94
#
# $Id: rcmp.html,v 1.1.1.1 1997/01/15 23:54:55 kunkee Exp $
#
constructor {config} {
}
destructor {
}
method configure {config} {
}
method disconnect {} {
if {$fromFP != ""} {
catch {close $fromFP}
set fromFP ""
}
if {$toFP != ""} {
catch {close $toFP}
set toFP ""
}
set connected 0
}
method connect {{connectHost ""} {hostIP ""}} {
disconnect
if {$connectHost != ""} {set host $connectHost}
if {$hostIP == ""} {
set hostIP $host
}
lassign [server_open $hostIP $rcmpPort] fromFP toFP
if {[send "" onlineMessage] != 2} {
disconnect
error "connect failed: $onlineMessage"
}
set connected 1
}
method disk {} {
if {[send disk response data] != 2} {
disconnect
error "disk request failed"
}
echo $data
echo $response
}
method login {user password} {
if {[send "USER $user"] != 3} {
disconnect
error "error sending user"
}
if {[send "PASS $password"] != 2} {
disconnect
error "error sending password"
}
}
method send {message {responseVar ""} {multilineVar ""}} {
if {$multilineVar != ""} {
upvar $multilineVar multilineResponse
}
if {$responseVar != ""} {
upvar $responseVar response
}
set multilineResponse ""
set inMultiline 0
if {$message != ""} {
puts $toFP $message
flush $toFP
}
while 1 {
if {[gets $fromFP line] < 0} {
disconnect
error "EOF from RCMP server"
}
set firstChar [cindex $line 0]
if {!$inMultiline && $firstChar != 1} {
set response $line
return $firstChar
}
if !$inMultiline {
if {$firstChar != 1} {
disconnect
error "protocol failure reading server"
}
if {[cindex $line 3] == "-"} {
set inMultiline 1
} else {
set multilineResponse $line
}
} else {
# really should make sure we have three entire digits
if {[ctype digit [crange $line 0 2]] && [cindex $line 3] == " "} {
set inMultiline 0
if {$firstChar != 1} {
set response $line
return $firstChar
}
} else {
lappend multilineResponse $line
}
}
}
}
protected fromFP ""
protected toFP ""
protected connected 0
protected state "new"
public host
public rcmpPort 222
neodp_remote_attach_object
neodp_remote_attach_object objType objName
global rpcFile
dp_DistributeObject $objName $rpcFile $objType
neodp_remote_detach_object
neodp_remote_detach_object objType objName
global rpcFile
dp_UndistributeObject $objName $rpcFile $objType
neodp_remote_hello
neodp_remote_hello
#@package: neodp-server neodp_remote_hello neodp_remote_attach_object neodp_remote_detach_object
#
# NeoSoft Internet-distributed database server.
#
# $Id: rcmp.html,v 1.1.1.1 1997/01/15 23:54:55 kunkee Exp $
#
global rpcFile
echo "hello from $rpcFile"