Index: openacs-4/packages/acs-service-contract/acs-service-contract.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/acs-service-contract.info,v diff -u -r1.10 -r1.11 --- openacs-4/packages/acs-service-contract/acs-service-contract.info 16 Jan 2003 13:35:54 -0000 1.10 +++ openacs-4/packages/acs-service-contract/acs-service-contract.info 3 Feb 2003 12:17:21 -0000 1.11 @@ -6,20 +6,19 @@ ACS Service Contract t t - - + + oracle postgresql - Neophytos Demetriou Kapil Thangavelu + Neophytos Demetriou Allows different packages to communicate via defined contracts - 2002-10-27 + 2003-01-31 OpenACS - - + @@ -37,8 +36,8 @@ - + @@ -58,6 +57,15 @@ + + + + + + + + + @@ -70,12 +78,14 @@ - + + + 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.9 -r1.10 --- openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 30 Nov 2002 17:21:44 -0000 1.9 +++ openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 3 Feb 2003 12:17:36 -0000 1.10 @@ -6,6 +6,41 @@ @cvs-id $Id$ } +namespace eval acs_sc {} + +##### +# +# Invoke +# +##### + +ad_proc -public acs_sc::invoke { + {-contract:required} + {-operation:required} + {-impl:required} + {-call_args {}} +} { + A wrapper for the acs_sc_call procedure, with explicitly named + parameters so it's easier to figure out how to use it. + + @param contract_name The name of the contract you wish to use. + @param operation_name The name of the operation in the contract you wish to call. + @param impl_name The name of the implementation you wish to use. + @param args The arguments you want to pass to the proc. + + @author Lars Pind (lars@collaboraid.biz) + @see acs_sc_call +} { + return [acs_sc_call $contract $operation $call_args $impl] +} + + +##### +# +# All the rest that used to be there +# +##### + ad_proc -public acs_sc_binding_exists_p { contract impl @@ -29,7 +64,6 @@ contract impl operation - } { generate the internal proc name. @@ -219,7 +253,6 @@ @author Neophytos Demetriou } { - set proc_name [acs_sc_generate_name $contract $impl $operation] if { [llength [info procs $proc_name]] == 1 } { @@ -239,24 +272,12 @@ ## Logging ## +# Private logging proc proc acs_sc_log {level msg} { # 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" } -} - - - - - - - - - - - - - +} \ No newline at end of file Index: openacs-4/packages/acs-service-contract/tcl/contract-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/contract-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/contract-procs-oracle.xql 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,82 @@ + + + + oracle8.1.7 + + + + select acs_sc_contract.new( + :name, + :description + ) from dual + + + + + + select acs_sc_contract.get_name( + :contract_id + ) from dual + + + + + + select acs_sc_contract.get_id( + :name + ) from dual + + + + + + select operation_id, + operation_inputtype_id, + operation_outputtype_id + from acs_sc_operations + where contract_id = :contract_id + + + + + + select acs_sc_contract.delete( + :name + ) from dual + + + + + + select acs_sc_operation.new( + :contract_name, + :operation, + :description, + :is_cachable_p, + :nargs, + :input_type_name, + :output_type_name + ) from dual + + + + + + select contract_name, + operation_name + from acs_sc_operations + where operation_id = :operation_id + + + + + + select acs_sc_operation.delete( + :contract_name, + :operation_name + ) from dual + + + + + Index: openacs-4/packages/acs-service-contract/tcl/contract-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/contract-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/contract-procs-postgresql.xql 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,73 @@ + + + + postgresql7.2 + + + + select acs_sc_contract__new( + :name, + :description + ); + + + + + + select acs_sc_contract__get_name(:contract_id); + + + + + + select acs_sc_contract__get_id(:name); + + + + + + select operation_id, + operation_inputtype_id, + operation_outputtype_id + from acs_sc_operations + where contract_id = :contract_id + + + + + + select acs_sc_contract__delete(:name); + + + + + + select acs_sc_operation__new( + :contract_name, + :operation, + :description, + :is_cachable_p, + :nargs, + :input_type_name, + :output_type_name + ); + + + + + + select contract_name, + operation_name + from acs_sc_operations + where operation_id = :operation_id + + + + + + select acs_sc_operation__delete(:contract_name, :operation_name); + + + + + Index: openacs-4/packages/acs-service-contract/tcl/contract-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/contract-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/contract-procs.tcl 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,233 @@ +ad_library { + Support library for acs service contracts. + + @author Lars Pind (lars@collaboraid.biz) + @creation-date 2003-01-14 + @cvs-id $Id: contract-procs.tcl,v 1.1 2003/02/03 12:17:36 lars Exp $ +} + +namespace eval acs_sc::contract {} +namespace eval acs_sc::contract::operation {} + + + +##### +# +# Contract +# +##### + +ad_proc -public acs_sc::contract::new { + {-name:required} + {-description:required} +} { + + Procedure to call to define and new service contract and + the message types, implementations and bindings. + + Refer to the Service contract Tcl API discussion at + http://openacs.org/forums/message-view?message_id=71799 + + @param name Name of the service contract + @param description Comment/description of the service contract + @return id of the contract + +} { + return [db_string insert_sc_contract {}] +} + +ad_proc -public acs_sc::contract::new_from_spec { + {-spec:required} +} { + Takes a complete notification spec and parses the + name, description and operations +} { + + # Default values + array set contract { description "" } + + # Get the spec + array set contract $spec + + db_transaction { + set contract_id [new \ + -name $contract(name) \ + -description $contract(description)] + + acs_sc::contract::operation::parse_operations_spec \ + -name $contract(name) \ + -spec $contract(operations) + } + return $contract_id +} + +ad_proc -public acs_sc::contract::delete { + {-contract_id} + {-name} + {-no_cascade:boolean} +} { + Delete a service contract definition. Supply either contract_id or name. + + @param contract_id The ID of the service contract to delete + @param name Name of the service contract to delete +} { + if { ![exists_and_not_null contract_id] && ![exists_and_not_null name] } { + error "You must supply either name or contract_id" + } + + db_transaction { + # Need both name and ID below + if { ![exists_and_not_null name] } { + set name [db_string get_name_by_id {}] + } elseif { ![exists_and_not_null contract_id] } { + set contract_id [db_string get_id_by_name {}] + } + + if { !$no_cascade_p } { + + set operations [list] + set msg_types [list] + + db_foreach select_operations {} { + # Put them on list of mesage types and operations to delete + lappend msg_types $operation_inputtype_id + lappend msg_types $operation_outputtype_id + lappend operations $operation_id + } + + # Delete the operations + foreach operation_id $operations { + acs_sc::contract::operation::delete -operation_id $operation_id + } + + # Delete msg types + foreach msg_type_id $msg_types { + if { ![empty_string_p $msg_type_id] } { + acs_sc::msg_type::delete -msg_type_id $msg_type_id + } + } + } + + # LARS: + # It seems like delete by ID doesn't work, because our PG bind thing turns all integers into strings + # by wrapping them in single quotes, causing PG to invoke the function for deleting by name + db_string delete_by_name {} + } +} + + + + +##### +# +# Operations +# +##### + +ad_proc -public acs_sc::contract::operation::new { + {-contract_name:required} + {-operation:required} + {-input:required} + {-output:required} + {-description:required} + {-is_cachable_p ""} +} { + + Call the service contract function to create the + operation in the database. + +} { + db_transaction { + # Create the input type + + set input_type_name "${contract_name}.${operation}.InputType" + + set nargs [acs_sc::msg_type::parse_spec \ + -name $input_type_name \ + -spec $input] + + # Create the output type + + set output_type_name "${contract_name}.${operation}.OutputType" + + acs_sc::msg_type::parse_spec \ + -name $output_type_name \ + -spec $output + + # Create the operation + + db_exec_plsql insert_operation {} + } +} + +ad_proc -public acs_sc::contract::operation::delete { + {-operation_id} + {-contract_name} + {-operation_name} +} { + Delete a message type. Supply either ID or name. + + @param msg_type_id The ID of the msg_type to delete. + @param name Name of the service contract to delete +} { + if { ![exists_and_not_null operation_id] && ( ![exists_and_not_null contract_name] || ![exists_and_not_null operation_name] ) } { + error "You must supply either contract_name and operation_name, or operation_id" + } + + # LARS: + # It seems like delete by ID doesn't work, because our PG bind thing turns all integers into strings + # by wrapping them in single quotes, causing PG to invoke the function for deleting by name + + if { ![exists_and_not_null contract_name] || ![exists_and_not_null operation_name] } { + # get contract_name and operation_name + db_1row select_names {} + } + + db_string delete_by_name {} +} + +ad_proc -public acs_sc::contract::operation::parse_operations_spec { + {-name:required} + {-spec:required} +} { + Parse the operations defined in the operations specification + @param name Name of the contract + @spec spec Specification of all the operations +} { + foreach { operation subspec } $spec { + acs_sc::contract::operation::parse_spec \ + -contract_name $name \ + -operation $operation \ + -spec $subspec + } +} + +ad_proc -public acs_sc::contract::operation::parse_spec { + {-contract_name:required} + {-operation:required} + {-spec:required} +} { + Parse one operation +} { + + # Default values + array set attributes { + description {} + input {} + output {} + is_cachable_p "f" + } + + # Get the sepc + array set attributes $spec + + # New operation + acs_sc::contract::operation::new \ + -contract_name $contract_name \ + -operation $operation \ + -description $attributes(description) \ + -input $attributes(input) \ + -output $attributes(output) \ + -is_cachable_p $attributes(is_cachable_p) +} + Index: openacs-4/packages/acs-service-contract/tcl/implementation-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/implementation-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/implementation-procs-oracle.xql 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,46 @@ + + + +oracle8.1.6 + + + + select acs_sc_impl.new( + :contract_name, + :name, + :owner + ) from dual + + + + + + select acs_sc_impl_alias.new( + :contract_name, + :impl_name, + :operation, + :alias, + :language + ) from dual + + + + + + select acs_sc_binding.alias_new( + :contract_name, + :impl_name + ) from dual + + + + + + select acs_sc_impl.delete( + :contract_name, + :impl_name + ) from dual + + + + Index: openacs-4/packages/acs-service-contract/tcl/implementation-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/implementation-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/implementation-procs-postgresql.xql 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,46 @@ + + + + postgresql7.2 + + + + select acs_sc_impl__new( + :contract_name, + :name, + :owner + ); + + + + + + select acs_sc_impl_alias__new( + :contract_name, + :impl_name, + :operation, + :alias, + :language + ); + + + + + + select acs_sc_binding__new( + :contract_name, + :impl_name + ); + + + + + + select acs_sc_impl__delete( + :contract_name, + :impl_name + ); + + + + Index: openacs-4/packages/acs-service-contract/tcl/implementation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/implementation-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/implementation-procs.tcl 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,185 @@ +ad_library { + Support library for acs service contracts. Implements the acs_sc::impl namespace. + + @author Lars Pind (lars@collaboraid.biz) + @creation-date 2003-01-14 + @cvs-id $Id: implementation-procs.tcl,v 1.1 2003/02/03 12:17:36 lars Exp $ +} + +namespace eval acs_sc::impl {} +namespace eval acs_sc::impl::alias {} +namespace eval acs_sc::impl::binding {} + + +##### +# +# Implementations +# +##### + +ad_proc -public acs_sc::impl::new { + {-contract_name:required} + {-name:required} + {-owner:required} +} { + Add new service contract implementation. + + @return the ID of the new implementation +} { + return [db_string impl_new {}] +} + +ad_proc -public acs_sc::impl::delete { + {-contract_name:required} + {-impl_name:required} +} { + Delete a service contract implementation +} { + + if { ![exists_and_not_null contract_name] || ![exists_and_not_null impl_name] } { + error "You must supply contract_name and impl_name" + } + + db_string delete_impl {} +} + +ad_proc -public acs_sc::impl::new_from_spec { + {-spec:required} +} { + Add new service contract implementation from an array-list style implementation. + + @return the ID of the new implementation +} { + # Spec contains: contract_name, name, owner, aliases + array set impl $spec + + db_transaction { + set impl_id [new \ + -contract_name $impl(contract_name) \ + -name $impl(name) \ + -owner $impl(owner)] + + acs_sc::impl::alias::parse_aliases_spec \ + -contract_name $impl(contract_name) \ + -impl_name $impl(name) \ + -spec $impl(aliases) + + acs_sc::impl::binding::new \ + -contract_name $impl(contract_name) \ + -impl_name $impl(name) + } + + # Initialize the procs so we can start calling them right away + acs_sc::impl::binding::init_procs -impl_id $impl_id + + return $impl_id +} + + + + +##### +# +# Aliases +# +##### + +ad_proc -public acs_sc::impl::alias::new { + {-contract_name:required} + {-impl_name:required} + {-operation:required} + {-alias:required} + {-language "TCL"} +} { + Add new service contract implementation alias + (the procedure that implements the operation in a contract). + + @return the ID of the implementation +} { + set impl_id [db_string alias_new {}] +} + +ad_proc -private acs_sc::impl::alias::parse_aliases_spec { + {-contract_name:required} + {-impl_name:required} + {-spec:required} +} { + Parse multiple aliases. +} { + foreach { operation subspec } $spec { + parse_spec \ + -contract_name $contract_name \ + -impl_name $impl_name \ + -operation $operation \ + -spec $subspec + } +} + +ad_proc -private acs_sc::impl::alias::parse_spec { + {-contract_name:required} + {-impl_name:required} + {-operation:required} + {-spec:required} +} { + Parse the spec for a single alias. The spec can either be just the + name of a Tcl procedure, or it can be an array list containing the + two keys 'alias' and 'language'. +} { + if { [llength $spec] == 1 } { + + # Single-element spec, which means it's the name of a Tcl procedure + new \ + -contract_name $contract_name \ + -impl_name $impl_name \ + -operation $operation \ + -alias $spec + } else { + # It's a full spec, expect 'alias' and 'language' + array set alias $spec + + new \ + -contract_name $contract_name \ + -impl_name $impl_name \ + -operation $operation \ + -alias $alias(alias) \ + -language $alias(language) + + } +} + + + + +##### +# +# Bindings +# +##### + +ad_proc -public acs_sc::impl::binding::new { + {-contract_name:required} + {-impl_name:required} +} { + Bind implementation to the contract. Bombs if not all operations + have aliases. +} { + db_string binding_new {} +} + +ad_proc -public acs_sc::impl::binding::init_procs { + {-impl_id:required} +} { + Initialize the procs so we can call the service contract. +} { + db_foreach impl_operation { + select impl_contract_name, + impl_operation_name, + impl_name + from acs_sc_impl_aliases + where impl_id = :impl_id + } { + acs_sc_proc $impl_contract_name $impl_operation_name $impl_name + } +} + + Index: openacs-4/packages/acs-service-contract/tcl/msg-type-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/msg-type-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/msg-type-procs-oracle.xql 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,34 @@ + + + + oracle8.1.7 + + + + select acs_sc_msg_type.new( + :name, + :specification + ) from dual + + + + + + select acs_sc_msg_type.delete( + :msg_type_id + ) from dual + + + + + + select acs_sc_msg_type.delete( + :name + ) from dual + + + + + + + Index: openacs-4/packages/acs-service-contract/tcl/msg-type-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/msg-type-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/msg-type-procs-postgresql.xql 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,44 @@ + + + + postgresql7.2 + + + + select acs_sc_msg_type__new( + :name, + :specification); + + + + + + select msg_type_name as name + from acs_sc_msg_types + where msg_type_id = :msg_type_id + + + + + + select acs_sc_msg_type__delete(:name); + + + + + + select acs_sc_msg_type__new_element( + :msg_type_name, + :element_name, + :element_msg_type_name, + :element_msg_type_isset_p, + :element_pos + ); + + + + + + + + Index: openacs-4/packages/acs-service-contract/tcl/msg-type-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/msg-type-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-service-contract/tcl/msg-type-procs.tcl 3 Feb 2003 12:17:36 -0000 1.1 @@ -0,0 +1,124 @@ +ad_library { + Support library for acs service contracts. + + @author Lars Pind (lars@collaboraid.biz) + @creation-date 2003-01-14 + @cvs-id $Id: msg-type-procs.tcl,v 1.1 2003/02/03 12:17:36 lars Exp $ +} + +namespace eval acs_sc::msg_type {} +namespace eval acs_sc::msg_type::element {} + +ad_proc -public acs_sc::msg_type::new { + {-name:required} + {-specification ""} +} { + @param specification Msg type specification in the format required by the SQL proc, namely + 'foo:integer,bar:[string]' +} { + ns_log Notice "LARS: Creating msg_type $name with spec $specification" + + db_exec_plsql insert_msg_type {} +} + +ad_proc -public acs_sc::msg_type::delete { + {-msg_type_id} + {-name} +} { + Delete a message type. Supply either ID or name. + + @param msg_type_id The ID of the msg_type to delete. + @param name Name of the service contract to delete +} { + if { ![exists_and_not_null msg_type_id] && ![exists_and_not_null name] } { + error "You must supply either name or msg_type_id" + } + + # LARS: + # It seems like delete by ID doesn't work, because our PG bind thing turns all integers into strings + # by wrapping them in single quotes, causing PG to invoke the function for deleting by name + + if { ![exists_and_not_null name] } { + # get msg_type name + db_1row select_name {} + } + + db_string delete_by_name {} +} + +ad_proc -public acs_sc::msg_type::parse_spec { + {-name:required} + {-spec:required} +} { + #The specification for the message type could be like this! + #case_id:integer + #foobar:string,multiple + + @param name Name of new msg_type + @param spec Spec in ad_page_contract style format, namely { foo:integer bar:string,multiple } +} { + ns_log Notice "LARS: msg-type-parse-spec, name=$name, spec=$spec" + + db_transaction { + + # First, create the msg_type + acs_sc::msg_type::new -name $name + + set nargs 0 + + # Then create the elements + foreach element $spec { + incr nargs + + # element:flag,flag + set elementv [split $element :] + set flagsv [split [lindex $elementv 1] ","] + + set element_name [string trim [lindex $elementv 0]] + + if { [llength $flagsv] > 1 } { + set idx [lsearch $flagsv "multiple"] + + if { [llength $flagsv] > 2 || $idx == -1 } { + error "Only one modified flag allowed, and that's multiple as in foo:integer,multiple" + } + + # Remove the 'multiple' flag + set flagsv [lreplace $flagsv $idx $idx] + set element_type "[lindex $flagsv 0]" + set isset_p 1 + } else { + set element_type [lindex $flagsv 0] + set isset_p 0 + } + + acs_sc::msg_type::element::new \ + -msg_type_name $name \ + -element_name $element_name \ + -element_msg_type_name $element_type \ + -element_msg_type_isset_p $isset_p \ + -element_pos $nargs + } + } + + return $nargs +} + +##### +# +# Msg_type Element +# +##### + +ad_proc -public acs_sc::msg_type::element::new { + {-msg_type_name:required} + {-element_name:required} + {-element_msg_type_name:required} + {-element_msg_type_isset_p:required} + {-element_pos:required} +} { + Insert a new msg_type element +} { + db_exec_plsql insert_msg_type_element {} +} +