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