_acs-tcl__datamodel__named_constraints (private)
_acs-tcl__datamodel__named_constraints
Defined in packages/acs-tcl/tcl/test/datamodel-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 {{ set db_is_pg_p [string equal [db_name] "PostgreSQL"] if { $db_is_pg_p } { set get_constraints { select cla.relname as table_name, con.conrelid, con.conname as constraint_name, CASE when con.contype='c' then 'ck' when con.contype='f' then 'fk' when con.contype='p' then 'pk' when con.contype='u' then 'un' else '' END as constraint_type, con.conkey, '' as search_condition from pg_constraint con, pg_class cla where con.conrelid != 0 and cla.oid=con.conrelid order by table_name,constraint_name } set get_constraint_col { select attname from pg_attribute where attnum = :columns_list and attrelid = :conrelid } } else { # Oracle set get_constraints { select acc.*, ac.search_condition, decode(ac.constraint_type,'C','CK','R','FK','P','PK','U','UN','') as constraint_type from (select count(column_name) as columns, table_name, constraint_name from user_cons_columns group by table_name, constraint_name) acc, user_constraints ac where ac.constraint_name = acc.constraint_name order by acc.table_name, acc.constraint_name } set get_constraint_col { select column_name from user_cons_columns where constraint_name = :constraint_name } } db_foreach check_constraints $get_constraints { if { $db_is_pg_p || [string last "$" $table_name] eq -1 } { if {[string range $constraint_name 0 2] eq "pg_"} { # # Don't complain about PostgreSQL not naming its # constraints according to the OpenACS rules. # continue } regsub {_[[:alpha:]]+$} $constraint_name "" name_without_type set standard_name "${name_without_type}_${constraint_type}" set standard_name_alt "${name_without_type}_[ad_decode $constraint_type pk pkey fk fkey un key ck ck missing]" if { $db_is_pg_p } { set columns_list [split [string range $conkey 1 end-1] ","] set columns [llength $columns_list] } if { $columns eq 1 } { set column_name [db_string get_col $get_constraint_col] # NOT NULL constraints (oracle only) if { $search_condition eq "\"$column_name\" IS NOT NULL" } { set constraint_type "NN" } set full_name ${table_name}_${column_name}_${constraint_type} if { [string length $full_name] < 30 } { # Only check the abbreviation set checked_name $full_name } else { set checked_name $standard_name } } else { set checked_name $standard_name } # Giving a hint for constraint naming if {[string range $checked_name 0 2] eq "SYS"} { set hint "unnamed" } else { set hint "hint: $checked_name" } if { $checked_name ne $constraint_name } { set oversized [expr {[string length $constraint_name] >= 30}] set oversized_checked [expr {[string length $checked_name] >= 30}] if {!$oversized && $oversized_checked} { # # Don't complain, if the standard name is # oversized, but the chosen variant is not. # } else { # # Too many entries for the log, we the information as well in the protocol # aa_silence_log_entries -severities warning { aa_log_result fail "Constraint '$constraint_name' ($constraint_type)" " violates naming standard ($hint)" " oversized $oversized oversized by standard naming $oversized_checked" } } } } } }} { 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" "datamodel__named_constraints (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo" } incr body_count }XQL Not present: Generic, PostgreSQL, Oracle