snit/validate.tcl

   1 #-----------------------------------------------------------------------
   2 # TITLE:
   3 #    validate.tcl
   4 #
   5 # AUTHOR:
   6 #    Will Duquette
   7 #
   8 # DESCRIPTION:
   9 #    Snit validation types.
  10 #
  11 #-----------------------------------------------------------------------
  12
  13 namespace eval ::snit:: {
  14     namespace export \
  15         boolean \
  16         double \
  17         enum \
  18         fpixels \
  19         integer \
  20         listtype \
  21         pixels \
  22         stringtype \
  23         window
  24 }
  25
  26 #-----------------------------------------------------------------------
  27 # snit::boolean
  28
  29 snit::type ::snit::boolean {
  30     #-------------------------------------------------------------------
  31     # Type Methods
  32
  33     typemethod validate {value} {
  34         if {![string is boolean -strict $value]} {
  35             return -code error -errorcode INVALID \
  36    "invalid boolean \"$value\", should be one of: 1, 0, true, false, yes, no, on, off"
  37
  38         }
  39
  40         return $value
  41     }
  42
  43     #-------------------------------------------------------------------
  44     # Constructor
  45
  46     # None needed; no options
  47
  48     #-------------------------------------------------------------------
  49     # Public Methods
  50
  51     method validate {value} {
  52         $type validate $value
  53     }
  54 }
  55
  56 #-----------------------------------------------------------------------
  57 # snit::double
  58
  59 snit::type ::snit::double {
  60     #-------------------------------------------------------------------
  61     # Options
  62
  63     # -min value
  64     #
  65     # Minimum value
  66
  67     option -min -default "" -readonly 1
  68
  69     # -max value
  70     #
  71     # Maximum value
  72
  73     option -max -default "" -readonly 1
  74
  75     #-------------------------------------------------------------------
  76     # Type Methods
  77
  78     typemethod validate {value} {
  79         if {![string is double -strict $value]} {
  80             return -code error -errorcode INVALID \
  81                 "invalid value \"$value\", expected double"
  82         }
  83
  84         return $value
  85     }
  86
  87     #-------------------------------------------------------------------
  88     # Constructor
  89
  90     constructor {args} {
  91         # FIRST, get the options
  92         $self configurelist $args
  93
  94         if {"" != $options(-min) &&
  95             ![string is double -strict $options(-min)]} {
  96             return -code error \
  97                 "invalid -min: \"$options(-min)\""
  98         }
  99
 100         if {"" != $options(-max) &&
 101             ![string is double -strict $options(-max)]} {
 102             return -code error \
 103                 "invalid -max: \"$options(-max)\""
 104         }
 105
 106         if {"" != $options(-min) &&
 107             "" != $options(-max) &&
 108             $options(-max) < $options(-min)} {
 109             return -code error "-max < -min"
 110         }
 111     }
 112
 113     #-------------------------------------------------------------------
 114     # Public Methods
 115
 116     # Fixed method for the snit::double type.
 117     # WHD, 6/7/2010.
 118     method validate {value} {
 119         $type validate $value
 120
 121         if {("" != $options(-min) && $value < $options(-min))       ||
 122             ("" != $options(-max) && $value > $options(-max))} {
 123
 124             set msg "invalid value \"$value\", expected double"
 125
 126             if {"" != $options(-min) && "" != $options(-max)} {
 127                 append msg " in range $options(-min), $options(-max)"
 128             } elseif {"" != $options(-min)} {
 129                 append msg " no less than $options(-min)"
 130             } elseif {"" != $options(-max)} {
 131                 append msg " no greater than $options(-max)"
 132             }
 133
 134             return -code error -errorcode INVALID $msg
 135         }
 136
 137         return $value
 138     }
 139 }
 140
 141 #-----------------------------------------------------------------------
 142 # snit::enum
 143
 144 snit::type ::snit::enum {
 145     #-------------------------------------------------------------------
 146     # Options
 147
 148     # -values list
 149     #
 150     # Valid values for this type
 151
 152     option -values -default {} -readonly 1
 153
 154     #-------------------------------------------------------------------
 155     # Type Methods
 156
 157     typemethod validate {value} {
 158         # No -values specified; it's always valid
 159         return $value
 160     }
 161
 162     #-------------------------------------------------------------------
 163     # Constructor
 164
 165     constructor {args} {
 166         $self configurelist $args
 167
 168         if {[llength $options(-values)] == 0} {
 169             return -code error \
 170                 "invalid -values: \"\""
 171         }
 172     }
 173
 174     #-------------------------------------------------------------------
 175     # Public Methods
 176
 177     method validate {value} {
 178         if {[lsearch -exact $options(-values) $value] == -1} {
 179             return -code error -errorcode INVALID \
 180     "invalid value \"$value\", should be one of: [join $options(-values) {, }]"
 181         }
 182
 183         return $value
 184     }
 185 }
 186
 187 #-----------------------------------------------------------------------
 188 # snit::fpixels
 189
 190 snit::type ::snit::fpixels {
 191     #-------------------------------------------------------------------
 192     # Options
 193
 194     # -min value
 195     #
 196     # Minimum value
 197
 198     option -min -default "" -readonly 1
 199
 200     # -max value
 201     #
 202     # Maximum value
 203
 204     option -max -default "" -readonly 1
 205
 206     #-------------------------------------------------------------------
 207     # Instance variables
 208
 209     variable min ""  ;# -min, no suffix
 210     variable max ""  ;# -max, no suffix
 211
 212     #-------------------------------------------------------------------
 213     # Type Methods
 214
 215     typemethod validate {value} {
 216         if {[catch {winfo fpixels . $value} dummy]} {
 217             return -code error -errorcode INVALID \
 218                 "invalid value \"$value\", expected fpixels"
 219         }
 220
 221         return $value
 222     }
 223
 224     #-------------------------------------------------------------------
 225     # Constructor
 226
 227     constructor {args} {
 228         # FIRST, get the options
 229         $self configurelist $args
 230
 231         if {"" != $options(-min) &&
 232             [catch {winfo fpixels . $options(-min)} min]} {
 233             return -code error \
 234                 "invalid -min: \"$options(-min)\""
 235         }
 236
 237         if {"" != $options(-max) &&
 238             [catch {winfo fpixels . $options(-max)} max]} {
 239             return -code error \
 240                 "invalid -max: \"$options(-max)\""
 241         }
 242
 243         if {"" != $min &&
 244             "" != $max &&
 245             $max < $min} {
 246             return -code error "-max < -min"
 247         }
 248     }
 249
 250     #-------------------------------------------------------------------
 251     # Public Methods
 252
 253     method validate {value} {
 254         $type validate $value
 255
 256         set val [winfo fpixels . $value]
 257
 258         if {("" != $min && $val < $min) ||
 259             ("" != $max && $val > $max)} {
 260
 261             set msg "invalid value \"$value\", expected fpixels"
 262
 263             if {"" != $min && "" != $max} {
 264                 append msg " in range $options(-min), $options(-max)"
 265             } elseif {"" != $min} {
 266                 append msg " no less than $options(-min)"
 267             }
 268
 269             return -code error -errorcode INVALID $msg
 270         }
 271
 272         return $value
 273     }
 274 }
 275
 276 #-----------------------------------------------------------------------
 277 # snit::integer
 278
 279 snit::type ::snit::integer {
 280     #-------------------------------------------------------------------
 281     # Options
 282
 283     # -min value
 284     #
 285     # Minimum value
 286
 287     option -min -default "" -readonly 1
 288
 289     # -max value
 290     #
 291     # Maximum value
 292
 293     option -max -default "" -readonly 1
 294
 295     #-------------------------------------------------------------------
 296     # Type Methods
 297
 298     typemethod validate {value} {
 299         if {![string is integer -strict $value]} {
 300             return -code error -errorcode INVALID \
 301                 "invalid value \"$value\", expected integer"
 302         }
 303
 304         return $value
 305     }
 306
 307     #-------------------------------------------------------------------
 308     # Constructor
 309
 310     constructor {args} {
 311         # FIRST, get the options
 312         $self configurelist $args
 313
 314         if {"" != $options(-min) &&
 315             ![string is integer -strict $options(-min)]} {
 316             return -code error \
 317                 "invalid -min: \"$options(-min)\""
 318         }
 319
 320         if {"" != $options(-max) &&
 321             ![string is integer -strict $options(-max)]} {
 322             return -code error \
 323                 "invalid -max: \"$options(-max)\""
 324         }
 325
 326         if {"" != $options(-min) &&
 327             "" != $options(-max) &&
 328             $options(-max) < $options(-min)} {
 329             return -code error "-max < -min"
 330         }
 331     }
 332
 333     #-------------------------------------------------------------------
 334     # Public Methods
 335
 336     method validate {value} {
 337         $type validate $value
 338
 339         if {("" != $options(-min) && $value < $options(-min))       ||
 340             ("" != $options(-max) && $value > $options(-max))} {
 341
 342             set msg "invalid value \"$value\", expected integer"
 343
 344             if {"" != $options(-min) && "" != $options(-max)} {
 345                 append msg " in range $options(-min), $options(-max)"
 346             } elseif {"" != $options(-min)} {
 347                 append msg " no less than $options(-min)"
 348             }
 349
 350             return -code error -errorcode INVALID $msg
 351         }
 352
 353         return $value
 354     }
 355 }
 356
 357 #-----------------------------------------------------------------------
 358 # snit::list
 359
 360 snit::type ::snit::listtype {
 361     #-------------------------------------------------------------------
 362     # Options
 363
 364     # -type type
 365     #
 366     # Specifies a value type
 367
 368     option -type -readonly 1
 369
 370     # -minlen len
 371     #
 372     # Minimum list length
 373
 374     option -minlen -readonly 1 -default 0
 375
 376     # -maxlen len
 377     #
 378     # Maximum list length
 379
 380     option -maxlen -readonly 1
 381
 382     #-------------------------------------------------------------------
 383     # Type Methods
 384
 385     typemethod validate {value} {
 386         if {[catch {llength $value} result]} {
 387             return -code error -errorcode INVALID \
 388                 "invalid value \"$value\", expected list"
 389         }
 390
 391         return $value
 392     }
 393
 394     #-------------------------------------------------------------------
 395     # Constructor
 396
 397     constructor {args} {
 398         # FIRST, get the options
 399         $self configurelist $args
 400
 401         if {"" != $options(-minlen) &&
 402             (![string is integer -strict $options(-minlen)] ||
 403              $options(-minlen) < 0)} {
 404             return -code error \
 405                 "invalid -minlen: \"$options(-minlen)\""
 406         }
 407
 408         if {"" == $options(-minlen)} {
 409             set options(-minlen) 0
 410         }
 411
 412         if {"" != $options(-maxlen) &&
 413             ![string is integer -strict $options(-maxlen)]} {
 414             return -code error \
 415                 "invalid -maxlen: \"$options(-maxlen)\""
 416         }
 417
 418         if {"" != $options(-maxlen) &&
 419             $options(-maxlen) < $options(-minlen)} {
 420             return -code error "-maxlen < -minlen"
 421         }
 422     }
 423
 424
 425     #-------------------------------------------------------------------
 426     # Methods
 427
 428     method validate {value} {
 429         $type validate $value
 430
 431         set len [llength $value]
 432
 433         if {$len < $options(-minlen)} {
 434             return -code error -errorcode INVALID \
 435               "value has too few elements; at least $options(-minlen) expected"
 436         } elseif {"" != $options(-maxlen)} {
 437             if {$len > $options(-maxlen)} {
 438                 return -code error -errorcode INVALID \
 439          "value has too many elements; no more than $options(-maxlen) expected"
 440             }
 441         }
 442
 443         # NEXT, check each value
 444         if {"" != $options(-type)} {
 445             foreach item $value {
 446                 set cmd $options(-type)
 447                 lappend cmd validate $item
 448                 uplevel \#0 $cmd
 449             }
 450         }
 451
 452         return $value
 453     }
 454 }
 455
 456 #-----------------------------------------------------------------------
 457 # snit::pixels
 458
 459 snit::type ::snit::pixels {
 460     #-------------------------------------------------------------------
 461     # Options
 462
 463     # -min value
 464     #
 465     # Minimum value
 466
 467     option -min -default "" -readonly 1
 468
 469     # -max value
 470     #
 471     # Maximum value
 472
 473     option -max -default "" -readonly 1
 474
 475     #-------------------------------------------------------------------
 476     # Instance variables
 477
 478     variable min ""  ;# -min, no suffix
 479     variable max ""  ;# -max, no suffix
 480
 481     #-------------------------------------------------------------------
 482     # Type Methods
 483
 484     typemethod validate {value} {
 485         if {[catch {winfo pixels . $value} dummy]} {
 486             return -code error -errorcode INVALID \
 487                 "invalid value \"$value\", expected pixels"
 488         }
 489
 490         return $value
 491     }
 492
 493     #-------------------------------------------------------------------
 494     # Constructor
 495
 496     constructor {args} {
 497         # FIRST, get the options
 498         $self configurelist $args
 499
 500         if {"" != $options(-min) &&
 501             [catch {winfo pixels . $options(-min)} min]} {
 502             return -code error \
 503                 "invalid -min: \"$options(-min)\""
 504         }
 505
 506         if {"" != $options(-max) &&
 507             [catch {winfo pixels . $options(-max)} max]} {
 508             return -code error \
 509                 "invalid -max: \"$options(-max)\""
 510         }
 511
 512         if {"" != $min &&
 513             "" != $max &&
 514             $max < $min} {
 515             return -code error "-max < -min"
 516         }
 517     }
 518
 519     #-------------------------------------------------------------------
 520     # Public Methods
 521
 522     method validate {value} {
 523         $type validate $value
 524
 525         set val [winfo pixels . $value]
 526
 527         if {("" != $min && $val < $min) ||
 528             ("" != $max && $val > $max)} {
 529
 530             set msg "invalid value \"$value\", expected pixels"
 531
 532             if {"" != $min && "" != $max} {
 533                 append msg " in range $options(-min), $options(-max)"
 534             } elseif {"" != $min} {
 535                 append msg " no less than $options(-min)"
 536             }
 537
 538             return -code error -errorcode INVALID $msg
 539         }
 540
 541         return $value
 542     }
 543 }
 544
 545 #-----------------------------------------------------------------------
 546 # snit::stringtype
 547
 548 snit::type ::snit::stringtype {
 549     #-------------------------------------------------------------------
 550     # Options
 551
 552     # -minlen len
 553     #
 554     # Minimum list length
 555
 556     option -minlen -readonly 1 -default 0
 557
 558     # -maxlen len
 559     #
 560     # Maximum list length
 561
 562     option -maxlen -readonly 1
 563
 564     # -nocase 0|1
 565     #
 566     # globs and regexps are case-insensitive if -nocase 1.
 567
 568     option -nocase -readonly 1 -default 0
 569
 570     # -glob pattern
 571     #
 572     # Glob-match pattern, or ""
 573
 574     option -glob -readonly 1
 575
 576     # -regexp regexp
 577     #
 578     # Regular expression to match
 579
 580     option -regexp -readonly 1
 581
 582     #-------------------------------------------------------------------
 583     # Type Methods
 584
 585     typemethod validate {value} {
 586         # By default, any string (hence, any Tcl value) is valid.
 587         return $value
 588     }
 589
 590     #-------------------------------------------------------------------
 591     # Constructor
 592
 593     constructor {args} {
 594         # FIRST, get the options
 595         $self configurelist $args
 596
 597         # NEXT, validate -minlen and -maxlen
 598         if {"" != $options(-minlen) &&
 599             (![string is integer -strict $options(-minlen)] ||
 600              $options(-minlen) < 0)} {
 601             return -code error \
 602                 "invalid -minlen: \"$options(-minlen)\""
 603         }
 604
 605         if {"" == $options(-minlen)} {
 606             set options(-minlen) 0
 607         }
 608
 609         if {"" != $options(-maxlen) &&
 610             ![string is integer -strict $options(-maxlen)]} {
 611             return -code error \
 612                 "invalid -maxlen: \"$options(-maxlen)\""
 613         }
 614
 615         if {"" != $options(-maxlen) &&
 616             $options(-maxlen) < $options(-minlen)} {
 617             return -code error "-maxlen < -minlen"
 618         }
 619
 620         # NEXT, validate -nocase
 621         if {[catch {snit::boolean validate $options(-nocase)} result]} {
 622             return -code error "invalid -nocase: $result"
 623         }
 624
 625         # Validate the glob
 626         if {"" != $options(-glob) &&
 627             [catch {string match $options(-glob) ""} dummy]} {
 628             return -code error \
 629                 "invalid -glob: \"$options(-glob)\""
 630         }
 631
 632         # Validate the regexp
 633         if {"" != $options(-regexp) &&
 634             [catch {regexp $options(-regexp) ""} dummy]} {
 635             return -code error \
 636                 "invalid -regexp: \"$options(-regexp)\""
 637         }
 638     }
 639
 640
 641     #-------------------------------------------------------------------
 642     # Methods
 643
 644     method validate {value} {
 645         # Usually we'd call [$type validate $value] here, but
 646         # as it's a no-op, don't bother.
 647
 648         # FIRST, validate the length.
 649         set len [string length $value]
 650
 651         if {$len < $options(-minlen)} {
 652             return -code error -errorcode INVALID \
 653               "too short: at least $options(-minlen) characters expected"
 654         } elseif {"" != $options(-maxlen)} {
 655             if {$len > $options(-maxlen)} {
 656                 return -code error -errorcode INVALID \
 657          "too long: no more than $options(-maxlen) characters expected"
 658             }
 659         }
 660
 661         # NEXT, check the glob match, with or without case.
 662         if {"" != $options(-glob)} {
 663             if {$options(-nocase)} {
 664                 set result [string match -nocase $options(-glob) $value]
 665             } else {
 666                 set result [string match $options(-glob) $value]
 667             }
 668
 669             if {!$result} {
 670                 return -code error -errorcode INVALID \
 671                     "invalid value \"$value\""
 672             }
 673         }
 674
 675         # NEXT, check regexp match with or without case
 676         if {"" != $options(-regexp)} {
 677             if {$options(-nocase)} {
 678                 set result [regexp -nocase -- $options(-regexp) $value]
 679             } else {
 680                 set result [regexp -- $options(-regexp) $value]
 681             }
 682
 683             if {!$result} {
 684                 return -code error -errorcode INVALID \
 685                     "invalid value \"$value\""
 686             }
 687         }
 688
 689         return $value
 690     }
 691 }
 692
 693 #-----------------------------------------------------------------------
 694 # snit::window
 695
 696 snit::type ::snit::window {
 697     #-------------------------------------------------------------------
 698     # Type Methods
 699
 700     typemethod validate {value} {
 701         if {![winfo exists $value]} {
 702             return -code error -errorcode INVALID \
 703                 "invalid value \"$value\", value is not a window"
 704         }
 705
 706         return $value
 707     }
 708
 709     #-------------------------------------------------------------------
 710     # Constructor
 711
 712     # None needed; no options
 713
 714     #-------------------------------------------------------------------
 715     # Public Methods
 716
 717     method validate {value} {
 718         $type validate $value
 719     }
 720 }