1 ! Copyright (C) 2006, 2010 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays assocs classes continuations hashtables kernel
4 make math math.functions math.parser math.ranges namespaces
5 quotations regexp sequences sets unicode.case unicode.categories
9 : v-checkbox ( str -- ? )
12 : v-default ( str def -- str/def )
13 [ drop empty? not ] most ;
15 : v-required ( str -- str )
16 dup empty? [ "required" throw ] when ;
18 : v-optional ( str quot -- result )
19 over empty? [ 2drop f ] [ call ] if ; inline
21 : v-min-length ( str n -- str )
23 [ "must be at least " % # " characters" % ] "" make
29 : v-max-length ( str n -- str )
31 [ "must be no more than " % # " characters" % ] "" make
37 : v-number ( str -- n )
38 dup string>number [ ] [ "must be a number" throw ] ?if ;
40 : v-integer ( str -- n )
41 v-number dup integer? [ "must be an integer" throw ] unless ;
43 : v-min-value ( x n -- x )
45 [ "must be at least " % # ] "" make throw
50 : v-max-value ( x n -- x )
52 [ "must be no more than " % # ] "" make throw
57 : v-regexp ( str what regexp -- str )
59 [ 2drop ] [ drop "invalid " prepend throw ] if ;
61 : v-email ( str -- str )
62 ! From http://www.regular-expressions.info/email.html
65 R/ [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}/i
68 : v-url ( str -- str )
69 "URL" R/ (?:ftp|http|https):\\/\\/\S+/ v-regexp ;
71 : v-captcha ( str -- str )
72 dup empty? [ "must remain blank" throw ] unless ;
74 : v-one-line ( str -- str )
76 dup "\r\n" intersects?
77 [ "must be a single line" throw ] when ;
79 : v-one-word ( str -- str )
82 [ "must be a single word" throw ] unless ;
84 : v-username ( str -- str )
85 2 v-min-length 16 v-max-length v-one-word ;
87 : v-password ( str -- str )
88 6 v-min-length 40 v-max-length v-one-line ;
90 : v-mode ( str -- str )
91 dup mode-names member? [
92 "not a valid syntax mode" throw
96 string>digits <reversed>
97 [ odd? [ 2 * 10 /mod + ] when ] map-index
100 : v-credit-card ( str -- n )
102 dup CHAR: 0 CHAR: 9 [a,b] diff empty? [
105 dup luhn? [ string>number ] [
106 "card number check failed" throw
109 "invalid credit card number format" throw