Home
The Toolkit for Online Communities
17474 Community Members, 1 member online, 2696 visitors today
Log In Register
OpenACS Home : ACS API Browser : ad_page_contract

ad_page_contract (public)

 ad_page_contract [ -form form ] [ -properties properties ] docstring \
    [ args... ]
Defined in packages/acs-tcl/tcl/tcl-documentation-procs.tcl

Specifies the contract between programmer and graphic designer for a page. When called with the magic "documentation-gathering" flag set (to be defined), the proc will record the information about this page, so it can be displayed as documentation. When called during normal page execution, it will validate the query string and set corresponding variables in the caller's environment.

Example:

ad_page_contract  {
    Some documentation.
    @author me (my@email)
    @cvs-id $Id$
} {
    foo
    bar:integer,notnull,multiple,trim
    {greble:integer {[expr {[lindex $bar 0] + 1}]}}
} -validate {
    greble_is_in_range -requires {greble:integer} {
	if { $greble < 1 || $greble > 100 } {
	    ad_complain
	}
    }
    greble_exists -requires { greble_is_in_range } {
        global greble_values
	if { ![info exists greble_values($greble)] } {
	    ad_complain "[_ acs-tcl.lt_Theres_no_greble_with]"
	}
    }
} -errors {
    foo {error message goes here}
    bar:,integer,notnull {another error message}
    greble_is_in_range {Greble must be between 1 and 100}
}
An argspec takes one of two forms, depending on whether there's a default value or not:
  1. {name[:flag,flag,flag] default}
  2. name[:flag,flag,flag]

If no default value is specified, the argument is considered required, but the empty string is permissible unless you specify :notnull. For all arguments, the filter :nohtml is applied by default. If the arg is named *.tmpfile, the tmpfile filter is applied.

Possible flags are:

trim
The value will be string trimmed.
notnull
When set, will barf if the value is the empty string. Checked after processing the trim flag. If not set, the empty string is always considered valid input, and no other filters are processed for that particular value. If it's an array or multiple variable, the filters will still be applied for other values, though.
optional
If there's a default value present, it's considered optional even without the flag. If a default is given, and the argument is present but blank, the default value will be used. Optional and no default value means the variable will not be set, if the argument is not present in the query string.
multiple
If multiple is specified, the var will be set as a list of all the argument values (e.g. arg=val1&arg=val2 will turn into arg=[list val1 val2]). The defaults are filled in from left to right, so it can depend on values of arguments to its left.
array
This syntax maps query variables into Tcl arrays. If you specify customfield:array, then query var customfield.foo will translate into the Tcl array entry $customfield(foo). In other words: whatever comes after the dot is used as the key into the array, or, more mathematically: x.y=z => set x(y) z. If you use dot or comma is part of your key (i.e., y above contains comma or dot), then you can easily split on it in your Tcl code. Remember that you can use any other flag or filter with array.
verify
Will invoke ad_verify_signature to verify the value of the variable, to make sure it's the value that was output by us, and haven't been tampered with. If you use export_form_vars -sign or export_url_vars -sign to export the variable, use this flag to verify it. To verify a variable named foo, the verify flag looks for a form variable named foo:sig. For a :multiple, it only expects one single signature for the whole list. For :array it also expects one signature only, taken on the [array get] form of the array.
cached
This syntax will check to see if a value is being passed in for this variable. If it is not, it will then look in cache for this variable in the package that this page is located, and get this value if it exists.
date
Pluggable filter, installed by default, that makes sure the array validates as a date. Use this filter with :array to do automatic date filtering. To use it, set up in your HTML form a call to \[ad_dateentrywidget varname\]. Then on the receiving page, specify the filter using varname:array,date. If the date validates, there will be a variable set in your environment varname with four keys: day, month, year, and date. You can safely pass $varname(date) to Oracle.
time
Pluggable filter, installed by default, that makes sure the array validates as a time in am/pm format. That is that it has two fields: time and ampm that have valid values. Use this filter with :array to do automoatic time filtering. To use it, set up in you HTML form using \[ec_timeentrywidget varname\] or equivalent. Then on the processing page specify the filter using varname:array,time. If the time validates, there will be a variable set in your environment varname with five keys: time, ampm, hours, minutes, and seconds.
time24
Pluggable filter, installed by default, that makes sure the array validates as a time in 24hr format. That is that it has one field: time that has valid values. Use this filter with :array to do automoatic time filtering. To use it, set up in you HTML form using <input type=text name=varname.time>. Then on the processing page specify the filter using varname:array,time24. If the time validates, there will be a variable set in your environment varname with four keys: time, hours, minutes, and seconds.
integer
Pluggable filter, installed by default, that makes sure the value is integer, and removed any leading zeros.
naturalnum
Pluggable filter, installed by default, that makes sure the value is a natural number, i.e. non-decimal numbers >= 0.
range
Pluggable filter, installed by default, that makes sure the value X is in range \[Y, Z\]. To use it say something like: foo:(1|100)
nohtml
Pluggable filter, installed by default, that disallows any and all html.
html
Pluggable filter, installed by default, that only allows certain, safe allowed tags to pass (see ad_html_security_check). The purpose of screening naughty html is to prevent users from uploading HTML with tags that hijack page formatting or execute malicious code on the users's computer.
allhtml
Pluggable filter, installed by default, that allows any and all html. Use of this filter is not reccomended, except for cases when the HTML will not be presented to the user or there is some other reason for overriding the site-wide control over naughty html.
tmpfile
Checks to see if the path and file specified by tmpfile are allowed on this system.
sql_identifier
Pluggable filter, installed by default, that makes sure the value is a valid SQL identifier.
more filters...

