1#----------------------------------------------------------------------- 2# TITLE: 3# validate.tcl 4# 5# AUTHOR: 6# Will Duquette 7# 8# DESCRIPTION: 9# Snit validation types. 10# 11#----------------------------------------------------------------------- 12 13namespace 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 29snit::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 59snit::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 144snit::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 190snit::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 279snit::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 360snit::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 459snit::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 548snit::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 696snit::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} 721