aa_proc_copy (private)

 aa_proc_copy proc_name_old proc_name_new [ new_body ]

Defined in packages/acs-automated-testing/tcl/aa-test-procs.tcl

Copy a Tcl or NSF procedure for automated-test stub management, optionally substituting a new body. Preserve the argument list and defaults, and retain any required OpenACS argument parser in the copied body.

Parameters:

proc_name_old (required)

Procedure to copy.

proc_name_new (required)

Name of the copy to create.

new_body (optional)

Replacement body, or empty to copy the existing body.

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

    #
    # This is a single proc handling all stub management requirements
    # from aa-testing. Since the arglist nsf::procs is not simply "args"
    # (like for proc based ad_procs), but the real argument/parameter
    # list, we address these differences here for all needed cases.
    #
    if {[info procs $proc_name_old] ne ""} {
        #
        # We copy a regular Tcl proc
        #
        set args {}
        foreach arg [info args $proc_name_old] {
            if { [info default $proc_name_old $arg default_value] } {
                lappend args [list $arg $default_value]
            } else {
                lappend args $arg
            }
        }
        set old_body [info body $proc_name_old]
        if {$new_body eq ""} {
            set new_body $old_body
        }
        set arg_parser "[namespace tail $proc_name_old]__arg_parser"
        #
        # In case an arg-parser was used in the old body, but is
        # missing in the new version, add it automatically to the new
        # body.
        #
        if {[string match "*$arg_parser*" $old_body]} {
            if {![string match "*$arg_parser*" $new_body]} {
                set new_body $arg_parser\n$new_body
                #ns_log notice "... auto added arg_parser for '$proc_name_new' ====> new_body $new_body"
            }
        }
        ::proc $proc_name_new $args $new_body
    } elseif {$::acs::useNsfProc && [namespace which $proc_name_old] ne ""} {
        #
        # We copy a nsf::proc
        #
        # Use an absolute name to reference to a nsf::proc
        # unambiguously
        #
        set proc_name [namespace which $proc_name_old]
        if {$new_body eq ""} {
            set new_body [::nsf::cmd::info body $proc_name]
        }
        nsf::proc -ad $proc_name_new  [::nsf::cmd::info parameter $proc_name]  $new_body
    } else {
        error "no such proc $proc_name_old"
    }

XQL Not present:

Generic, PostgreSQL, Oracle