db_qd_get_fullname (public)

 db_qd_get_fullname local_name [ added_stack_num ]

Defined in packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl

Find the fully qualified name of the query

Parameters:

local_name (required)

added_stack_num (optional, defaults to "1")

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

Testcases:

db__database_interface

Source code:

    # We do a check to see if we already have a fullname.
    # Since the DB procs are a bit incestuous, this might get
    # called more than once. DAMMIT! (ben)
    if {![db_qd_relative_path_p $local_name]} {
        return $local_name
    }

    # Get the proc name being executed.
    # We catch this in case we're being called from the top level
    # (e.g. from bootstrap.tcl), in which case we return what we
    # were given
    if { [catch {string trimleft [info level [expr {-1 - $added_stack_num}]] ::} proc_name] } {
        return [::nsf::strip_proc_name $local_name]
    }

    # If util_memoize, we have to go back up one in the stack
    if {[lindex $proc_name 0] eq "util_memoize"} {
        # db_qd_log QDDebug "util_memoize! going up one level"
        set proc_name [info level [expr {-2 - $added_stack_num}]]
    }

    set proc_name [::nsf::strip_proc_name $proc_name]
    set list_of_source_procs {
        ns_sourceproc
        apm_source
        template::adp_parse
        template::frm_page_handler
        rp_handle_tcl_request
    }

    # We check if we're running the special ns_ proc that tells us
    # whether this is a URL or a Tcl proc.
    if { [lindex $proc_name 0] in $list_of_source_procs } {

        # Means we are running inside a URL

        # TEST
        # for {set i 0} {$i < 6} {incr i} {
        #   if {[catch {db_qd_log QDDebug "LEVEL=$i= [info level [expr {-1 - $i}]]"} errmsg]} {}
        # }

        # Check the ad_conn stuff
        # if {[ns_conn isconnected]} {
        #   if {[catch {db_qd_log QDDebug "the ad_conn file is [ad_conn file]"} errmsg]} {}
        # }

        # Now we do a check to see if this is a directly accessed URL or a
        # sourced URL

        # added case for handling .vuh files which are sourced from
        # rp_handle_tcl_request.  Otherwise, QD was forming fullquery path
        # with the assumption that the query resided in the
        # rp_handle_tcl_request proc itself. (OpenACS - DanW)

        switch $proc_name {

            ns_sourceproc {
                # db_qd_log QDDebug "We are in a WWW page, woohoo!"
                set real_url_p 1
                set url [ns_conn url]
            }

            rp_handle_tcl_request {
                # db_qd_log QDDebug "We are in a VUH page sourced by rp_handle_tcl_request, woohoo!"
                set real_url_p 0
                regsub {\.vuh} [ad_conn file] {} url
                set url [ad_make_relative_path $url]
                regsub {^/?packages} $url {} url
            }

            template::frm_page_handler {
                # db_qd_log QDDebug "We are in the template system's form page debugger!"
                set real_url_p 1
                regsub {\.frm} [ad_conn url] {} url
            }

            default {
                # db_qd_log QDDebug "We are in a WWW page sourced by apm_source, woohoo!"
                set real_url_p 0
                set url [lindex $proc_name 1]
                set url [ad_make_relative_path $url]
                regsub {^/?packages} $url {} url
            }
        }

        # Get the URL and remove the .tcl
        regsub {^/} $url {} url
        regsub {\.tcl$} $url {} url
        regsub {\.vuh$} $url {} url

        # Change all dots to colons, and slashes to dots
        regsub -all {\.} $url {:} url
        regsub -all {/} $url {.} url

        # We insert the "www" after the package key
        set rest {}
        regexp {^([^\.]*)(.*)} $url all package_key rest

        # db_qd_log QDDebug "package key is $package_key and rest is $rest"

        if {$real_url_p} {
            set full_name [db_qd_make_absolute_path "${package_key}.www${rest}." $local_name]
            # set full_name "acs.${package_key}.www${rest}.${local_name}"
        } else {
            set full_name [db_qd_make_absolute_path "${package_key}${rest}." $local_name]
            # set full_name "acs.${package_key}${rest}.${local_name}"
        }
    } else {
        # Let's find out where this Tcl proc is defined!!
        # Get the first word, which is the Tcl proc
        regexp {^([^ ]*).*} $proc_name all proc_name

        # check to see if a package proc is being called without
        # namespace qualification.  If so, add the package qualification to the
        # proc_name, so that the correct query can be looked up.
        # (OpenACS - DanW)

        set calling_namespace [string range [uplevel [expr {1 + $added_stack_num}] {namespace current}] 2 end]
        # db_qd_log QDDebug "calling namespace = $calling_namespace"

        if {$calling_namespace ne "" &&
            ![string match "*::*" $proc_name]} {
            set proc_name ${calling_namespace}::${proc_name}
        }
        # db_qd_log QDDebug "proc_name is -$proc_name-"

        # We use the ad_proc construct!!
        # (woohoo, can't believe that was actually useful!)

        # First we check if the proc is there. If not, then we're
        # probably dealing with one of the bootstrap procs, and so we just
        # return a bogus proc name
        if {![nsv_exists api_proc_doc $proc_name]} {
            ns_log warning "db_qd_get_fullname: there is no documented proc "  "with name $proc_name returning [db_qd_null_path] "  "(declare proc $proc_name with ad_proc to make it "  "work with the query dispatcher"
            return [db_qd_null_path]
        }

        array set doc_elements [nsv_get api_proc_doc $proc_name]
        set url $doc_elements(script)

        # db_qd_log QDDebug "tcl file is $url"

        regsub {.tcl$} $url {} url

        # Change all dots to colons, and slashes to dots
        regsub -all {\.} $url {:} url
        regsub -all {/} $url {.} url

        # We get something like packages.acs-tcl.tcl.acs-kernel-procs
        # We need to remove packages.
        set rest {}
        regexp {^packages\.(.*)} $url all rest

        # db_qd_log QDDebug "TEMP - QD: proc_name is $proc_name"
        # db_qd_log QDDebug "TEMP - QD: local_name is $local_name"

        # set full_name "acs.$rest.${proc_name}.${local_name}"
        set full_name [db_qd_make_absolute_path "${rest}.${proc_name}." $local_name]
    }

    # db_qd_log QDDebug "generated fullname of $full_name"

    #
    # The following block is apparently just for debugging.
    #
    # if {[llength $proc_name] > 1} {
    #     set proc_name_with_parameters "[lindex $proc_name 0] "
    #     set i 1
    #     foreach parameter [lrange $proc_name  1 end] {
    #         append proc_name_with_parameters "parameter$i: $parameter "
    #         incr i
    #     }
    # } else {
    #     set proc_name_with_parameters $proc_name
    # }
    # db_qd_log QDDebug "db_qd_get_fullname: following query in file: $url proc: $proc_name_with_parameters"

    return $full_name

XQL Not present:

Generic, PostgreSQL, Oracle