1 ! Copyright (C) 2006, 2008 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel continuations sequences math namespaces make sets
4 math.parser math.ranges assocs regexp unicode.categories arrays
5 hashtables words classes quotations xmode.catalog ;
8 : v-default ( str def -- str )
11 : v-required ( str -- str )
12 dup empty? [ "required" throw ] when ;
14 : v-optional ( str quot -- str )
15 over empty? [ 2drop f ] [ call ] if ; inline
17 : v-min-length ( str n -- str )
19 [ "must be at least " % # " characters" % ] "" make
25 : v-max-length ( str n -- str )
27 [ "must be no more than " % # " characters" % ] "" make
33 : v-number ( str -- n )
34 dup string>number [ ] [ "must be a number" throw ] ?if ;
36 : v-integer ( str -- n )
37 v-number dup integer? [ "must be an integer" throw ] unless ;
39 : v-min-value ( x n -- x )
41 [ "must be at least " % # ] "" make throw
46 : v-max-value ( x n -- x )
48 [ "must be no more than " % # ] "" make throw
53 : v-regexp ( str what regexp -- str )
55 [ drop ] [ "invalid " prepend throw ] if ;
57 : v-email ( str -- str )
58 #! From http://www.regular-expressions.info/email.html
61 R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i
64 : v-url ( str -- str )
66 R' (ftp|http|https)://(\w+:?\w*@)?(\S+)(:[0-9]+)?(/|/([\w#!:.?+=&%@!\-/]))?'
69 : v-captcha ( str -- str )
70 dup empty? [ "must remain blank" throw ] unless ;
72 : v-one-line ( str -- str )
74 dup "\r\n" intersect empty?
75 [ "must be a single line" throw ] unless ;
77 : v-one-word ( str -- str )
80 [ "must be a single word" throw ] unless ;
82 : v-username ( str -- str )
83 2 v-min-length 16 v-max-length v-one-word ;
85 : v-password ( str -- str )
86 6 v-min-length 40 v-max-length v-one-line ;
88 : v-mode ( str -- str )
89 dup mode-names member? [
90 "not a valid syntax mode" throw
94 string>digits <reversed>
95 [ odd? [ 2 * 10 /mod + ] when ] map-index
98 : v-credit-card ( str -- n )
100 dup CHAR: 0 CHAR: 9 [a,b] diff empty? [
103 dup luhn? [ string>number ] [
104 "card number check failed" throw
107 "invalid credit card number format" throw