|
|
The following Tcl execution procedures implement each of the functions described here for the UUCP Systems file OSA:
systems:createEntry
proc systemsGet
proc systemsModify
proc systemsCreate
proc systemsDelete
Example execution procedures: uucp.cdt
proc systems:createEntry { Attrs } {
global Systems_fields
set entry ""
foreach f $Systems_fields {
if {! [keylget Attrs $f val]} {
ErrorPush {} 1 SCO_UUCPOSA_ERR_ATTRIBUTE "$attribute $op"
}
if { ! [lempty $entry] } {
append entry " "
}
# process the loginscript
if {$f == "loginscript"} {
set loginscript "$val"
set val ""
foreach pair "$loginscript" {
# protect backslashes
lassign "$pair" expect send
append val "$expect $send "
}
}
append entry $val
}
return $entry
}
# Get procedure for the class sco UUCPsystems
# Arguments:
# class: The class of the object being operated on. If this procedure
# handles more than one class, use this parameter to
# find out the class of the current object.
# object: The name of the object being operated on.
# refObject: Ignored.
# op: Name of the operation being performed, which will always be
# "get" unless you use this procedure to handle multiple
# operations, in which case you can use this parameter to
# find out the operation currently requested.
# subOp: Ignored.
# data: Ignored.
# attr: If this procedure is being called per attribute, this parameter
# contains the attribute to be operated on.
# This can be ignored if the procedure is called per object.
# attr-
# ValueList: This contains the whole list of attributes which should be
# operated on, which should only be used if the procedure is
# called per object.
# osaData: Contains any extra data associated with the class in the
# osaData section of the CDT (currently not supported by the
# OSA builder).
proc systemsGet {class object refObject op subOp data attr attrValueList osaData} {
global SYSTEMS Systems_fields SystemsConfig SYSTEMS_ts
if { ![file exists $SYSTEMS] } {
if {$object == "NULL"} {
return {}
} else {
ErrorPush {} 1 SCO_OSA_ERR_NO_SUCH_OBJECT_INSTANCE "$object"
}
}
set newtimestamp [file mtime $SYSTEMS]
if {($newtimestamp > $SYSTEMS_ts) || ($SystemsConfig == "")} {
ErrorCatch {} 1 "cfgRead $SYSTEMS" syslist
set SystemsConfig {}
set SYSTEMS_ts [file mtime $SYSTEMS]
# parse the config into a keyed list, of keyed lists
foreach sys $syslist {
set cfg ""
for {set i 0} {$i < 5} {incr i} {
keylset cfg [lindex $Systems_fields $i] [lindex $sys $i]
}
# format the loginscript into a list of expect/send pairs
set pairs {}
set entries [split [lrange $sys 5 end] " "]
for {set i 0} { $i < [llength $entries] } {incr i +2} {
set line [lindex $entries $i]
while {$line != ""} {
# look for subfields separated with -
set altern [string first "-" $line]
if {$altern > -1} {
set want [string range $line 0 [expr {$altern - 1}]]
set line [string range $line [expr {$altern + 1}] end]
# any more subfields?
set altern [string first "-" $line]
if {$altern > -1} {
set send [string range $line 0 [expr {$altern - 1}]]
set line [string range $line [expr {$altern + 1}] end]
} else {
set send [lindex $entries [expr {$i + 1}]]
set line ""
}
} else {
set want $line
set send [lindex $entries [expr {$i + 1}]]
set line ""
}
lappend pairs [list $want $send]
}
}
keylset cfg loginscript $pairs
keylset SystemsConfig [keylget cfg site] $cfg
}
}
if {$object == "NULL"} {
return $SystemsConfig
} else {
if {! [keylget SystemsConfig $object objectVal]} {
ErrorPush {} 1 SCO_OSA_ERR_NO_SUCH_OBJECT_INSTANCE "$object"
} else {
return $objectVal
}
}
}
# Replace procedure for the class sco UUCPsystems
# Arguments:
# class: The class of the object being operated on. If this procedure
# handles more than one class, use this parameter to
# find out the class of the current object.
# object: The name of the object being operated on.
# refObject: Ignored.
# op: Name of the operation being performed, which will always be
# "replace" unless you use this procedure to handle multiple
# operations, in which case you can use this parameter to
# find out the operation currently requested.
# subOp: Ignored.
# data: Ignored.
# attr: If this procedure is being called per attribute, this parameter
# contains the attribute to be operated on.
# This can be ignored if the procedure is called per object.
# attr-
# ValueList: This contains an list of attribute-value pairs which are to be
# operated on. If this procedure is called per object, carry out
# the operation for each attribute-value pair. If it is called per
# attribute, you need to use the "attr" argument to find out
# which attribute to operate on, and then use it to index into
# the attrValueList to obtain the value or values that are
# associated with it.
# osaData: Contains any extra data associated with the class in the
# osaData section of the CDT (currently not supported by the
# OSA builder).
proc systemsModify {class object refObject op subOp data attr attrValueList osaData} {
global SYSTEMS Systems_fields SystemsConfig SYSTEMS_ts
if {$SYSTEMS_ts == 0} {
systemsGet $class "NULL" "" "get" "" "" "" "" ""
}
set entry [systems:createEntry $attrValueList]
if {! [keylget SystemsConfig $object objectVal]} {
ErrorPush {} 1 SCO_OSA_ERR_NO_SUCH_OBJECT_INSTANCE "$object"
}
ErrorCatch {} 1 "cfgModify $SYSTEMS REPLACE $object \"$entry\"" results
set SYSTEMS_ts 0
}
# Create procedure for the class sco UUCPsystems
# Arguments:
# class: The class of the object being operated on. If this procedure
# handles more than one class, use this parameter to
# find out the class of the current object.
# object: The name of the object being operated on.
# refObject: If this parameter is specified, create the new object based
# on the attributes of the given object. Otherwise, use default
# attributes.
# op: Name of the operation being performed, which will always be
# "create" unless you use this procedure to handle multiple
# operations, in which case you can use this parameter to
# find out the operation currently requested.
# subOp: Ignored.
# data: Ignored.
# attr: Ignored.
# attr-
# ValueList: Ignored.
# osaData: Contains any extra data associated with the class in the
# osaData section of the CDT (currently not supported by the
# OSA builder).
proc systemsCreate {class object refObject op subOp data attr attrValueList osaData} {
global SYSTEMS SYSTEMS_ts SystemsConfig
if {$SYSTEMS_ts == 0} {
systemsGet $class "NULL" "" "get" "" "" "" "" ""
}
set entry [systems:createEntry $attrValueList]
# Check object is unique
keylget attrValueList site newkey
if [keylget SystemsConfig $newkey dummy] {
ErrorPush {} 1 SCO_OSA_ERR_DUPLICATE_MANAGED_OBJECT_INSTANCE "$newkey"
}
# create a new entry
ErrorCatch {} 1 "cfgAdd $SYSTEMS \"$entry\"" result
set SYSTEMS_ts 0
}
# Delete procedure for the class sco UUCPsystems
# Arguments:
# class: The class of the object being operated on. If this procedure
# handles more than one class, use this parameter to
# find out the class of the current object.
# object: The name of the object being operated on.
# refObject: Ignored.
# op: Name of the operation being performed, which will always be
# "delete" unless you use this procedure to handle multiple
# operations, in which case you can use this parameter to
# find out the operation currently requested.
# subOp: Ignored.
# data: Ignored.
# attr: Ignored.
# attr-
# ValueList: Ignored.
# osaData: Contains any extra data associated with the class in the
# osaData section of the CDT (currently not supported by the
# OSA builder).
proc systemsDelete {class object refObject op subOp data attr attrValueList osaData} {
global SYSTEMS SystemsConfig SYSTEMS_ts
if {$SYSTEMS_ts == 0} {
systemsGet $class "NULL" "" "get" "" "" "" "" ""
}
if {! [keylget SystemsConfig $object objectVal]} {
ErrorPush {} 1 SCO_OSA_ERR_NO_SUCH_OBJECT_INSTANCE "$object"
}
ErrorCatch {} 1 "cfgModify $SYSTEMS REMOVE $object {}" results
set SYSTEMS_ts 0
}
set SystemsConfig ""
set SYSTEMS_ts 0
set SYSTEMS /usr/lib/uucp/Systems
set Systems_fields [list site schedule type speed phone loginscript]
OFBinding sco_UUCPsystems_CDT