_acs-tcl__documentation__check_proc_doc (private)

 _acs-tcl__documentation__check_proc_doc

Defined in packages/acs-tcl/tcl/test/doc-check-procs.tcl

Partial Call Graph (max 5 caller/called nodes):
%3 aa_error aa_error (public) aa_log aa_log (public) aa_log_result aa_log_result (public) acs::icanuse acs::icanuse (public) api_proc_link api_proc_link (public) _acs-tcl__documentation__check_proc_doc _acs-tcl__documentation__check_proc_doc _acs-tcl__documentation__check_proc_doc->aa_error _acs-tcl__documentation__check_proc_doc->aa_log _acs-tcl__documentation__check_proc_doc->aa_log_result _acs-tcl__documentation__check_proc_doc->acs::icanuse _acs-tcl__documentation__check_proc_doc->api_proc_link

Testcases:
No testcase defined.
Source code:
        
        set _aa_export {}
        set body_count 1
        foreach testcase_body {{
    set count 0
    set good 0
    #
    # Certain procs are defined outside the OpenACS installation
    # source tree, e.g. in nsf. If they fail the test, the regular
    # OpenACS administrator cannot do much about it, so we only
    # generate a warning for them.
    #
    set ignored_namespaces {
        nx
        nsshell
    }
    set excluded_proc_index {
        { Object ::ns_cache}
        { Object ::xo::lti::LTI::per-object-slot}
    }
    foreach p [lsort -dictionary [nsv_array names api_proc_doc]] {
        set pa [nsv_get api_proc_doc $p]
        if { [dict exists $pa protection]
             && "public" in [dict get $pa protection]
             && !([dict get $pa deprecated_p] || [dict get $pa warn_p])
             && ![string match *::slot* $p]
             && ![string match "ns_*" $p]
             && $p ni $excluded_proc_index
         } {
            #
            # For nx objects and classes, we check, if we find the
            # place where it was defined (script_name). If thiswe
            # cannot determine the location this indicates that it
            # might not be defined by OpenACS, or it might hint a bug.
            #
            set obj [::xo::api object_from_proc_index $p]
            if {$obj ne "" && [nsf::is object,type=::nx::Object $obj]} {
                set obj [namespace which $obj]
                set skip [::acs::per_request_cache eval -key script-name-$obj {
                    set script_name [::xo::api script_name -obj $obj {}]
                    if {$script_name eq ""} {
                        aa_log "Cannot determine script name for object '$obj' (proc_index: $p)"
                        set result 1
                    } else {
                        set result 0
                    }
                }]
                #ns_log notice "SKIP '$skip' for <$obj> // $p"
                if {$skip} {
                    continue
                }
            }

            incr count
            if { [string is space [join [dict get $pa main]]] &&
                 (![dict exists $pa return] || [string is space [join [dict get $pa return]]]) &&
                 (![dict exists $pa param] || [string is space [join [dict get $pa param]]]) &&
                 (![dict exists $pa see] || [string is space [join [dict get $pa see]]]) &&
                 (![dict exists $pa author] || [string is space [join [dict get $pa author]]])
             } {
                if {[regexp "^(\\s+Class ::)?([join $ignored_namespaces |])::.*\$" $p m]} {
                    set test_result warning
                } else {
                    set test_result fail
                }
                aa_log_result $test_result "No documentation for public proc <a href='/api-doc/proc-view?proc=[ns_urlencode $p]'>$p</a>"
            } else {
                incr good
            }
        }
    }
    aa_log "Found $good public procs with proper documentation (out of $count checked)"

    if {[::acs::icanuse "ns_parsehtml"]} {
        set nrTags 0
        set nrNotAllowedTags 0
        set allowedTags {
            h3 /h3
            h4 /h4
            p /p
            a /a
            blockquote /blockquote
            dd /dd
            dt /dt
            dl /dl
            ul /ul
            ol /ol
            li /li
            table /table
            td /td
            th /th
            tr /tr
            pre /pre
            code /code
            tt /tt
            strong /strong
            b /b
            i /i
            em /em
            span /span
            br
        }
        foreach p [lsort -dictionary [nsv_array names api_proc_doc]] {
            set dict [nsv_get api_proc_doc $p]
            if {[dict exists $dict main]} {
                set text [dict get $dict main]
                foreach chunk [::ns_parsehtml -- $text] {
                    lassign $chunk what chunk content
                    if {$what eq "tag"} {
                        incr nrTags
                        set tag [lindex $content 0]
                        if {$tag ni $allowedTags} {
                            aa_error "[api_proc_link $p]: tag '$tag' not allowed '[ns_quotehtml <$content>]'"
                            incr nrNotAllowedTags
                        }
                    }
                }
            }
        }
        aa_log "Found $nrTags tags in documentation, $nrNotAllowedTags not allowed"
    }


}} {
          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" "documentation__check_proc_doc (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: