File Coverage

blib/lib/MarpaX/Demo/JSONParser/Actions.pm
Criterion Covered Total %
statement 40 42 95.2
branch n/a
condition n/a
subroutine 13 14 92.8
pod 1 12 8.3
total 54 68 79.4


line stmt bran cond sub pod time code
1             package MarpaX::Demo::JSONParser::Actions;
2              
3 1     1   4 use strict;
  1         1  
  1         23  
4 1     1   3 use warnings;
  1         1  
  1         335  
5              
6             # Warning: Do not use Moo or anything similar.
7             # This class needs a sub new() due to the way
8             # Marpa calls the constructor.
9              
10             our $VERSION = '1.07';
11              
12             # ------------------------------------------------
13              
14             sub do_array
15             {
16 5     5 0 92 shift;
17              
18 5         8 return $_[1];
19              
20             } # End of do_array.
21              
22             # ------------------------------------------------
23              
24             sub do_empty_array
25             {
26 4     4 0 465 return [];
27              
28             } # End of do_empty_array.
29              
30             # ------------------------------------------------
31              
32             sub do_empty_object
33             {
34 1     1 0 27 return {};
35              
36             } # End of do_empty_object.
37              
38             # ------------------------------------------------
39              
40             sub do_first_arg
41             {
42 85     85 0 1582 shift;
43              
44 85         123 return $_[0];
45              
46             } # End of do_first_arg.
47              
48             # ------------------------------------------------
49              
50             sub do_join
51             {
52 0     0 0 0 shift;
53              
54 0         0 return join '', @_;
55              
56             } # End of do_join.
57              
58             # ------------------------------------------------
59              
60             sub do_list
61             {
62 24     24 0 438 shift;
63              
64 24         41 return \@_;
65              
66             } # End of do_list.
67              
68             # ------------------------------------------------
69              
70             sub do_null
71             {
72 2     2 0 58 return undef;
73              
74             } # End of do_null.
75              
76             # ------------------------------------------------
77              
78             sub do_object
79             {
80 19     19 0 358 shift;
81              
82 19         20 return {map {@$_} @{$_[1]} };
  65         120  
  19         36  
83              
84             } # End of do_object.
85              
86             # ------------------------------------------------
87              
88             sub do_pair
89             {
90 65     65 0 1184 shift;
91              
92 65         119 return [ $_[0], $_[2] ];
93              
94             } # End of do_pair.
95              
96             # ------------------------------------------------
97              
98             sub do_string
99             {
100 102     102 0 7068 shift;
101              
102 102         114 my($s) = $_[0];
103              
104 102         254 $s =~ s/^"//;
105 102         179 $s =~ s/"$//;
106              
107 102         90 $s =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/eg;
  1         7  
108              
109 102         95 $s =~ s/\\n/\n/g;
110 102         75 $s =~ s/\\r/\r/g;
111 102         63 $s =~ s/\\b/\b/g;
112 102         78 $s =~ s/\\f/\f/g;
113 102         88 $s =~ s/\\t/\t/g;
114 102         88 $s =~ s/\\\\/\\/g;
115 102         75 $s =~ s{\\/}{/}g;
116 102         87 $s =~ s{\\"}{"}g;
117              
118 102         158 return $s;
119              
120             } # End of do_string.
121              
122             # ------------------------------------------------
123              
124             sub do_true
125             {
126 4     4 0 93 shift;
127              
128 4         9 return $_[0] eq 'true';
129              
130             } # End of do_true.
131              
132             # ------------------------------------------------
133              
134             sub new
135             {
136 28     28 1 59457 my($class) = @_;
137              
138 28         161 return bless {}, $class;
139              
140             } # End of new.
141              
142             # ------------------------------------------------
143              
144             1;
145              
146             =pod
147              
148             =head1 NAME
149              
150             C - A JSON parser with a choice of grammars
151              
152             =head1 Synopsis
153              
154             See L.
155              
156             The module is used automatically by L as appropriate.
157              
158             =head1 Description
159              
160             See L.
161              
162             =head1 Installation
163              
164             See L.
165              
166             =head1 Methods
167              
168             The functions are called automatically by L as appropriate.
169              
170             =head2 new()
171              
172             The constructor is called automatically by L as appropriate.
173              
174             =head1 Machine-Readable Change Log
175              
176             The file Changes was converted into Changelog.ini by L.
177              
178             =head1 Version Numbers
179              
180             Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions.
181              
182             =head1 Support
183              
184             Email the author, or log a bug on RT:
185              
186             L.
187              
188             =head1 Author
189              
190             Peter Stuifzand wrote the code in 2013.
191              
192             L is now maintained by Ron Savage Iron@savage.net.auE>.
193              
194             Home page: L.
195              
196             =head1 Copyright
197              
198             Australian copyright (c) 2013, Ron Savage.
199              
200             All Programs of mine are 'OSI Certified Open Source Software';
201             you can redistribute them and/or modify them under the terms of
202             The Artistic License 2.0, a copy of which is available at:
203             http://www.opensource.org/licenses/index.html
204              
205             =cut