cmdr
Artifact Content
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Artifact 9bd389ca09b3b47767c34650e440838daba7f416:


## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Validate - Definition of core validation classes.

# @@ Meta Begin
# Package cmdr::validate 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Standard validation types for parameters.
# Meta description Standard validation types for parameters.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require cmdr::validate::common
package require debug
package require debug::caller

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export validate
    namespace ensemble create
}

namespace eval ::cmdr::validate {
    namespace export boolean integer double percent identity \
	pass str rfile rwfile rdirectory rwdirectory rpath rwpath
    #namespace ensemble create

    # For external v-types relying on them here.
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-enum
}

# # ## ### ##### ######## ############# #####################

debug define cmdr/validate
debug level  cmdr/validate
debug prefix cmdr/validate {[debug caller] | }

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr::validate::boolean {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-enum
}

proc ::cmdr::validate::boolean::release  {p x} { return }
proc ::cmdr::validate::boolean::default  {p}  {
    debug.cmdr/validate {}
    return no
}

proc ::cmdr::validate::boolean::complete {p x} {
    debug.cmdr/validate {} 10
    return [complete-enum {yes no false true on off 0 1} 1 $x]
}

proc ::cmdr::validate::boolean::validate {p x} {
    debug.cmdr/validate {}
    if {[string is boolean -strict $x]} {
	# Double inverse keeps value, and makes it canonical.
	return [expr {!!$x}]
    }
    fail $p BOOLEAN "a boolean" $x
}

# # ## ### ##### ######## ############# #####################
## Any integer

namespace eval ::cmdr::validate::integer {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
}

proc ::cmdr::validate::integer::release  {p x} { return }
proc ::cmdr::validate::integer::default  {p}  {
    debug.cmdr/validate {}
    return 0
}
proc ::cmdr::validate::integer::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::integer::validate {p x} {
    debug.cmdr/validate {}

    # While we accept integers in octal and hex we convert them into
    # proper decimals for internal use, as our standard
    # representation.
    if {[string is integer -strict $x]} {
	return [format %d $x]
    }
    fail $p INTEGER "an integer" $x
}

# # ## ### ##### ######## ############# #####################
## Any double

namespace eval ::cmdr::validate::double {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
}

proc ::cmdr::validate::double::release  {p x} { return }
proc ::cmdr::validate::double::default  {p}  {
    debug.cmdr/validate {}
    return 0
}
proc ::cmdr::validate::double::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::double::validate {p x} {
    debug.cmdr/validate {}
    if {[string is double -strict $x]} { return $x }
    fail $p DOUBLE "a double" $x
}

# # ## ### ##### ######## ############# #####################
## Any double in [0,100]

namespace eval ::cmdr::validate::percent {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
}

proc ::cmdr::validate::percent::release  {p x} { return }
proc ::cmdr::validate::percent::default  {p}  {
    debug.cmdr/validate {}
    return 0
}
proc ::cmdr::validate::percent::complete {p x} {
    debug.cmdr/validate {} 10
    return {}
}
proc ::cmdr::validate::percent::validate {p x} {
    debug.cmdr/validate {}
    if {[string is double -strict $x] &&
	($x >= 0) &&
	($x <= 100)} { return $x }
    fail $p PERCENT "a percentage" $x
}

# # ## ### ##### ######## ############# #####################
## Any string

namespace eval ::cmdr::validate::identity {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::identity::release  {p x} { return }
proc ::cmdr::validate::identity::default  {p}   { debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::identity::complete {p x} { debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::identity::validate {p x} { debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## Any string, alternate name

namespace eval ::cmdr::validate::pass {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::pass::release  {p x} { return }
proc ::cmdr::validate::pass::default  {p}   {debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::pass::complete {p x} {debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::pass::validate {p x} {debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## Any string, alternate name, the second

namespace eval ::cmdr::validate::str {
    namespace export default validate complete release
    namespace ensemble create
}

proc ::cmdr::validate::str::release  {p x} { return }
proc ::cmdr::validate::str::default  {p}   { debug.cmdr/validate {}    ; return {} }
proc ::cmdr::validate::str::complete {p x} { debug.cmdr/validate {} 10 ; return {} }
proc ::cmdr::validate::str::validate {p x} { debug.cmdr/validate {}    ; return $x }

# # ## ### ##### ######## ############# #####################
## File, existing and readable

namespace eval ::cmdr::validate::rfile {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rfile::release  {p x} { return }
proc ::cmdr::validate::rfile::default  {p}   { return {} }
proc ::cmdr::validate::rfile::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rfile::Ok $x
}
proc ::cmdr::validate::rfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RFILE "an existing readable file" $x
}

proc ::cmdr::validate::rfile::Ok {path} {
    if {![file exists   $path]} {return 0}
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## File, existing and read/writable

namespace eval ::cmdr::validate::rwfile {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rwfile::release  {p x} { return }
proc ::cmdr::validate::rwfile::default  {p}   { return {} }
proc ::cmdr::validate::rwfile::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwfile::Ok $x
}
proc ::cmdr::validate::rwfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWFILE "an existing read/writable file" $x
}

proc ::cmdr::validate::rwfile::Ok {path} {
    if {![file exists   $path]} {return 0}
    if {![file isfile   $path]} {return 0}
    if {![file readable $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Directory, existing and readable.

namespace eval ::cmdr::validate::rdirectory {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rdirectory::release  {p x} { return }
proc ::cmdr::validate::rdirectory::default  {p}   { return {} }
proc ::cmdr::validate::rdirectory::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rdirectory::Ok $x
}

proc ::cmdr::validate::rdirectory::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RDIRECTORY "an existing readable directory" $x
}

proc ::cmdr::validate::rdirectory::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Directory, existing and read/writable.

namespace eval ::cmdr::validate::rwdirectory {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rwdirectory::release  {p x} { return }
proc ::cmdr::validate::rwdirectory::default  {p}   { return {} }
proc ::cmdr::validate::rwdirectory::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwdirectory::Ok $x
}

proc ::cmdr::validate::rwdirectory::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWDIRECTORY "an existing read/writeable directory" $x
}

proc ::cmdr::validate::rwdirectory::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Any path, existing and readable.

namespace eval ::cmdr::validate::rpath {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rpath::release  {p x} { return }
proc ::cmdr::validate::rpath::default  {p}   { return {} }
proc ::cmdr::validate::rpath::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rpath::Ok $x
}

proc ::cmdr::validate::rpath::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RPATH "an existing readable path" $x
}

proc ::cmdr::validate::rpath::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file isdirectory $path]} {return 0}
    if {![file readable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Any path, existing and read/writable.

namespace eval ::cmdr::validate::rwpath {
    namespace export default validate complete release
    namespace ensemble create
    namespace import ::cmdr::validate::common::fail
    namespace import ::cmdr::validate::common::complete-glob
}

proc ::cmdr::validate::rwpath::release  {p x} { return }
proc ::cmdr::validate::rwpath::default  {p}   { return {} }
proc ::cmdr::validate::rwpath::complete {p x} {
    debug.cmdr/validate {} 10
    complete-glob ::cmdr::validate::rwpath::Ok $x
}

proc ::cmdr::validate::rwpath::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p RWPATH "an existing read/writeable path" $x
}

proc ::cmdr::validate::rwpath::Ok {path} {
    if {![file exists      $path]} {return 0}
    if {![file readable    $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::validate 1.2.1
return