File Coverage

blib/lib/MarpaX/ESLIF/URI/file.pm
Criterion Covered Total %
statement 21 21 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod 3 3 100.0
total 32 32 100.0


line stmt bran cond sub pod time code
1 1     1   643 use strict;
  1         3  
  1         33  
2 1     1   5 use warnings FATAL => 'all';
  1         1  
  1         70  
3              
4             package MarpaX::ESLIF::URI::file;
5              
6             # ABSTRACT: URI::file syntax as per RFC8089
7              
8             our $AUTHORITY = 'cpan:JDDPAUSE'; # AUTHORITY
9              
10             our $VERSION = '0.006'; # VERSION
11              
12 1     1   6 use Class::Tiny::Antlers;
  1         1  
  1         9  
13 1     1   162 use Class::Method::Modifiers qw/around/;
  1         2  
  1         64  
14 1     1   41 use MarpaX::ESLIF;
  1         3  
  1         271  
15              
16             extends 'MarpaX::ESLIF::URI::_generic';
17              
18             has '_drive' => (is => 'rwp' );
19              
20             #
21             # Inherited method
22             #
23             __PACKAGE__->_generate_actions(qw/_drive/);
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 1     1 1 2 my ($class) = @_;
34              
35 1         4 join("\n", $BNF, MarpaX::ESLIF::URI::_generic->bnf)
36             };
37              
38              
39             sub grammar {
40 9     9 1 26 my ($class) = @_;
41              
42 9         543 return $GRAMMAR;
43             }
44              
45              
46             sub drive {
47 18     18 1 19955 my ($self, $type) = @_;
48              
49 18         62 return $self->_generic_getter('_drive', $type)
50             }
51              
52             # -------------
53             # Normalization
54             # -------------
55             around _set__drive => sub {
56             my ($orig, $self, $value) = @_;
57              
58             #
59             # Normalized drive is case insensitive and should be uppercased
60             #
61             $value->{normalized} = uc($value->{normalized});
62             $self->$orig($value)
63             };
64              
65              
66             1;
67              
68             =pod
69              
70             =encoding UTF-8
71              
72             =head1 NAME
73              
74             MarpaX::ESLIF::URI::file - URI::file syntax as per RFC8089
75              
76             =head1 VERSION
77              
78             version 0.006
79              
80             =head1 SUBROUTINES/METHODS
81              
82             MarpaX::ESLIF::URI::file inherits, and eventually overwrites some, methods of MarpaX::ESLIF::URI::_generic.
83              
84             =head2 $class->bnf
85              
86             Overwrites parent's bnf implementation. Returns the BNF used to parse the input.
87              
88             =head2 $class->grammar
89              
90             Overwrite parent's grammar implementation. Returns the compiled BNF used to parse the input as MarpaX::ESLIF::Grammar singleton.
91              
92             =head2 $self->drive($type)
93              
94             Returns the drive, or undef. C<$type> is either 'decoded' (default value), 'origin' or 'normalized'.
95              
96             =head1 SEE ALSO
97              
98             L<RFC8089|https://tools.ietf.org/html/rfc8089>, L<MarpaX::ESLIF::URI::_generic>
99              
100             =head1 AUTHOR
101              
102             Jean-Damien Durand <jeandamiendurand@free.fr>
103              
104             =head1 COPYRIGHT AND LICENSE
105              
106             This software is copyright (c) 2017 by Jean-Damien Durand.
107              
108             This is free software; you can redistribute it and/or modify it under
109             the same terms as the Perl 5 programming language system itself.
110              
111             =cut
112              
113             __DATA__
114             #
115             # Reference: https://tools.ietf.org/html/rfc8089#section-2
116             #
117             <file URI> ::= <file scheme> ":" <file hier part> action => _action_string
118              
119             <file scheme> ::= "file":i action => _action_scheme
120              
121             <file hier part> ::= "//" <auth path>
122             | <local path>
123              
124             #
125             # <file absolute> is generating ambiguity
126             #
127             <auth path> ::= <file auth> <path absolute>
128             | <path absolute>
129             | <file auth> <file absolute> rank => 1
130             | <file absolute> rank => 1
131             | <unc authority> <path absolute>
132              
133             <local path> ::= <drive letter> <path absolute> action => _action_path
134             | <path absolute>
135             | <file absolute> rank => 1
136              
137             <unc authority> ::= "//" <file host> action => _action_authority
138             | "///" <file host> action => _action_authority
139              
140             <file host> ::= <inline IP> action => _action_host
141             | IPv4address action => _action_host
142             | <reg name> action => _action_host
143              
144             <inline IP> ::= "%5B" <IPv6address> "%5D"
145             | "%5B" <IPvFuture> "%5D"
146              
147             <file absolute> ::= "/" <drive letter> <path absolute> action => _action_path
148              
149             <drive> ::= ALPHA action => _action_drive
150              
151             <drive letter> ::= <drive> ":" action => __segment
152             | <drive> "|" action => __segment
153              
154             <file auth> ::= <userinfo> "@" <host> action => _action_authority
155             | <host> action => _action_authority
156              
157             <host> ::= "localhost" action => _action_host
158             #
159             # Generic syntax will be appended here
160             #