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