Index: openacs-4/packages/cronjob/tcl/cronjob-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/cronjob/tcl/cronjob-init.tcl,v diff -u -N -r1.3 -r1.4 --- openacs-4/packages/cronjob/tcl/cronjob-init.tcl 30 Nov 2002 17:29:40 -0000 1.3 +++ openacs-4/packages/cronjob/tcl/cronjob-init.tcl 29 May 2009 09:11:28 -0000 1.4 @@ -14,164 +14,164 @@ ad_proc qd_write_query_select {package attrs} { -

Returns Postgresql function with: -

+

Returns Postgresql function with: +

} { - ns_log Debug "Running qd_write_query_select with $package $attrs" - set query [list] - set in_args [list] - set args [concat $attrs] - foreach {attr sign value} $args { - lappend in_args $attr - set attr_array($attr) $value - } - set attrs_and_defaults [eval qd_choose_function $package $in_args] - foreach {attr default_value} $attrs_and_defaults { - # see if attr was passed in with value - if {![info exists attr_array($attr)]} { - - if {[string match "" $default_value]} { - ns_log Debug "Attempt to call $package with no value for $attr" - return -code error - } - lappend query $default_value - } else { - lappend query "$attr_array($attr)" - } - } - ns_log Debug "${package}([join $query ",\n"]);" - return "${package}([join $query ",\n"]);" + ns_log Debug "Running qd_write_query_select with $package $attrs" + set query [list] + set in_args [list] + set args [concat $attrs] + foreach {attr sign value} $args { + lappend in_args $attr + set attr_array($attr) $value + } + set attrs_and_defaults [eval qd_choose_function $package $in_args] + foreach {attr default_value} $attrs_and_defaults { + # see if attr was passed in with value + if {![info exists attr_array($attr)]} { + + if {[string match "" $default_value]} { + ns_log Debug "Attempt to call $package with no value for $attr" + return -code error + } + lappend query $default_value + } else { + lappend query "$attr_array($attr)" + } + } + ns_log Debug "${package}([join $query ",\n"]);" + return "${package}([join $query ",\n"]);" } ad_proc qd_add_package {package args} { -

Adds a package with all the attributes for every function of the same name. -

For example, if you have two functions that could be called - foo(a,b,c) and foo(a,c,d), - the package would be registered using: -

- 
-	qd_add_package foo a b c d
-
-
+

Adds a package with all the attributes for every function of the same name. +

For example, if you have two functions that could be called + foo(a,b,c) and foo(a,c,d), + the package would be registered using: +

+ 
+        qd_add_package foo a b c d
+
+
} { - nsv_set qd_pg_packages $package $args - set n 1 - foreach attr $args { - nsv_set $package $attr $n - set n [expr $n * 2] - } + nsv_set qd_pg_packages $package $args + set n 1 + foreach attr $args { + nsv_set $package $attr $n + set n [expr $n * 2] + } } ad_proc qd_total_attributes {package attributes} { -

Totals the attribute values. +

Totals the attribute values. } { - upvar $package package_array - upvar $attributes attrs - set total 0 - foreach attribute $attrs { - incr total $package_array($attribute) - ns_log Debug "Adding $package_array($attribute) $total" - } - return $total + upvar $package package_array + upvar $attributes attrs + set total 0 + foreach attribute $attrs { + incr total $package_array($attribute) + ns_log Debug "Adding $package_array($attribute) $total" + } + return $total } ad_proc qd_add_function {package args} { -

Adds a single function, including defaults to a package. -

If one foo function has three attributes: a, b and c, where - a is required and b can be null and c default to 't', +

Adds a single function, including defaults to a package. +

If one foo function has three attributes: a, b and c, where + a is required and b can be null and c default to 't', the function would be - registered using: -

- 
-	qd_add_function foo a "" b "null" c "'t'"
-
-
+ registered using: +
+ 
+        qd_add_function foo a "" b "null" c "'t'"
+
+
} { - + - # total up the function value. - array set temp_package [nsv_array get $package] - set i 1 - foreach {attr default} $args { - lappend attr_list $attr - } - set total [qd_total_attributes temp_package attr_list] - nsv_set ${package}_functions $total $args + # total up the function value. + array set temp_package [nsv_array get $package] + set i 1 + foreach {attr default} $args { + lappend attr_list $attr + } + set total [qd_total_attributes temp_package attr_list] + nsv_set ${package}_functions $total $args } ad_proc qd_choose_function {package args} { -

Used to choose a function based on passed in attributes. +

Used to choose a function based on passed in attributes. } { - - array set temp_package [nsv_array get $package] - set total [qd_total_attributes temp_package args] - if {[nsv_exists ${package}_functions $total]} { - ns_log Debug "Found matching sig: '$total'" - return [nsv_get ${package}_functions $total] - } - set functions [nsv_array names ${package}_functions] - foreach sig $functions { - ns_log Debug "checking sig '$total' against '$sig'" - if {$total == [expr $sig & $total]} { - ns_log Debug "Found match '$total' in '$sig'" - return [nsv_get ${package}_functions $sig] - } - } - return "!NO MATCH: $total not in $functions" + + array set temp_package [nsv_array get $package] + set total [qd_total_attributes temp_package args] + if {[nsv_exists ${package}_functions $total]} { + ns_log Debug "Found matching sig: '$total'" + return [nsv_get ${package}_functions $total] + } + set functions [nsv_array names ${package}_functions] + foreach sig $functions { + ns_log Debug "checking sig '$total' against '$sig'" + if {$total == [expr $sig & $total]} { + ns_log Debug "Found match '$total' in '$sig'" + return [nsv_get ${package}_functions $sig] + } + } + return "!NO MATCH: $total not in $functions" } proc qd_write_query {package args} { - - set query [list] - set attrs_and_defaults [eval qd_choose_function $package $args] - foreach {attr default_value} $attrs_and_defaults { - if {[lsearch $args $attr] < 0 } { - if {[string match "" $default_value]} { - ns_log Debug "Attempt to call $package with no value for $attr" - return -code error - } - lappend query $default_value - } else { - lappend query ":${attr}" - } - } - return [join $query ",\n"] + + set query [list] + set attrs_and_defaults [eval qd_choose_function $package $args] + foreach {attr default_value} $attrs_and_defaults { + if {[lsearch $args $attr] < 0 } { + if {[string match "" $default_value]} { + ns_log Debug "Attempt to call $package with no value for $attr" + return -code error + } + lappend query $default_value + } else { + lappend query ":${attr}" + } + } + return [join $query ",\n"] } proc qd_write_query_upvar {package listvar} { - - set query [list] - upvar $listvar args - set attrs_and_defaults [eval qd_choose_function $package $args] - if {[string match "!NO MATCH:*" $attrs_and_defaults ]} { - ns_log Debug "$attrs_and_defaults" - return -code error - } - foreach {attr default_value} $attrs_and_defaults { - if {[lsearch $args $attr] < 0 } { - if {[string match "" $default_value]} { - ns_log Debug "Attempt to call $package with no value for $attr" - return -code error - } - lappend query $default_value - } else { - lappend query ":${attr}" - } - } - return [join $query ",\n"] + + set query [list] + upvar $listvar args + set attrs_and_defaults [eval qd_choose_function $package $args] + if {[string match "!NO MATCH:*" $attrs_and_defaults ]} { + ns_log Debug "$attrs_and_defaults" + return -code error + } + foreach {attr default_value} $attrs_and_defaults { + if {[lsearch $args $attr] < 0 } { + if {[string match "" $default_value]} { + ns_log Debug "Attempt to call $package with no value for $attr" + return -code error + } + lappend query $default_value + } else { + lappend query ":${attr}" + } + } + return [join $query ",\n"] } }