_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):
- 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