_acs-tcl__ad__sanitize_filename (private)
_acs-tcl__ad__sanitize_filename
Defined in packages/acs-tcl/tcl/test/utilities-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 {{ aa_section "Sanitized string without an extension" set str "A;\\ <<<ß*>CoOO/etc/passwdl# \"\u001f:: f__?ilename \u0000" # Our test string is poisonous enough that this log command # would fail... # aa_log "Checking against '$str'" aa_equals "Basic sanitizing" [ad_sanitize_filename $str] "A ßCoOOetcpasswdl# f__ilename " aa_equals "Collapsing spaces" [ad_sanitize_filename -collapse_spaces $str] "A-ßCoOOetcpasswdl#-f__ilename-" aa_equals "Collapsing spaces with a custom separator" [ad_sanitize_filename -replace_with _ -collapse_spaces $str] "A_ßCoOOetcpasswdl#_f__ilename_" aa_equals "Collapsing spaces with a custom separator, to lowercase" [ad_sanitize_filename -tolower -replace_with _ -collapse_spaces $str] [string tolower "A_ßCoOOetcpasswdl#_f__ilename_"] aa_true "Sanitizing to an existing filename without resolving throws an error" [catch { ad_sanitize_filename -tolower -replace_with _ -collapse_spaces -no_resolve -existing_names {a_ßcoooetcpasswdl#_f__ilename_} $str }] aa_false "Sanitizing without resolving does not throw an error with an empty list fo existing names" [catch { ad_sanitize_filename -tolower -replace_with _ -collapse_spaces -no_resolve -existing_names {} $str }] set resolved [ad_sanitize_filename -tolower -replace_with _ -collapse_spaces -existing_names {a_ßcoooetcpasswdl#_f__ilename_} $str] aa_equals "Sanitizing to an existing filename with resolving is fine" $resolved [string tolower "A_ßCoOOetcpasswdl#_f__ilename_"]_2 aa_section "Sanitized string containing an extension" set str "A;\\ <<<ß*>CoOO/etc/passwdl# \"\u001f:: f__?ilename \u0000.extension" aa_equals "Basic sanitizing" [ad_sanitize_filename $str] "A ßCoOOetcpasswdl# f__ilename .extension" aa_equals "Collapsing spaces" [ad_sanitize_filename -collapse_spaces $str] "A-ßCoOOetcpasswdl#-f__ilename-.extension" aa_equals "Collapsing spaces with a custom separator" [ad_sanitize_filename -replace_with _ -collapse_spaces $str] "A_ßCoOOetcpasswdl#_f__ilename_.extension" aa_equals "Collapsing spaces with a custom separator, to lowercase" [ad_sanitize_filename -tolower -replace_with _ -collapse_spaces $str] [string tolower "A_ßCoOOetcpasswdl#_f__ilename_.extension"] aa_true "Sanitizing to an existing filename without resolving throws an error" [catch { ad_sanitize_filename -tolower -replace_with _ -collapse_spaces -no_resolve -existing_names {a_ßcoooetcpasswdl#_f__ilename_.extension} $str }] aa_false "Sanitizing without resolving does not throw an error with an empty list fo existing names" [catch { ad_sanitize_filename -tolower -replace_with _ -collapse_spaces -no_resolve -existing_names {} $str }] set resolved [ad_sanitize_filename -tolower -replace_with _ -collapse_spaces -existing_names {a_ßcoooetcpasswdl#_f__ilename_.extension} $str] aa_equals "Sanitizing to an existing filename with resolving is fine" $resolved [string tolower "A_ßCoOOetcpasswdl#_f__ilename_.extension"]_2 aa_false "Sanitizing with not balanced parentheses in the filename does not throw an error" [catch { aa_equals "Sanitizing to an existing filename with resolving is fine" [ad_sanitize_filename -existing_names {foo( foo(-3} "foo("] "foo(-4" }] }} { 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" "ad__sanitize_filename (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo" } incr body_count }XQL Not present: Generic, PostgreSQL, Oracle