Note that there can be no spaces between name, colon, flags, commas, etc. The first space encountered denotes the beginning of the default value. Also, variable names can't contain commas, colons or anything Tcl accepts as list element seperators (space, tab, newline, possibly others) If more than one value is specified for something that's not a multiple, a complaint will be thrown ("you supplied more than one value for foo").

There's an interface for enhancing ad_page_contract with pluggable filters, whose names can be used in place of flags (see ad_page_contract_filter). There's also an interface for pluggable filter rules, which determine what filters are applied to arguments (see ad_page_contract_filter_rule).

Note on QQ-variables: Unlike the old ad_page_variables, ad_page_contract does not set QQ-versions of variables. The QQ-versions (had each single-quote replaced by two single-quotes) were only necessary for building up SQL statements directly in a Tcl string. Now that we're using bind variables, the QQ-variables aren't necessary anymore, and thus, ad_page_contract doesn't waste time setting them.

Default Values

Default values are filled in from left to right (or top to bottom), so it can depend on the values or variables that comes before it, like in the example above. Default values are only used when the argument is not supplied, thus you can't use default values to override the empty string. (This behavior has been questioned and may have to be changed at a later point.) Also, default values are not checked, even if you've specified flags and filters. If the argument has the multiple flag specified, the default value is treated as a list. If the array flag is specified, we expect it to be in array get format, i.e. a list of { name value name value ... } pairs. If both multiple and array are set, the value elements of the before-mentioned array get format are treated as lists themselves.

Errors Argument

The -errors block defines custom error messages. The format is a list in array get format with alternating error-names and error texts. The error names can be foo, which means it's thrown when the variable is not supplied. Or foo:flag,flag,..., which means it'll get thrown whenever one of the flags fail. If you want the same error to be thrown for both not supplying a var, and for a flag, you can say foo:,flag,... (a comma immediately after the colon).

Validation Blocks

The -validate is used to fully customized user input validation. The format is a list of named chunks of code, for example:
-validate {
    name {
        code block
    }
    another_name -requires { argname[:filter-or-validation-block-name,...] ... } {
        code block
    }
}
The name is for use with the -errors block, and for use within the -requires argument of another validation block. The validation blocks will get executed after all flags and filters have been evaluated. The code chunk should perform some validation, and if it's unhappy it should call ad_complain, optionally with an error message. If no error message is specified, the error should be declared in the -errors section.

Each validation block can also have a -requires switch, which takes a list of validations that must already have been successfully passed, for the validation to get executed. The intent is that you want to provide as much feedback as possible at once, but you don't want redundant feedback, like "foo must be an integer" and "foo must be in range 10 to 20". So a check for foo in range 10 to 20 would have a -requires { foo:integer } switch, to ensure that the check only gets executed if foo was sucessfully validated as an integer.

