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