ad_page_contract_filter (public)

 ad_page_contract_filter [ -deprecated ] [ -type type ] \
    [ -priority priority ] name proc_args doc_string body

Defined in packages/acs-tcl/tcl/tcl-documentation-procs.tcl

Declare a filter to be available for use in ad_page_contract.

Here's an example of how to declare a filter:

    ad_page_contract_filter integer { name value } {
        Checks whether the value is a valid integer, and removes any leading zeros so as
        not to confuse Tcl into thinking it's octal
    } {
        if { ![regexp {^[0-9]+$} $value] } {
            ad_complain [_ acs-tcl.lt_Value_is_not_an_integ]
            return 0
        set value [util::trim_leading_zeros $value]
        return 1
After the filter has been declared, it can be used as a flag in ad_page_contract, e.g.
    ad_page_contract {
    } {}
Note that there's only one global namespace for names. At some point, we might add package-local filters, but we don't have it yet.

The filter proc must return either 1 if it accepts the value or 0 if it rejects it. Any problem with the value is reported using ad_complain (see documentation for this). Note: Any modifications you make to value from inside your code block will modify the actual value being set in the page.

There are two types of filters. They differ in scope for variables that are multiple or array. The standard type of filter (filter classic) is invoked on each individual value before it's being put into the list or the array. A post filter is invoked after all values have been collected, and is invoked on the list or array as a whole.

(boolean) (optional)
used to flag a filter as deprecated
(defaults to "filter") (optional)
The type of filter; i.e. filter or post. Default is filter.
(defaults to "1000") (optional)
name - The name of the flag as used in ad_page_contract
proc_args - the arguments to your filter. The filter must take three arguments, name, value, and parameters, although you can name them any way you want. The first will be set to the name of the variable, the second will be upvar'd to the value, so that any change you make to the value will be reflected in the value ultimately being set in the page's environment, and the third is a list of arguments to the filter. This third argument can have multiple parameters split by | with no spaces or any other characters. Something like foo:range(3|5)
doc_string - Standard documentation-string. Tell other programmers what your filter does.
body - The body is a procedure body that performs the filtering. It'll automatically have one argument named value set, and it must either return the possibly transformed value, or throw an error. The error message will be displayed to the user.
Lars Pind <>
25 July 2000

Partial Call Graph (max 5 caller/called nodes):
%3 test_page_contracts page_contracts (test acs-tcl) ad_page_contract_filter ad_page_contract_filter test_page_contracts->ad_page_contract_filter _ _ (public) ad_page_contract_filter->_ ad_page_contract_filter_script ad_page_contract_filter_script (public) ad_page_contract_filter->ad_page_contract_filter_script ad_page_contract_filter_type ad_page_contract_filter_type (public) ad_page_contract_filter->ad_page_contract_filter_type

Source code:

    if { ![string is wordchar $name] || $name eq "" } {
        return -code error [_ acs-tcl.lt_Flag_name_must_be_a_v]
    if { [string tolower $name] ne $name } {
        return -code error [_ acs-tcl.lt_Flag_names_must_be_al]
    if { ![string match $type filter] && ![string match $type post] } {
        return -code error [_ acs-tcl.lt_Filter_type_must_be_f]

    set proc_args_len [llength $proc_args]

    if { $proc_args_len != 2 && $proc_args_len != 3 } {
        return -code error [_ acs-tcl.lt_Invalid_number_of_arg]

    set script [info script]
    set proc_name ad_page_contract_filter_proc_$name

    # Register the filter

    set mutex [nsv_get ad_page_contract_mutex filters]
    ns_mutex lock $mutex

    set prior_type [ad_page_contract_filter_type $name]

    if {$prior_type eq "internal"} {
        ns_mutex unlock $mutex
        return -code error [_ acs-tcl.lt_The_flag_name_name_is]
    } elseif$prior_type ne "" } {
        set prior_script [ad_page_contract_filter_script $name]
        if { $prior_script ne $script } {
            ns_log Warning [_ acs-tcl.lt_Multiple_definitions_]
    set filter_info [list $type $proc_name $doc_string $script $priority]
    set ::acs::ad_page_contract_filters($name$filter_info
    nsv_set ad_page_contract_filters $name $filter_info
    ns_mutex unlock $mutex

    # Declare the proc

    # this may look complicated, but it's really pretty simple:
    # If you declare a filter like this: ad_page_contract_filter foo { name value } { ... }
    # it turns into this proc:
    # ad_proc ad_page_contract_filter_proc_foo { name value_varname } { upvar $value_varname value ; ... }
    # so that when the filter proc is passed the name of a variable, the body of the proc
    # will have access to that variable as if the value had been passed.

    set visibility [expr {$deprecated_p ? "-deprecated" : "-public"}]

    lassign $proc_args arg0 arg1 arg2
    if { $proc_args_len == 2 } {
        d_proc $visibility $proc_name [list $arg0 ${arg1}_varname] $doc_string "upvar \$${arg1}_varname $arg1\n$body"
    } else {
        d_proc $visibility $proc_name [list $arg0 ${arg1}_varname $arg2$doc_string "upvar \$${arg1}_varname $arg1\n$body"
XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: