_acs-tcl__files__check_xql_files (private)

 _acs-tcl__files__check_xql_files

Defined in packages/acs-tcl/tcl/test/file-test-procs.tcl

Partial Call Graph (max 5 caller/called nodes):
%3 aa_false aa_false (public) aa_log aa_log (public) aa_log_result aa_log_result (public) ad_file ad_file (public) apm_get_installed_versions apm_get_installed_versions (public) _acs-tcl__files__check_xql_files _acs-tcl__files__check_xql_files _acs-tcl__files__check_xql_files->aa_false _acs-tcl__files__check_xql_files->aa_log _acs-tcl__files__check_xql_files->aa_log_result _acs-tcl__files__check_xql_files->ad_file _acs-tcl__files__check_xql_files->apm_get_installed_versions

Testcases:
No testcase defined.
Source code:
        
        set _aa_export {}
        set body_count 1
        foreach testcase_body {{
    # if startdir is not $::acs::rootdir/packages, then somebody checked in the wrong thing by accident
    set startdir $::acs::rootdir/packages

    aa_log "Checks starting from $startdir"

    # get xql files from installed packages
    set files [list]
    apm_get_installed_versions -array installed_versions
    foreach {package_key version} [array get installed_versions] {
        lappend files {*}[lmap f [apm_get_package_files  -package_key $package_key  -file_types {query_file}] {
            set f $startdir/$package_key/$f
        }]
    }

    foreach file $files {

        set fp [open $file "r"]
        set data [read $fp]
        close $fp
        ns_log debug "acs_tcl__check_xql_files: read $file"
        set data [db_qd_prepare_queryfile_content $data]

        set parse_failed_p [catch {set parse [xml_parse $data]} errMsg]
        aa_false "xql $file correctly parsed" $parse_failed_p

        # Errors:
        #   .xql files without .tcl
        #   dbname not blank or postgresql or oracle
        #   -oracle w/o generic or -postgresql
        #   -postgresql w/o generic or -oracle
        #

        regexp {(.*)[.]xql$} $file match base

        if {![ad_file exists ${base}.tcl] && ![ad_file exists ${base}.vuh]} {
            # the file did not exist so we must have a -db extension...
            regexp {(.*?)(-)?([A-Za-z_]*)[.]xql$} $file match base dummy db

            if { $db ne ""
                 && $dummy ne ""
                 && ![string match $db oracle]
                 && ![string match $db postgresql] } {
                aa_log_result fail "bad db name \"$db\" file $file (or maybe .tcl or .vuh missing)"
            } elseif$db ne ""
                       && $dummy ne ""
                       && ![regexp $db $data] } {
                aa_log_result fail "rdbms \"$db\" missing $file"
            } elseif {$dummy eq ""
                      && [regexp {<rdbms>} $data] } {
                aa_log_result fail "rdbms found in generic $file"
            }

            if {$db eq "postgresql" || $dummy eq ""} {
                if {[regexp -nocase {(nvl[ ]*\(|decode[ ]*\(| connect by )} $data match]} {
                    aa_log_result fail "postgres or generic with oracle code $file: $match"
                }
                if {[regexp -nocase {((limit|offset)[ ]*:)} $data match]} {
                    aa_log_result fail "postgres <7.4 does not support limit :var binding with our driver"
                }
                set allxql($base$file
            } else {
                if {[regexp -nocase {(now[ ]*\(| limit | offset | outer join )} $data match ] || $dummy eq ""} {
                    aa_log_result fail "oracle or generic with postgres code $file: $match"
                }
                set allxql($base$file
            }
        } else {
            set allxql($base$file
        }
    }

    foreach xql [array names allxql] {
        # check there is a corresponding .tcl file
        if {![ad_file exists ${xql}.tcl]
            && ![ad_file exists ${xql}.vuh]} {
            # JCD: Hack to exclude calendar/www/views which is the only current file which has
            # no associated Tcl file.
            if {[string first calendar/www/views $allxql($xql)] <  0} {
                aa_log_result fail "missing .tcl or .vuh file for $allxql($xql)"
            }
        }
        if { 0 } {
            # JCD: disabled for now...

            # check that if there is a db specific version that the corresponding
            # generic or other db file exists...
            if {[info exists onexql(${xql}-oracle)]
                && !([info exists onexql(${xql}-postgresql)]
                     || [info exists onexql(${xql})]) } {
                aa_log_result fail "No postgresql or generic $allxql($xql)"
            }
            if {[info exists onexql(${xql}-postgresql)]
                && !([info exists onexql(${xql}-oracle)]
                     || [info exists onexql(${xql})]) } {
                aa_log_result fail "No oracle or generic $allxql($xql)"
            }
        }
    }
}} {
          aa_log "Running testcase body $body_count"
          set ::__aa_test_indent [info level]
          set catch_val [catch $testcase_body msg]
          if {$catch_val != 0 && $catch_val != 2} {
              aa_log_result "fail" "files__check_xql_files (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo"
          }
          incr body_count
        }
XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: