Index: openacs-4/packages/acs-service-contract/tcl/acs-service-contract-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/acs-service-contract-init.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-service-contract/tcl/acs-service-contract-init.tcl 9 Oct 2001 04:57:37 -0000 1.3 +++ openacs-4/packages/acs-service-contract/tcl/acs-service-contract-init.tcl 16 Oct 2002 15:10:04 -0000 1.4 @@ -7,9 +7,13 @@ from acs_sc_impl_aliases } { + acs_sc_log SCDebug "ACS_SC_PROC: checking binding exists for contract $impl_contract_name impl $impl_name" + set binding_exists_p [db_string binding_exists_p {select acs_sc_binding__exists_p(:impl_contract_name,:impl_name)}] if $binding_exists_p { acs_sc_proc $impl_contract_name $impl_operation_name $impl_name + } else { + acs_sc_log SCDebug "ACS_SC_PROC: binding not found for contract $impl_contract_name impl $impl_name" } } Index: openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 14 Aug 2002 18:54:32 -0000 1.7 +++ openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 16 Oct 2002 15:10:04 -0000 1.8 @@ -1,37 +1,53 @@ ad_library { - + Support library for acs service contracts. + @author Neophytos Demetriou - + @creation-date 2001-09-01 + @cvs-id $Id$ } -ad_proc acs_sc_binding_exists_p { +ad_proc -public acs_sc_binding_exists_p { contract impl } { + Returns a boolean depending on whether or not the binding between + the contract and implementation exists. + + @param contract the contract name + @param impl the implementation name + + @return 0 or 1 + @author Neophytos Demetriou } { return [db_string binding_exists_p {select acs_sc_binding__exists_p(:contract,:impl)}] } -ad_proc acs_sc_generate_name { +ad_proc -private acs_sc_generate_name { contract impl operation } { + generate the internal proc name. + @author Neophytos Demetriou } { return AcsSc.${contract}.${operation}.${impl} } -ad_proc acs_sc_get_alias { +ad_proc -private acs_sc_get_alias { contract operation impl } { + Returns the implementation alias (the + proc defined to handle a given operation + for a given implementation). + @author Neophytos Demetriou } { @@ -54,28 +70,31 @@ -ad_proc acs_sc_proc { +ad_proc -private acs_sc_proc { contract operation impl } { + Builds the proc used by acs_sc_call, generally only called + in acs-service-contract-init.tcl at startup. + + @return 0 on failure, 1 on success. @author Neophytos Demetriou } { set arguments [list] - set docblock [list] + set docblock {} - set proc_name [acs_sc_generate_name $contract $impl $operation] acs_sc_log SCDebug "ACS_SC_PROC: proc_name = $proc_name" foreach {impl_alias impl_pl} [acs_sc_get_alias $contract $operation $impl] break if ![info exists impl_alias] { - error "Cannot find alias for $proc_name" + error "ACS-SC: Cannot find alias for $proc_name" } - db_0or1row get_operation_definition { + if {![db_0or1row get_operation_definition { select operation_desc, operation_iscachable_p, @@ -85,9 +104,12 @@ from acs_sc_operations where contract_name = :contract and operation_name = :operation + }]} { + ns_log warning "ACS-SC: operation definition not found for contract $contract operation $operation" + return 0 } - lappend docblock "$operation_desc" + append docblock "\nacs-service-contract operation. Call via acs_sc_call.\n\n$operation_desc\n\n" db_foreach operation_inputtype_element { select @@ -100,9 +122,9 @@ order by element_pos asc } { lappend arguments "$element_name" - lappend docblock "@param $element_name $element_msg_type_name" + append docblock "\n@param $element_name $element_msg_type_name" if { $element_msg_type_isset_p } { - lappend docblock "\[\]" + append docblock " \[\]" } } @@ -116,12 +138,13 @@ where msg_type_id = :operation_outputtype_id order by element_pos asc } { - lappend docblock "@return $element_name - $element_msg_type_name" + append docblock "\n@return $element_name - $element_msg_type_name" if { $element_msg_type_isset_p } { - lappend docblock "\[\]" + append docblock " \[\]" } } + append docblock "\n@see $impl_alias\n@see acs_sc_call" set full_statement [acs_sc_get_statement $impl_alias $impl_pl $arguments] @@ -132,20 +155,26 @@ #FIX ME: CALL BY NAME USING UPVAR set body "return \[$full_statement\]" - set docblock [join $docblock "\n\r"] set arguments [join $arguments] - acs_sc_log SCDebug "sc_proc: $proc_name, $arguments" - ad_proc $proc_name $arguments $docblock $body - + acs_sc_log SCDebug "ACS-SC: ad_proc $proc_name $arguments\n$docblock\n$body\n" + ad_proc -private $proc_name $arguments $docblock $body + + return 1 } -ad_proc acs_sc_get_statement { +ad_proc -private acs_sc_get_statement { impl_alias impl_pl arguments } { + Builds the statement to call from the provided metadata. + + @param impl_alias tcl or plpgsql proc to call + @param impl_pl programmimg language of the proc to call (TCL or PLPGSQL) + @param arguments list of argument names + @author Neophytos Demetriou } { @@ -167,7 +196,7 @@ set full_statement "db_exec_plsql full_statement \"select ${impl_alias}(${args_final})\"" } default { - error "Unknown impl_pl: $impl_pl" + error "ACS-SC: Unknown impl_pl: $impl_pl" } } @@ -177,12 +206,17 @@ -ad_proc acs_sc_call { +ad_proc -public acs_sc_call { contract operation {arguments ""} {impl ""} } { + @param contract the contract name + @param operation the method to invoke + @param arguments list of arguments to pass to the method + @param impl the implementation name. + @author Neophytos Demetriou } { @@ -195,7 +229,7 @@ # SHOULD WE PRODUCE AN ERROR HERE? # MAYBE NOT, THE SEMANTICS MIGHT REQUIRE TO CALL # THE FUNCTION ONLY IF THE IMPLEMENTATION IS SUPPORTED. - ns_log warning "ACS-SC: Function Not Found: $proc_name" + ns_log warning "ACS-SC: Function Not Found: $proc_name [info procs $proc_name]" return } } @@ -206,9 +240,11 @@ ## proc acs_sc_log {level msg} { - # If you want to debug the SC, change SCDebug to Debug below + # If you want to debug the SC, uncomment the Debug log below if {![string equal "SCDebug" $level]} { ns_log $level "$msg" + } else { + # ns_log Debug "$msg" } } Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/acs-service-contract/www/contract-display.adp'. Fisheye: No comparison available. Pass `N' to diff? Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/acs-service-contract/www/contract-display.tcl'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/packages/acs-service-contract/www/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/www/index.adp,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-service-contract/www/index.adp 6 Sep 2002 21:49:55 -0000 1.3 +++ openacs-4/packages/acs-service-contract/www/index.adp 16 Oct 2002 15:09:59 -0000 1.4 @@ -2,6 +2,17 @@ ACS Service Contract @context@ +

Defined Contracts

+

Installed Bindings

Index: openacs-4/packages/acs-service-contract/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/www/index.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/acs-service-contract/www/index.tcl 6 Sep 2002 21:49:55 -0000 1.4 +++ openacs-4/packages/acs-service-contract/www/index.tcl 16 Oct 2002 15:09:59 -0000 1.5 @@ -1,6 +1,7 @@ - set context [list] +db_multirow defined_contracts defined_contracts {select contract_id,contract_name,contract_desc from acs_sc_contracts} + db_multirow valid_installed_binding valid_installed_binding "" db_multirow valid_uninstalled_binding valid_uninstalled_binding ""