File Coverage

blib/lib/JSON/Parser/Regexp.pm
Criterion Covered Total %
statement 55 70 78.5
branch 2 10 20.0
condition 0 3 0.0
subroutine 19 23 82.6
pod 0 2 0.0
total 76 108 70.3


line stmt bran cond sub pod time code
1             package JSON::Parser::Regexp;
2              
3 1     1   59852 use utf8;
  1         2  
  1         5  
4 1     1   1142 use Regexp::Grammars;
  1         22360  
  1         9  
5              
6             our $VERSION = '0.19';
7              
8             sub new {
9 1     1 0 77 my $class = shift;
10 1         3 return bless {}, $class;
11             }
12              
13             sub T::JSON::X {
14 1     1   3 my ($self) = @_;
15 1         5 return $self->{Hash}->X();
16             }
17              
18             sub T::Hash::X {
19 2     2   3 my ($self) = @_;
20 2         8 my %hash = $self->{Key_Values}->X();
21 2         12 return \%hash;
22             }
23              
24             sub T::Key_Values::X {
25 2     2   3 my ($self) = @_;
26 2         5 my @kvs = ();
27 2         2 for my $element ( @{ $self->{Key_Value} } ) {
  2         7  
28 6         13 push @kvs, $element->X();
29             }
30 2         13 return @kvs;
31             }
32              
33             sub T::Key_Value::X {
34 6     6   8 my ($self) = @_;
35 6         11 my $key = $self->{Key}->X();
36 6         10 my $sep = $self->{Sep}->X();
37 6         10 my $value = $self->{Value}->X();
38              
39 6 50       14 if ( $sep eq ':' ) {
40 6         12 my @kv = ( $key, $value );
41 6         16 return @kv;
42             }
43             }
44              
45             sub T::Key::X {
46 6     6   7 my ($self) = @_;
47 6         10 return $self->{String_Value}->X();
48             }
49              
50             sub T::Value::X {
51 6     6   8 my ($self) = @_;
52 6         15 return $self->{Any_Value}->X();
53             }
54              
55             sub T::Any_Value::X {
56 15     15   19 my ($self) = @_;
57             ( $self->{String_Value}
58             || $self->{Numeric_Value}
59             || $self->{Null_Value}
60             || $self->{Hash}
61             || $self->{Array}
62             || $self->{True}
63 15   0     64 || $self->{False} )->X();
64             }
65              
66             sub T::String_Value::X {
67 7     7   10 my ($self) = @_;
68 7         12 return $self->{Words}->X();
69             }
70              
71             sub T::Words::X {
72 7     7   9 my ($self) = @_;
73 7         15 return $self->{''};
74             }
75              
76             sub T::Numeric_Value::X {
77 10     10   14 my ($self) = @_;
78 10         17 return $self->{Number}->X();
79             }
80              
81             sub T::Number::X {
82 10     10   12 my ($self) = @_;
83 10         23 return $self->{''};
84             }
85              
86             sub T::Null_Value::X {
87 0     0   0 my ($self) = @_;
88 0 0       0 if ( $self->{''} eq 'null' ) {
89 0         0 return undef;
90             }
91             }
92              
93             sub T::True::X {
94 0     0   0 my ($self) = @_;
95 0 0       0 if ( $self->{''} eq 'true' ) {
96 0         0 my $TRUE = 1;
97 0         0 my $class = "JSON::Parser::Regexp::Bool";
98 0         0 return bless \$TRUE, $class;
99             }
100             }
101              
102             sub T::False::X {
103 0     0   0 my ($self) = @_;
104 0 0       0 if ( $self->{''} eq 'false' ) {
105 0         0 my $FALSE = 0;
106 0         0 my $class = "JSON::Parser::Regexp::Bool";
107 0         0 return bless \$FALSE, $class;
108             }
109             }
110              
111             sub T::Array::X {
112 3     3   5 my ($self) = @_;
113 3         7 return $self->{Array_Elements}->X();
114             }
115              
116             sub T::Array_Elements::X {
117 3     3   3 my ($self) = @_;
118 3         6 my @array = ();
119 3         3 for my $element ( @{ $self->{Array_Element} } ) {
  3         5  
120 9         12 push @array, $element->X();
121             }
122 3         6 return \@array;
123             }
124              
125             sub T::Array_Element::X {
126 9     9   12 my ($self) = @_;
127 9         17 return $self->{Any_Value}->X();
128             }
129              
130             sub T::Sep::X {
131 6     6   7 my ($self) = @_;
132 6         13 return $self->{''};
133             }
134              
135             sub T::Comma::X {
136 0     0   0 my ($self) = @_;
137 0         0 return $self->{''};
138             }
139              
140             my $Parser = qr {
141            
142              
143            
144            
145              
146             | | | | | |
147              
148             \{ \}
149              
150             <[Key_Value]>+ %
151            
152            
153            
154              
155             \[ \]
156             <[Array_Element]>+ %
157            
158              
159             \s*\"\s*\s*\"\s*
160             (.)*?
161              
162             \s*\s*
163             [-]?[\d\.]*
164              
165             null
166             true
167             false
168             \:
169             \,
170              
171             }xms;
172              
173             sub decode {
174 1     1 0 6 my ( $self, $String ) = @_;
175 1 50       26 if ( $String =~ $Parser ) {
176 1         39 $/{JSON}->X();
177             }
178             }
179              
180             1;
181             __END__