File Coverage

blib/lib/MarpaX/ESLIF/URI/http.pm
Criterion Covered Total %
statement 28 28 100.0
branch 1 2 50.0
condition 1 2 50.0
subroutine 10 10 100.0
pod 2 2 100.0
total 42 44 95.4


line stmt bran cond sub pod time code
1 1     1   607 use strict;
  1         3  
  1         30  
2 1     1   5 use warnings FATAL => 'all';
  1         3  
  1         65  
3              
4             package MarpaX::ESLIF::URI::http;
5              
6             # ABSTRACT: URI::http syntax as per RFC7230
7              
8             our $AUTHORITY = 'cpan:JDDPAUSE'; # AUTHORITY
9              
10             our $VERSION = '0.006'; # VERSION
11              
12 1     1   6 use Carp qw/croak/;
  1         1  
  1         70  
13 1     1   6 use Class::Tiny::Antlers;
  1         2  
  1         9  
14 1     1   191 use Class::Method::Modifiers qw/around/;
  1         2  
  1         45  
15 1     1   5 use MarpaX::ESLIF;
  1         12  
  1         21  
16 1     1   388 use Net::servent qw/getservbyname/;
  1         3275  
  1         5  
17              
18             extends 'MarpaX::ESLIF::URI::_generic';
19              
20             #
21             # Constants
22             #
23             my $BNF = do { local $/; <DATA> };
24             my $GRAMMAR = MarpaX::ESLIF::Grammar->new(__PACKAGE__->eslif, __PACKAGE__->bnf);
25             my $DEFAULT_PORT;
26             BEGIN {
27 1     1   120 my $s = getservbyname('http');
28 1 50       679 $DEFAULT_PORT = $s->port if $s;
29 1   50     314 $DEFAULT_PORT //= 80
30             }
31              
32              
33             sub bnf {
34 1     1 1 3 my ($class) = @_;
35              
36 1         5 join("\n", $BNF, MarpaX::ESLIF::URI::_generic->bnf)
37             };
38              
39              
40             sub grammar {
41 7     7 1 17 my ($class) = @_;
42              
43 7         424 return $GRAMMAR;
44             }
45              
46             # -------------
47             # Normalization
48             # -------------
49             around _set__authority => sub {
50             my ($orig, $self, $value) = @_;
51             #
52             # If the port is equal to the default port for a scheme, the normal
53             # form is to omit the port subcomponent
54             #
55             my $port = $self->port;
56             if (! defined($port) || ($port eq '') || ($port == $DEFAULT_PORT)) {
57             my $new_port = $self->_port;
58             $new_port->{normalized} = undef;
59             $self->_set__port($new_port);
60             $value->{normalized} =~ s/:[^:]*//
61             }
62             $self->$orig($value)
63             };
64              
65             around _set__path => sub {
66             my ($orig, $self, $value) = @_;
67             #
68             # Normalized path is '/' instead of empty, as if
69             # it was a <path absolute>
70             #
71             if (! length($value->{normalized})) {
72             $value->{normalized} = '/'
73             }
74             $self->$orig($value)
75             };
76              
77              
78             1;
79              
80             =pod
81              
82             =encoding UTF-8
83              
84             =head1 NAME
85              
86             MarpaX::ESLIF::URI::http - URI::http syntax as per RFC7230
87              
88             =head1 VERSION
89              
90             version 0.006
91              
92             =head1 SUBROUTINES/METHODS
93              
94             MarpaX::ESLIF::URI::http inherits, and eventually overwrites some, methods of MarpaX::ESLIF::URI::_generic.
95              
96             =head2 $class->bnf
97              
98             Overwrites parent's bnf implementation. Returns the BNF used to parse the input.
99              
100             =head2 $class->grammar
101              
102             Overwrite parent's grammar implementation. Returns the compiled BNF used to parse the input as MarpaX::ESLIF::Grammar singleton.
103              
104             =head1 NOTES
105              
106             The default http port is the one configured on caller's system, or 80.
107              
108             =head1 SEE ALSO
109              
110             L<RFC7230|https://tools.ietf.org/html/rfc7230>, L<MarpaX::ESLIF::URI::_generic>
111              
112             =head1 AUTHOR
113              
114             Jean-Damien Durand <jeandamiendurand@free.fr>
115              
116             =head1 COPYRIGHT AND LICENSE
117              
118             This software is copyright (c) 2017 by Jean-Damien Durand.
119              
120             This is free software; you can redistribute it and/or modify it under
121             the same terms as the Perl 5 programming language system itself.
122              
123             =cut
124              
125             __DATA__
126             #
127             # Reference: https://tools.ietf.org/html/rfc7230#section-2.7.1
128             #
129             <http URI> ::= <http scheme> ":" <http hier part> <URI query> <URI fragment> action => _action_string
130              
131             <http scheme> ::= "http":i action => _action_scheme
132             #
133             # Empty host is invalid
134             #
135             <http hier part> ::= "//" <http authority> <path abempty>
136              
137             <http authority> ::= <http authority value> action => _action_authority
138             <http authority value> ::= <authority userinfo> <http host> <authority port>
139             <http host> ::= <IP literal> rank => 0 action => _action_host
140             | <IPv4address> rank => -1 action => _action_host
141             | <http reg name> rank => -2 action => _action_host
142              
143             <http reg name> ::= <reg name unit>+
144              
145             #
146             # Generic syntax will be appended here
147             #