blob: e9c140a149bc5aa4bebe2e9a2804ca49fd32b181 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
#!/bin/env perl6
# scheme:[//[userinfo@]host[:port]]path[?query][#fragment]
grammar URL {
token TOP { ^
<scheme> ':'
[ '//'
[ <userinfo> '@' ]?
<host>
[ ':' <port> ]?
]?
<path>
[ '?' <queries> ]?
[ '#' <fragment> ]?
$ }
token scheme { <id> }
token userinfo { <user> [ ':' <password> ]? }
token user { <id> }
token password { \w+ }
token host { [ <IPv4-address> | <domain-name> ] }
token IPv4-address { [\d ** 1..3] ** 4 % '.' }
token dname { <[a..zA..Z]> <[-a..zA..Z0..9]>* }
token domain-name { <dname>+ % '.' }
token port { \d+ }
token path { '/' [<[a..zA..Z0..9]>+] *%% '/' }
token key { <id> }
token value { \w+ }
token query { <key> '=' <value> }
token queries { <query> +% '&' }
token fragment { <id> }
token id { <[a..zA..Z]> <[-+.a..zA..Z0..9]>* }
}
sub MAIN(Str $url = 'jdbc://user:password@localhost:3306/pwc?profile=true#h1') {
my $m = URL.parse($url);
if $m {
say 'scheme: ', ~$m<scheme>;
say 'userinfo: ', ~$m<userinfo> if $m<userinfo>;
say 'host: ', ~$m<host> if $m<host>;
say 'port: ', ~$m<port> if $m<port>;
say 'path: ', ~$m<path>;
say 'query: ', ~$m<queries> if $m<queries>;
say 'fragment: ', ~$m<fragment> if $m<fragment>;
}
}
|