In the -requires argument, you can specify a list of (1) the name of an argument, which means that the argument must be supplied. Or (2) you can specify argname:filter or argname:validation_block to say that a given filter, flag or valdiation block must have been executed and satisfied for this validation block to get executed. You can have as many requirements as you like.

Switches:
-form (optional)
Optionally supply the parameters directly here instead of fetching them from the page's form (ns_getform). This should be a reference to an ns_set.
-properties (optional)
what properties the resulting document will contain.
Parameters:
docstring - the documentation for your page; will be parsed like ad_proc and ad_library.
Authors:
Lars Pind <lars@pinds.com>
Yonatan Feldman <yon@arsdigita.com>
Bryan Quinn <bquinn@arsdigita.com>
Created:
16 June 2000
Source code:
    ad_complaints_init

    ####################
    #
    # Parse arguments
    #
    ####################


    if { [llength $args] == 0 } {
	set query [list]
    } else {
	
	set valid_args { validate errors return_errors properties }; 	# add type later

	# If the first arg isn't a switch, it should be the query
	if { [string index [lindex $args 0] 0] != "-" } {
	    set query [lindex $args 0]
	    set args [lrange $args 1 end]
	} else {
	    # otherwise, accept a -query argument
	    lappend valid_args query
	    set query [list]
	}
	
	ad_arg_parser $valid_args $args
    }

    ####################
    # 
    #   Check supplied query form and set up variables in caller's environment
    # 
    ####################
    #
    # These are the steps:
    # 1. go over the formal args, massaging it into an internal data structure that's easier to manipulate
    # 2. go over the form (actual args), match actual to formal args, apply filters
    # 3. go over the formal args again: defaulting, post filters, complain if required but not supplied
    # 4. execute the validation blocks
    #
    ####################


    ####################
    #
    # Step 1: Massage the query arg into some useful data structure.
    #
    ####################
    # BASIC STUFF:
    # list apc_formals                list of formals in the order specified by in the arguments
    # array apc_formal($name)         1 if there is a formal argument with that name
    # array apc_default_value($name)  the default value, if any
    # 
    # FILTERS:
    # array apc_internal_filter($name:$flag):        1 if the given flag is set, undefined
    # array apc_filters($name):                      contains a list of the filters to apply
    # array apc_post_filters($name):                 contains a list of the post filters to apply
    # array apc_filter_parameters($name:$flag:):      contains a list of the parameters for a filter
    #
    # DOCUMENTATION:
    # array apc_flags($name):         contains a list of the flags that apply
    #
    
    set apc_formals [list]
    array set apc_formal [list]
    array set apc_default_value [list]

    array set apc_internal_filter [list]
    array set apc_filters [list]
    array set apc_post_filters [list]
    array set apc_filter_parameters [list]

    array set apc_flags [list]

    foreach element $query {
	set element_len [llength $element]

	if { $element_len > 2 } {
	    return -code error "[_ acs-tcl.lt_Argspec_element_is_in]"
	}

	set arg_spec [lindex $element 0]

	if { ![regexp {^([^ \t:]+)(?::([a-zA-Z0-9_,(|)]*))?$} $arg_spec match name flags] } {
	    return -code error "Argspec '$arg_spec' doesn't have the right format. It must be var\[:flag\[,flag ...\]\]"
	}
	
	lappend apc_formals $name
        set apc_formal($name) 1
	     
	if { $element_len == 2 } {
	    set apc_default_value($name) [lindex $element 1]
	} 

	set pre_flag_list [split [string tolower $flags] ,]
	set flag_list [list]

	# find parameterized flags
	foreach flag $pre_flag_list {
	    set left_paren [string first "(" $flag]
	    if { $left_paren == -1 } {
		lappend flag_list $flag
	    } else {
		if { [string index $flag end] ne ")" } {
		    return -code error "Missing or misplaced end parenthesis for flag '$flag' on argument '$name'"
		}
		set flag_parameters [string range $flag $left_paren+1 [string length $flag]-2]
		set flag [string range $flag 0 $left_paren-1]

		lappend flag_list $flag
		foreach flag_parameter [split $flag_parameters "|"] {
		    lappend apc_filter_parameters($name:$flag) $flag_parameter
		}
	    }
	}

	#
	# Apply filter rules
	#

	foreach filter_rule [nsv_array names ad_page_contract_filter_rules] { 
	    [ad_page_contract_filter_rule_proc $filter_rule] $name flag_list
	}

	# 
	# Sort the flag list according to priority
	#

	set flag_list_for_sorting [list]
	foreach flag $flag_list {
	    lappend flag_list_for_sorting [list [ad_page_contract_filter_priority $flag] $flag]
	}
	set flag_list_sorted [lsort -index 0 $flag_list_for_sorting]

	#
	# Split flag_list up into the different kinds, i.e. internal, filter (classic) or post_filter.
	#
	# apc_flags($name) is for documentation only.
	#

	set apc_flags($name) [list]
	set apc_filters($name) [list]
	set apc_post_filters($name) [list]

	foreach flag_entry $flag_list_sorted {
	    set flag [lindex $flag_entry 1]
	    lappend apc_flags($name) $flag
	    
	    switch [ad_page_contract_filter_type $flag] {
		internal {
		    set apc_internal_filter($name:$flag) 1
		}
		filter {
		    lappend apc_filters($name) $flag
		}
		post {
		    lappend apc_post_filters($name) $flag
		}
		default {
		    return -code error "Unrecognized flag or filter \"$flag\" specified for query argument $name"
		}
	    }
	}
    }

    ####################
    #
    # Documentation-gathering mode
    #
    ####################

    if { [api_page_documentation_mode_p] } {
	# Just gather documentation for this page

	ad_parse_documentation_string $docstring doc_elements

	# copy all the standard elements over
	foreach element { query properties } {
	    if { [info exists $element] } {
		set doc_elements($element) [set $element]
	    }
	}
	# then the arrays
	foreach element { apc_default_value apc_flags } {
	    set doc_elements($element) [array get $element]
	}
	# then the array names
	set doc_elements(apc_arg_names) $apc_formals
	
	# figure out where the calling script is located, relative to the ACS root
	set root_dir [nsv_get acs_properties root_directory]
	set script [info script]
	set root_length [string length $root_dir]
	if { $root_dir eq [string range $script 0 $root_length-1 ] } {
	    set script [string range $script $root_length+1 end]
	}

	error [array get doc_elements] "ad_page_contract documentation"
    }

    #
    # Page serving mode
    #

    ####################
    #
    # Parse -properties argument
    #
    ####################
    # This must happen even if the query (aka parameters, formals) is empty

    if { [info exists properties] } {
	upvar 1 __page_contract_property property
	array set property [doc_parse_property_string $properties]
    }

    # If there are no query arguments to process, we're done
    if { ![info exists query] || $query eq "" } {
	return
    }

    ####################
    #
    # Parse -validate block
    #
    ####################
    #
    # array apc_validation_blocks($name): an array of lists that contain the validation blocks
    #                                    the list will contain either 1 or 2 elements, a possible
    #                                    list of required completed filters/blocks and the code block
    #                                    for the validation block. Once the block has executed, this entry
    #                                    self destructs, i.e. unset apc_validation_blocks($name)

    array set apc_validation_blocks [list]

    if { ![info exists validate] } {
	set validate [list]
    }

    set validate_len [llength $validate]
    for { set i 0 } { $i < $validate_len } { incr i } {
	set name [lindex $validate $i]

	if { [string first : $name] != -1 } {
	    return -code error "[_ acs-tcl.lt_Validation_block_name]"
	}
	if { [info exists apc_formal($name)] } {
	    return -code error "[_ acs-tcl.lt_You_cant_name_your_va]"
	}
	if { [info exists apc_validation_blocks($name)] } {
	    return -code error "[_ acs-tcl.lt_You_cant_have_two_val]"
	}

	incr i
	if { [string index [lindex $validate $i] 0] == "-" } {
	    if { [lindex $validate $i] ne "-requires" } {
		return -code error "[_ acs-tcl.lt_Valid_switches_are_-r]"
	    }
	    set requires [lindex $validate [incr i]]

	    foreach element $requires {
		if { [string first , $element] != -1 } {
		    return -code error "[_ acs-tcl.lt_The_-requires_element]"
		}
		set parts_v [split $element ":"]
		set parts_c [llength $parts_v]
		if { $parts_c > 2 }  {
		    return -code error "[_ acs-tcl.lt_The_-requires_element_1]"
		}
		set req_filter [lindex $parts_v 1]
		if { $req_filter in {array multiple} } {
		    return -code error "You can't require \"$req_name:$req_filter\" for block \"$name\"."
		}
	    }
	    incr i
	} else {
	    set requires [list]
	}
	set code [lindex $validate $i]
	set apc_validation_blocks($name) [list $requires $code]
    }

    ####################
    #
    # Parse -errors argument
    #
    ####################

    if { [info exists errors] } {
	ad_complaints_parse_error_strings $errors
    }

    ####################
    #
    # Step 2: Go through all the actual arguments supplied in the form
    # 
    ####################

    if { $form eq "" } {
        set form [ns_getform]
    }
    
    if { $form eq "" } {
	set form_size 0
    } else {
	set form_size [ns_set size $form]
    }

    # This is the array in which we store the signature variables as we come across them
    # Whenever we see a variable named foo:sig, we record it here as apc_signatures(foo).
    array set apc_signatures [list]
	
    for { set form_counter_i 0 } { $form_counter_i < $form_size } { incr form_counter_i } {
	
	#
	# Map actual argument to formal argument ... only complication is from arrays
	#


	# Check the name of the argument to passed in the form, ignore if not valid
        if { [regexp -nocase -- {^[a-z0-9_\-\.\:]*$}  [ns_set key $form $form_counter_i] ] } {
        set actual_name [ns_set key $form $form_counter_i]

        # The name of the formal argument in the page
        set formal_name $actual_name

        # This will be var(key) for an array
        set variable_to_set var

        # This is the value	
        set actual_value [ns_set value $form $form_counter_i]

        # This is needed for double click protection so we can access the two variables down below.
        if {$actual_name eq "__submit_button_name" || $actual_name eq "__submit_button_value"} {
            set $actual_name $actual_value
        }

        # It may be a signature for another variable
        if { [regexp {^(.*):sig$} $actual_name match formal_name] } {
            set apc_signatures($formal_name) $actual_value
            # We're done with this variable
            continue
        }
        
        # If there is no formal with this name, _or_ the formal that has this name is an array, 
        # in which case it can't be the right formal, since we'd have to have a dot and then the key
        if { ![info exists apc_formal($formal_name)] || [info exists apc_internal_filter($formal_name:array)] } {
            
            # loop over all the occurrences of dot in the argument name
            # and search for a variable spec with that name, e.g.
            # foo.bar.greble can be interpreted as foo(bar.greble) or foo.bar(greble)
            set found_p 0
            set actual_name_v [split $actual_name "."]
            set actual_name_c [expr { [llength $actual_name_v] - 1 }]
            for { set i 0 } { $i < $actual_name_c } { incr i } {
                set formal_name [join [lrange $actual_name_v 0 $i] "."]
                if { [info exists apc_internal_filter($formal_name:array)] } {
                    set found_p 1
                    set variable_to_set var([join [lrange $actual_name_v $i+1 end] "."])
                    break
                }
            }
            if { !$found_p } {
                # The user supplied a value for which we didn't have any arg_spec
                # It might be safest to fail completely in this case, but for now, 
                # we just ignore it and go on with the next arg
                continue
            }
        }
        
        if { [info exists apc_internal_filter($formal_name:multiple)] 
	     && $actual_value eq "" 
	 } {
            # LARS:
            # If you lappend an emptry_string, it'll actually add the empty string to the list as an element
            # which is not what we want
            continue
        }
        
        
        # Remember that we've found the spec so we don't complain that this argument is missing
        ad_page_contract_set_validation_passed $formal_name
        
        #
        # Apply filters
        #
        
        if { [info exists apc_internal_filter($formal_name:trim)] } {
            set actual_value [string trim $actual_value]
            ad_page_contract_set_validation_passed $formal_name:trim
        }

        if { $actual_value eq "" } {
            if { [info exists apc_internal_filter($formal_name:notnull)] } {
                ad_complain -key $formal_name:notnull "[_ acs-tcl.lt_You_must_specify_some]"
                continue
            } else { 
                ad_page_contract_set_validation_passed $formal_name:notnull
            }
        } else {
            set ::ad_page_contract_validations_passed($formal_name:notnull) 1
            
            foreach filter $apc_filters($formal_name) {
                set ::ad_page_contract_errorkeys [concat $formal_name:$filter $::ad_page_contract_errorkeys]
                if { ![info exists apc_filter_parameters($formal_name:$filter)] } {
                    set filter_ok_p [[ad_page_contract_filter_proc $filter] $formal_name actual_value]
                } else {
                    set filter_ok_p [[ad_page_contract_filter_proc $filter] $formal_name actual_value  $apc_filter_parameters($formal_name:$filter)]
                }
                set ::ad_page_contract_errorkeys [lrange $::ad_page_contract_errorkeys 1 end]
                
                if { $filter_ok_p } {
                    set ::ad_page_contract_validations_passed($formal_name:$filter) 1
                } else {
                    break
                }
            }
        }
        
        #
        # Set the variable in the caller's environment
        #
        
        upvar 1 $formal_name var
        
        if { [info exists apc_internal_filter($formal_name:multiple)] } {
            lappend $variable_to_set $actual_value
        } else {
            if { [info exists $variable_to_set] } {
                ad_complain -key $formal_name:-doublevalue "[_ acs-tcl.lt_Youve_supplied_two_va]"
                ns_log Warning "User experienced Youve_supplied_two_va when submitting a form related to path_info: [ad_conn path_info]"
                continue
            } else {
                set $variable_to_set $actual_value
            }
        }
    } else {
        ns_log Error "ad_page_contract: attempt to use a nonstandard variable name in form.  [ns_set key $form $form_counter_i]  "
    }
}
    

    ####################
    # 
    # Step 3: Pass over each formal argument to make sure all the required
    # things are there, and setting defaults if they're provided, 
    # apply post filters, and validate signatures.
    #
    ####################

    foreach formal_name $apc_formals {
	
	upvar 1 $formal_name var

	if { [info exists apc_internal_filter($formal_name:cached)] } {
	    if { ![ad_page_contract_get_validation_passed_p $formal_name] 
		 && ![info exists apc_internal_filter($formal_name:notnull)] 
		 && (![info exists apc_default_value($formal_name)] 
		     || $apc_default_value($formal_name) eq "") 
	     } {
		if { [info exists apc_internal_filter($formal_name:array)] } {
		    # This is an array variable, so we need to loop through each name.* variable for this package we have ...
		    set array_list ""
		    foreach arrayvar [ns_cache names util_memoize] {
			if [regexp [list [ad_conn session_id] [ad_conn package_id] "$formal_name."] $arrayvar] {
			    set arrayvar [lindex $arrayvar [llength $arrayvar]-1]
			    if { $array_list ne "" } {
				append array_list " "
			    }
			    set arrayvar_formal [string range $arrayvar [string first "." $arrayvar]+1 [string length $arrayvar]]
			    append array_list "{$arrayvar_formal} {[ad_get_client_property [ad_conn package_id] $arrayvar]}"
			}
		    }
		    set apc_default_value($formal_name) $array_list
		} else {
		    set apc_default_value($formal_name) [ad_get_client_property [ad_conn package_id] $formal_name]
		}
	    }
	}
	
	if { [ad_page_contract_get_validation_passed_p $formal_name] } {
	    
	    if { [info exists apc_internal_filter($formal_name:verify)] } {
		if { ![info exists apc_internal_filter($formal_name:array)] } {
 		    # This is not an array, verify the variable
		    if { ![info exists apc_signatures($formal_name)] 
			 || ![ad_verify_signature $var $apc_signatures($formal_name)] 
		    } {
			ad_complain -key $formal_name:verify "[_ acs-tcl.lt_The_signature_for_the]"
			continue
		    }
		} else {
		    # This is an array: verify the [array get] form of the array
		    if { ![info exists apc_signatures($formal_name)] 
			 || ![ad_verify_signature [lsort [array get var]] $apc_signatures($formal_name)] 
		    } {
			ad_complain -key $formal_name:verify "[_ acs-tcl.lt_The_signature_for_the]"
			continue
		    }
		}
	    }

	    # Apply post filters
	    if { [info exists var] } {
		foreach filter $apc_post_filters($formal_name) {
		    ad_complaints_with_key $formal_name:$filter {
			if { ![info exists apc_filter_parameters($formal_name:$filter)] } {
			    set filter_ok_p [[ad_page_contract_filter_proc $filter] $formal_name var]
			} else {
			    set filter_ok_p [[ad_page_contract_filter_proc $filter] $formal_name var $apc_filter_parameters($formal_name:$filter)]
			}
		    }
		    if { $filter_ok_p } {
			ad_page_contract_set_validation_passed $formal_name:$filter
		    } else { 
			break
		    }
		}
	    }
	    
	} else {
	    
	    # no value supplied for this arg spec
	    
	    if { [info exists apc_default_value($formal_name)] } {
		
		# Only use the default value if there has been no complaints so far
		# Why? Because if there are complaints, the page isn't going to serve anyway,
		# and because one default value may depend on another variable having a correct value.
		if { [ad_complaints_count] == 0 } {
		    # we need to set the default value
		    if { [info exists apc_internal_filter($formal_name:array)] } {
			array set var [uplevel subst \{$apc_default_value($formal_name)\}]
		    } else {
			set var [uplevel subst \{$apc_default_value($formal_name)\}]
		    }
		}
		
	    } elseif { ![info exists apc_internal_filter($formal_name:optional)] } {
		ad_complain -key $formal_name "[_ acs-tcl.lt_You_must_supply_a_val]"
	    }
	}
    }

    ####################
    #
    # Step 4: Execute validation blocks 
    #
    ####################

    set done_p 0
    while { !$done_p } {

	set done_p 1
	foreach validation_name [array names apc_validation_blocks] {
	    set dependencies [lindex $apc_validation_blocks($validation_name) 0]
	    set code [lindex $apc_validation_blocks($validation_name) 1]

	    set dependencies_met_p 1
	    #
	    # Check, of the variables of the dependencies were provided.
	    #
	    foreach dependency $dependencies {
		set varName [lindex [split $dependency ":"] 0]
		if { ![ad_page_contract_get_validation_passed_p $varName] } {
		    # var $varName was not provided
		    set dependencies_met_p 0
		    break
		}
	    }

	    #
	    # Check, whether the earlier section haven't returned
	    # errors, in which case the detailed validation is not
	    # necessary.
	    #
	    if { $dependencies_met_p && [ad_complaints_count] > 0} {
		set dependencies_met_p 0
	    }

	    if { $dependencies_met_p } {

		# remove from validation blocks array, so we don't execute the same block twice
		unset apc_validation_blocks($validation_name)

		set no_complaints_before [ad_complaints_count]

		# Execute the validation block with an environment with a default error key set
		set ::ad_page_contract_errorkeys [concat $validation_name $::ad_page_contract_errorkeys]
		set validation_ok_p [ad_page_contract_eval uplevel 1 $code]
		set ::ad_page_contract_errorkeys [lrange $::ad_page_contract_errorkeys 1 end]

		if { $validation_ok_p eq "" 
		     || ($validation_ok_p ne "1" && $validation_ok_p ne "0" )
		 } {
		    set validation_ok_p [expr {[ad_complaints_count] == $no_complaints_before}]
		}
		
		if { $validation_ok_p } {
		    set ::ad_page_contract_validations_passed($validation_name) 1
		    # more stuff to process still
		    set done_p 0
		}
		    
	    }
	}
    }

    ####################
    #
    # Done. Spit out error, if any
    #
    ####################

    # Initialize the list of page variables for other scripts to use
    set ::ad_page_contract_variables $apc_formals

    if { [ad_complaints_count] > 0 } {
	if { [info exists return_errors] } {
	    upvar 1 $return_errors error_list
	    set error_list [ad_complaints_get_list]
	} else {
            template::multirow create complaints text
            foreach elm [ad_complaints_get_list] {
                template::multirow append complaints $elm
            }
            ns_return 200 text/html [ad_parse_template -params [list complaints] "/packages/acs-tcl/lib/complain"]
	    ad_script_abort
	}
    }

    # Set the __submit_button_variable. This is used in double click protection.
    if {[info exists __submit_button_name] 
	&& $__submit_button_name ne "" 
	&& [info exists __submit_button_value]
    } {
	uplevel 1 [list set $__submit_button_name $__submit_button_value]
    }

XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: