|
|
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_fieldsset 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