1# # ## ### ##### ######## ############# ###################### 2## (C) 2011 Andreas Kupries. BSD licensed. 3# 4## Common helper commands for the validation types in this 5## module. 6 7# # ## ### ##### ######## ############# ###################### 8 9# # ## ### ##### ######## ############# ###################### 10## Requisites 11 12package require Tcl 8.5 13namespace eval ::valtype::common {} 14 15# # ## ### ##### ######## ############# ###################### 16## Implementation 17 18proc ::valtype::common::reject {code text} { 19 if {[string match {[aeiouAEIOU]*} $text]} { 20 set prefix "Not an " 21 } else { 22 set prefix "Not a " 23 } 24 25 return -code error \ 26 -errorcode [list INVALID {*}$code] \ 27 $prefix$text 28} 29 30proc ::valtype::common::badchar {code {text {}}} { 31 reject [list {*}$code CHAR] $text 32} 33 34proc ::valtype::common::badcheck {code {text {}}} { 35 if {$text ne {}} { append text ", " } 36 append text "the check digit is incorrect" 37 reject [list {*}$code CHECK-DIGIT] $text 38} 39 40proc ::valtype::common::badlength {code lengths {text {}}} { 41 set ln [llength $lengths] 42 if {$text ne {}} { append text ", " } 43 append text "incorrect length" 44 if {$ln} { 45 if {$ln == 1} { 46 append text ", expected [lindex $lengths 0] characters" 47 } else { 48 append text ", expected one of [linsert [join $lengths {, }] end-1 or] characters" 49 } 50 } 51 reject [list {*}$code LENGTH] $text 52} 53 54proc ::valtype::common::badprefix {code prefixes {text {}}} { 55 set ln [llength $prefixes] 56 if {$text ne {}} { append text ", " } 57 append text "incorrect prefix" 58 if {$ln} { 59 if {$ln == 1} { 60 append text ", expected [lindex $prefixes 0]" 61 } else { 62 append text ", expected one of [linsert [join $prefixes {, }] end-1 or]" 63 } 64 } 65 reject [list {*}$code PREFIX] $text 66} 67 68# # ## ### ##### ######## ############# ###################### 69 70namespace eval ::valtype::common { 71 namespace export reject badchar badcheck badlength badprefix 72} 73 74# # ## ### ##### ######## ############# ###################### 75## Ready 76 77package provide valtype::common 1 78