File Coverage

blib/lib/MarpaX/ESLIF/URI/mailto.pm
Criterion Covered Total %
statement 46 46 100.0
branch n/a
condition 2 4 50.0
subroutine 12 12 100.0
pod 4 4 100.0
total 64 66 96.9


line stmt bran cond sub pod time code
1 2     2   1127 use strict;
  2         4  
  2         58  
2 2     2   8 use warnings FATAL => 'all';
  2         4  
  2         116  
3              
4             package MarpaX::ESLIF::URI::mailto;
5              
6             # ABSTRACT: URI::mailto syntax as per RFC6068
7              
8             our $AUTHORITY = 'cpan:JDDPAUSE'; # AUTHORITY
9              
10             our $VERSION = '0.006'; # VERSION
11              
12 2     2   11 use Class::Tiny::Antlers;
  2         4  
  2         15  
13 2     2   260 use MarpaX::ESLIF;
  2         4  
  2         1045  
14              
15             extends 'MarpaX::ESLIF::URI::_generic';
16              
17             has '_to' => (is => 'rwp', default => sub { { origin => [], decoded => [], normalized => [] } });
18             has '_headers' => (is => 'rwp', default => sub { { origin => [], decoded => [], normalized => [] } });
19              
20             #
21             # All attributes starting with an underscore are the result of parsing
22             #
23             __PACKAGE__->_generate_actions(qw/_to _headers/);
24              
25             #
26             # Constants
27             #
28             my $BNF = do { local $/; <DATA> };
29             my $GRAMMAR = MarpaX::ESLIF::Grammar->new(__PACKAGE__->eslif, __PACKAGE__->bnf);
30              
31              
32             sub bnf {
33 3     3 1 8 my ($class) = @_;
34              
35 3         11 join("\n", $BNF, MarpaX::ESLIF::URI::_generic->bnf)
36             };
37              
38              
39             sub grammar {
40 3     3 1 6 my ($class) = @_;
41              
42 3         193 return $GRAMMAR;
43             }
44              
45              
46             sub to {
47 9     9 1 6537 my ($self, $type) = @_;
48              
49 9         32 return $self->_generic_getter('_to', $type)
50             }
51              
52              
53             sub headers {
54 6     6 1 6029 my ($self, $type) = @_;
55              
56 6         24 return $self->_generic_getter('_headers', $type)
57             }
58              
59             # ------------------------
60             # Specific grammar actions
61             # ------------------------
62             sub __to {
63 3     3   12 my ($self, @args) = @_;
64              
65             #
66             # <to> is also the <path> from generic URI point of view
67             #
68 3         65 $self->_action_path(@args);
69              
70 3         22 my $concat = $self->__concat(@args);
71              
72 3         12 while (@args) {
73 6         25 my $addr = shift @args;
74 6         11 my $comma = shift @args;
75 6         10 foreach my $type (qw/origin decoded normalized/) {
76 18   50     303 $self->_to->{$type} //= [];
77 18         91 push(@{$self->_to->{$type}}, $addr->{$type})
  18         240  
78             }
79             }
80              
81 3         46 return $concat
82             }
83              
84             sub __hfield {
85 3     3   9 my ($self, $hfname, $equal, $hfvalue) = @_;
86              
87 3         11 my $concat = $self->__concat($hfname, $equal, $hfvalue);
88              
89 3         8 foreach my $type (qw/origin decoded normalized/) {
90 9   50     178 $self->_headers->{$type} //= [];
91 9         50 push(@{$self->_headers->{$type}}, { $hfname->{$type} => $hfvalue->{$type} })
  9         124  
92             }
93              
94 3         44 return $concat
95             }
96              
97             sub __hfname {
98 3     3   9 my ($self, @args) = @_;
99              
100             #
101             # <hfname> is case-insensitive. Since it may contain percent encoded characters that
102             # are normalized to uppercase, we have to apply uppercase in normalization.
103             #
104 3         10 my $rc = $self->__concat(@args);
105 3         11 $rc->{normalized} = uc($rc->{normalized});
106 3         26 $rc
107             }
108              
109             sub __domain {
110 8     8   23 my ($self, @args) = @_;
111              
112             #
113             # <domain> is case-insensitive.
114             #
115 8         26 my $rc = $self->__concat(@args);
116 8         29 $rc->{normalized} = lc($rc->{normalized});
117 8         72 $rc
118             }
119              
120             # -------------
121             # Normalization
122             # -------------
123              
124              
125             1;
126              
127             =pod
128              
129             =encoding UTF-8
130              
131             =head1 NAME
132              
133             MarpaX::ESLIF::URI::mailto - URI::mailto syntax as per RFC6068
134              
135             =head1 VERSION
136              
137             version 0.006
138              
139             =head1 SUBROUTINES/METHODS
140              
141             MarpaX::ESLIF::URI::mailto inherits, and eventually overwrites some, methods of MarpaX::ESLIF::URI::_generic.
142              
143             =head2 $class->bnf
144              
145             Overwrites parent's bnf implementation. Returns the BNF used to parse the input.
146              
147             =head2 $class->grammar
148              
149             Overwrite parent's grammar implementation. Returns the compiled BNF used to parse the input as MarpaX::ESLIF::Grammar singleton.
150              
151             =head2 $self->to($type)
152              
153             Returns the addresses as an array reference, that can be empty. C<$type> is either 'decoded' (default value), 'origin' or 'normalized'.
154              
155             =head2 $self->headers($type)
156              
157             Returns the headers as an array reference of single hashes, that can be empty. C<$type> is either 'decoded' (default value), 'origin' or 'normalized'.
158              
159             There is no check of eventual duplicates, and it is reason why at every array indice, there is a hash reference where the key is a mailto header field, and the value is a mailto header value.
160              
161             =head1 NOTES
162              
163             The characters C</> and C<?> has been added to mailto syntax
164              
165             =head1 SEE ALSO
166              
167             L<RFC6068|https://tools.ietf.org/html/rfc6068>, L<MarpaX::ESLIF::URI::_generic>
168              
169             =head1 AUTHOR
170              
171             Jean-Damien Durand <jeandamiendurand@free.fr>
172              
173             =head1 COPYRIGHT AND LICENSE
174              
175             This software is copyright (c) 2017 by Jean-Damien Durand.
176              
177             This is free software; you can redistribute it and/or modify it under
178             the same terms as the Perl 5 programming language system itself.
179              
180             =cut
181              
182             __DATA__
183             #
184             # Reference: https://tools.ietf.org/html/rfc6068#section-2
185             #
186             # Note that <URI fragment> should not be used, still it is allowed
187             #
188             <mailto URI> ::= <mailto scheme> ":" <mailto hier part> <URI fragment> action => _action_string
189              
190             <mailto scheme> ::= "mailto":i action => _action_scheme
191              
192             <mailto hier part> ::=
193             <mailto hier part> ::= <hfields>
194             | <to>
195             | <to> <hfields>
196              
197             <to> ::= <addr spec>+ separator => ',' action => __to
198              
199             <mailto query> ::= <hfield>+ separator => '&' action => _action_query
200             <hfields> ::= "?" <mailto query>
201              
202             <hfield> ::= <hfname> "=" <hfvalue> action => __hfield
203             <hfname> ::= <hfname char>* action => __hfname
204             <hfvalue> ::= <hfvalue char>*
205              
206             <addr spec> ::= <local part> "@" <domain>
207             <local part> ::= <dot atom text>
208             | <quoted string>
209              
210             <dtext no obs any> ::= <dtext no obs>*
211             <domain> ::= <dot atom text> action => __domain
212             | "[" <dtext no obs any> "]" action => __domain
213             <dtext no obs> ::= [\x{21}-\x{5A}\x{5E}-\x{7E}] # Printable US-ASCII or characters not including "[", "]", or "\"
214             <hfname char> ::= <unreserved>
215             | <hfname some delims>
216             | <hfname pct encoded>
217             <hfvalue char> ::= <unreserved>
218             | <hfvalue some delims>
219             | <hfvalue pct encoded>
220             <hfname some delims> ::= [!$'()*+,@/?]
221             <hfvalue some delims> ::= [!$'()*+,:@/?] # hfname + ":"
222              
223             #
224             # From https://tools.ietf.org/html/rfc5322#section-3.2.3
225             #
226             <dot atom text unit> ::= <atext>+
227             <dot atom text> ::= <dot atom text unit>+ separator => "."
228             <atext> ::= <ALPHA>
229             | <DIGIT>
230             | [!$'*+\-^_`{|}~]
231             | <atext pct encoded>
232             #
233             # A number of characters that can appear in <addr-spec> MUST be
234             # percent-encoded. These are the characters that cannot appear in
235             # a URI according to [STD66] as well as "%" (because it is used for
236             # percent-encoding) and all the characters in gen-delims except "@"
237             # and ":" (i.e., "/", "?", "#", "[", and "]"). Of the characters
238             # in sub-delims, at least the following also have to be percent-
239             # encoded: "&", ";", and "=". Care has to be taken both when
240             # encoding as well as when decoding to make sure these operations
241             # are applied only once.
242             #
243             <atext pct encoded> ::= "%" '2' '5' action => __pct_encoded # %
244             | "%" '2' 'F':i action => __pct_encoded # /
245             | "%" '3' 'F':i action => __pct_encoded # ?
246             | "%" '2' '3' action => __pct_encoded # #
247             | "%" '5' 'B':i action => __pct_encoded # [
248             | "%" '5' 'D':i action => __pct_encoded # ]
249             | "%" '2' '6' action => __pct_encoded # &
250             | "%" '3' 'B':i action => __pct_encoded # ;
251             | "%" '3' 'D':i action => __pct_encoded # =
252             # %23, %25, %26, %2F are forced to be encoded
253             | "%" '2' [0-247-9A-Ea-e] action => __pct_encoded
254             # %3B, %3D, %3F are forced to be encoded
255             | "%" '3' [0-9ACEace] action => __pct_encoded
256             # %5B, %5D are forced to be encoded
257             | "%" '5' [0-9ACE-Face-f] action => __pct_encoded
258             # All the rest
259             | "%" [0-146-9A-Fa-f] [0-9A-Fa-f] action => __pct_encoded
260             #
261             # <hfname> and <hfvalue> are encodings of an [RFC5322] header field
262             # name and value, respectively. Percent-encoding is needed for the
263             # same characters as listed above for <addr-spec>.
264             #
265             # Note that [RFC5322] allows all US-ASCII printable characters except ":" in
266             # optional header field names (Section 3.6.8). Its % encoded form is "%" "3" "A":i
267             #
268             <hfname pct encoded> ::= "%" '2' '5' action => __pct_encoded # %
269             | "%" '2' 'F':i action => __pct_encoded # /
270             | "%" '3' 'F':i action => __pct_encoded # ?
271             | "%" '2' '3' action => __pct_encoded # #
272             | "%" '5' 'B':i action => __pct_encoded # [
273             | "%" '5' 'D':i action => __pct_encoded # ]
274             | "%" '2' '6' action => __pct_encoded # &
275             | "%" '3' 'B':i action => __pct_encoded # ;
276             | "%" '3' 'D':i action => __pct_encoded # =
277             # %23, %25, %26, %2F are forced to be encoded
278             | "%" '2' [0-247-9A-Ea-e] action => __pct_encoded
279             # %3B, %3D, %3F are forced to be encoded, %3A or %3a are excluded (character ":")
280             | "%" '3' [0-9CEce] action => __pct_encoded
281             # %5B, %5D are forced to be encoded
282             | "%" '5' [0-9ACE-Face-f] action => __pct_encoded
283             # All the rest
284             | "%" [0-146-9A-Fa-f] [0-9A-Fa-f] action => __pct_encoded
285              
286             <hfvalue pct encoded> ::= "%" '2' '5' action => __pct_encoded # %
287             | "%" '2' 'F':i action => __pct_encoded # /
288             | "%" '3' 'F':i action => __pct_encoded # ?
289             | "%" '2' '3' action => __pct_encoded # #
290             | "%" '5' 'B':i action => __pct_encoded # [
291             | "%" '5' 'D':i action => __pct_encoded # ]
292             | "%" '2' '6' action => __pct_encoded # &
293             | "%" '3' 'B':i action => __pct_encoded # ;
294             | "%" '3' 'D':i action => __pct_encoded # =
295             # %23, %25, %26, %2F are forced to be encoded
296             | "%" '2' [0-247-9A-Ea-e] action => __pct_encoded
297             # %3B, %3D, %3F are forced to be encoded
298             | "%" '3' [0-9ACEace] action => __pct_encoded
299             # %5B, %5D are forced to be encoded
300             | "%" '5' [0-9ACE-Face-f] action => __pct_encoded
301             # All the rest
302             | "%" [0-146-9A-Fa-f] [0-9A-Fa-f] action => __pct_encoded
303              
304             <quoted string char> ::= <qcontent>
305             | <FWS> <qcontent>
306             <quoted string interior> ::= <quoted string char>*
307             <quoted string> ::= <DQUOTE> <quoted string interior> <DQUOTE>
308             | <DQUOTE> <quoted string interior> <DQUOTE> <CFWS>
309             | <DQUOTE> <quoted string interior> <FWS> <DQUOTE>
310             | <DQUOTE> <quoted string interior> <FWS> <DQUOTE> <CFWS>
311             | <CFWS> <DQUOTE> <quoted string interior> <DQUOTE>
312             | <CFWS> <DQUOTE> <quoted string interior> <DQUOTE> <CFWS>
313             | <CFWS> <DQUOTE> <quoted string interior> <FWS> <DQUOTE>
314             | <CFWS> <DQUOTE> <quoted string interior> <FWS> <DQUOTE> <CFWS>
315             <qcontent> ::= <qtext>
316             | <quoted pair>
317             <qtext> ::= [\x{21}\x{23}-\x{5B}\x{5D}-\x{7E}] # Characters not including "\" or the quote character
318              
319             #
320             # From https://tools.ietf.org/html/rfc5322#section-3.2.2
321             #
322             <WSP many> ::= <WSP>+
323             <WSP any> ::= <WSP>*
324             <FWS> ::= <WSP many>
325             | <WSP any> <CRLF> <WSP many>
326             | <obs FWS>
327             <CFWS comment> ::= <comment>
328             | <FWS> <comment>
329             <CFWS comment many> ::= <CFWS comment>+
330             <CFWS> ::= <CFWS comment many>
331             | <CFWS comment many> <FWS>
332             | <FWS>
333             <comment interior unit> ::= <ccontent>
334             | <FWS> <ccontent>
335             <comment interior units> ::= <comment interior unit>*
336             <comment interior> ::= <comment interior units>
337             | <comment interior units> <FWS>
338             <comment> ::= "(" <comment interior> ")"
339             <ccontent> ::= <ctext>
340             | <quoted pair>
341             # <addr-spec> is a mail address as specified in [RFC5322], but excluding <comment> from [RFC5322]
342             # | <comment>
343             <ctext> ::= [\x{21}-\x{27}\x{2A}-\x{5B}\x{5D}-\x{7E}]
344             | <obs ctext>
345             <obs ctext> ::= <obs NO WS CTL>
346             <obs NO WS CTL> ::= [\x{01}-\x{08}\x{0B}\x{0C}\x{0E}-\x{1F}\x{7F}]
347             <obs qp> ::= "\\" [\x{00}]
348             | "\\" <obs NO WS CTL>
349             | "\\" <LF>
350             | "\\" <CR>
351             #
352             # From https://tools.ietf.org/html/rfc5322#section-3.2.1
353             #
354             <quoted pair> ::= "\\" <VCHAR>
355             | "\\" <WSP>
356             | <obs qp>
357             #
358             # From https://tools.ietf.org/html/rfc5234#appendix-B.1
359             #
360             <CR> ::= [\x{0D}]
361             <LF> ::= [\x{0A}]
362             <CRLF> ::= <CR> <LF>
363             <DQUOTE> ::= [\x{22}]
364             <VCHAR> ::= [\x{21}-\x{7E}]
365             <WSP> ::= <SP>
366             | <HTAB>
367             <SP> ::= [\x{20}]
368             <HTAB> ::= [\x{09}]
369              
370             #
371             # From https://tools.ietf.org/html/rfc5322#section-4.2
372             #
373             <obs FWS trailer unit> ::= <CRLF> <WSP many>
374             <obs FWS trailer> ::= <obs FWS trailer unit>*
375             <obs FWS> ::= <WSP many> <obs FWS trailer>
376             #
377             # Generic syntax will be appended here
378             #