|
4223
|
1 #!../ploki
|
|
|
2 REM adaption of Jeffrey Friedl's RFC 822 email regex
|
|
|
3 REM (taken from _Mastering Regular Expressions_)
|
|
|
4
|
|
|
5 GOTO 1000
|
|
|
6
|
|
|
7 FOR esc KTHX "\\"
|
|
|
8 FOR Period KTHX ".!"
|
|
|
9 FOR OpenBr KTHX "[!"
|
|
|
10 FOR CloseBr KTHX "]!"
|
|
|
11 FOR OpenParen KTHX "(!"
|
|
|
12 FOR CloseParen KTHX ")!"
|
|
|
13 FOR NonASCII KTHX "\x80-\xff"
|
|
|
14 FOR ctl KTHX "\000-\037"
|
|
|
15 FOR CRlist KTHX "\n\015"
|
|
|
16
|
|
|
17 FOR qtext KTHX "'^\V@esc()\V@NonASCII()\V@CRlist()\"'"
|
|
|
18 FOR dtext KTHX "'^\V@esc()\V@NonASCII()\V@CRlist()[]'"
|
|
|
19 FOR quoted$pair KTHX @esc() _ "'^\V@NonASCII()'"
|
|
|
20
|
|
|
21 FOR ctext KTHX "'^\V@esc()\V@NonASCII()\V@CRlist())('"
|
|
|
22
|
|
|
23 FOR Cnested KTHX @OpenParen() _ @ctext() _ "*(\V@quoted$pair()\V@ctext()*)*" _ @CloseParen()
|
|
|
24
|
|
|
25 FOR comment KTHX @OpenParen() _ @ctext() _ "*((\V@quoted$pair()|\V@Cnested())\V@ctext()*)*" _ @CloseParen()
|
|
|
26
|
|
|
27 FOR X KTHX "' \t'*(\V@comment()' \t'*)*"
|
|
|
28
|
|
|
29 FOR atom$char KTHX "'^() <>\\@,;:\".\V@esc()[]\V@ctl()\V@NonASCII()'"
|
|
|
30 FOR atom KTHX "<\V@atom$char()+>"
|
|
|
31
|
|
|
32 FOR quoted$str KTHX "\"\V@qtext()*(\V@quoted$pair()\V@qtext()*)*\""
|
|
|
33
|
|
|
34 FOR word KTHX "(\V@atom()|\V@quoted$str())"
|
|
|
35
|
|
|
36 FOR domain$ref KTHX @atom()
|
|
|
37
|
|
|
38 FOR domain$lit KTHX @OpenBr() _ "(\V@dtext()|\V@quoted$pair())*" _ @CloseBr()
|
|
|
39
|
|
|
40 FOR sub$domain KTHX "(\V@domain$ref()|\V@domain$lit())" _ @X()
|
|
|
41
|
|
|
42 FOR domain KTHX @sub$domain() _ "(\V@Period()\V@X()\V@sub$domain())*"
|
|
|
43
|
|
|
44 FOR route KTHX "@" _ @X() _ @domain() _ "(,\V@X()\V@domain())*:!" _ @X()
|
|
|
45
|
|
|
46 FOR local$part KTHX @word() _ @X() _ "(\V@Period()\V@X()\V@word()\V@X())*"
|
|
|
47
|
|
|
48 FOR addr$spec KTHX @local$part() _ "@" _ @X() _ @domain()
|
|
|
49
|
|
|
50 FOR route$addr KTHX "<!(\V@route())?\V@addr$spec()>!"
|
|
|
51
|
|
|
52 FOR phrase$ctl KTHX "\000-\010\012-\037"
|
|
|
53
|
|
|
54 FOR phrase$char KTHX "'^()<>@,;:\".\V@esc()[]\V@NonASCII()\V@phrase$ctl()'"
|
|
|
55
|
|
|
56 FOR phrase KTHX @word() _ @phrase$char() _ "*((\V@comment()|\V@quoted$str())\V@phrase$char()*)*"
|
|
|
57
|
|
|
58 FOR mailbox KTHX @X() _ "(\V@addr$spec()|\V@phrase()\V@route$addr())"
|
|
|
59
|
|
|
60
|
|
|
61 1000 REM *** main code ***
|
|
|
62
|
|
|
63 REM ******************
|
|
|
64 REM ** test snippet **
|
|
|
65 REM ******************
|
|
|
66
|
|
|
67 LET status 0
|
|
|
68 LET i 1
|
|
|
69 FOR main-loop IF i < \ARG
|
|
|
70 IF \ARG:i ~ ("^" _ @mailbox() _ "$")
|
|
|
71 "`\V\ARG:i' is syntactically valid.
|
|
|
72 ELSE
|
|
|
73 "`\V\ARG:i' is syntactically invalid.
|
|
|
74 LET status @NEG 1
|
|
|
75 FI
|
|
|
76 LET i += 1
|
|
|
77 NEXT main-loop
|
|
|
78 FI
|
|
|
79 END status
|
