_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):
%3 aa_log aa_log (public) aa_log_result aa_log_result (public) aa_silence_log_entries aa_silence_log_entries (public) ad_decode ad_decode (public) db_foreach db_foreach (public) _acs-tcl__datamodel__named_constraints _acs-tcl__datamodel__named_constraints _acs-tcl__datamodel__named_constraints->aa_log _acs-tcl__datamodel__named_constraints->aa_log_result _acs-tcl__datamodel__named_constraints->aa_silence_log_entries _acs-tcl__datamodel__named_constraints->ad_decode _acs-tcl__datamodel__named_constraints->db_foreach

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
[ hide source ] | [ make this the default ]
Show another procedure: