File Coverage

blib/lib/JSON/Relaxed.pm
Criterion Covered Total %
statement 234 247 94.7
branch 124 138 89.8
condition 4 5 80.0
subroutine 36 37 97.3
pod 1 1 100.0
total 399 428 93.2


line stmt bran cond sub pod time code
1             package JSON::Relaxed;
2 1     1   476 use strict;
  1         1  
  1         157  
3              
4             # debugging
5             # use Debug::ShowStuff ':all';
6             # use Debug::ShowStuff::ShowVar;
7              
8             # version
9             our $VERSION = '0.03';
10              
11             # global error messages
12             our $err_id;
13             our $err_msg;
14              
15              
16             =head1 NAME
17              
18             JSON::Relaxed -- An extension of JSON that allows for better human-readability.
19              
20             =head1 SYNOPSIS
21              
22             my ($rjson, $hash, $parser);
23            
24             # raw RJSON code
25             $rjson = <<'(RAW)';
26             /* Javascript-like comments are allowed */
27             {
28             // single or double quotes allowed
29             a : 'Larry',
30             b : "Curly",
31            
32             // nested structures allowed like in JSON
33             c: [
34             {a:1, b:2},
35             ],
36            
37             // like Perl, trailing commas are allowed
38             d: "more stuff",
39             }
40             (RAW)
41            
42             # subroutine parsing
43             $hash = from_rjson($rjson);
44            
45             # object-oriented parsing
46             $parser = JSON::Relaxed::Parser->new();
47             $hash = $parser->parse($rjson);
48              
49              
50             =head1 INSTALLATION
51              
52             JSON::Relaxed can be installed with the usual routine:
53              
54             perl Makefile.PL
55             make
56             make test
57             make install
58              
59             =head1 DESCRIPTION
60              
61             JSON::Relaxed is a lightweight parser and serializer for an extension of JSON
62             called Relaxed JSON (RJSON). The intent of RJSON is to provide a format that
63             is more human-readable and human-editable than JSON. Most notably, RJSON allows
64             the use of JavaScript-like comments. By doing so, configuration files and other
65             human-edited files can include comments to indicate the intention of each
66             configuration.
67              
68             JSON::Relaxed is currently only a parser that reads in RJSON code and produces
69             a data structure. JSON::Relaxed does not currently encode data structures into
70             JSON/RJSON. That feature is planned.
71              
72             =head2 Why Relaxed JSON?
73              
74             There's been increasing support for the idea of expanding JSON to improve
75             human-readability. "Relaxed" JSON is a term that has been used to describe a
76             JSON-ish format that has some features that JSON doesn't. Although there isn't
77             yet any kind of official specification, descriptions of Relaxed JSON generally
78             include the following extensions to JSON:
79              
80             =over 4
81              
82             =item * comments
83              
84             RJSON supports JavaScript-like comments:
85              
86             /* inline comments */
87             // line-based comments
88              
89             =item * trailing commas
90              
91             Like Perl, RJSON allows treats commas as separators. If nothing is before,
92             after, or between commas, those commas are just ignored:
93              
94             {
95             , // look, nothing before this comma
96             "data",
97             , // nothing after this comma
98             }
99              
100             =item * single quotes, double quotes, no quotes
101              
102             Strings can be quoted with either single or double quotes. Space-less strings
103             are also parsed as strings. So, the following data items are equivalent:
104              
105             [
106             "Starflower",
107             'Starflower',
108             Starflower
109             ]
110              
111             Note that unquoted boolean values are still treated as boolean values, so the
112             following are NOT the same:
113              
114             [
115             "true", // string
116             true, // boolean true
117            
118             "false", // string
119             false, // boolean false
120            
121             "null", // string
122             null, // what Perl programmers call undef
123             ]
124              
125             Because of this ambiguity, unquoted non-boolean strings should be considered
126             sloppy and not something you do in polite company.
127              
128             =item * documents that are just a single string
129              
130             Early versions of JSON require that a JSON document contains either a single
131             hash or a single array. Later versions also allow a single string. RJSON
132             follows that later rule, so the following is a valid RJSON document:
133              
134             "Hello world"
135              
136             =item * hash keys without values
137              
138             A hash in JSON can have a key that is followed by a comma or a closing C<}>
139             without a specified value. In that case the hash element is simply assigned
140             the undefined value. So, in the following example, C is assigned C<1>,
141             C is assigned 2, and C is assigned undef:
142              
143             {
144             a: 1,
145             b: 2,
146             c
147             }
148              
149             =back
150              
151             =cut
152              
153              
154             #------------------------------------------------------------------------------
155             # from_rjson
156             #
157              
158             =head2 from_rjson()
159              
160             C is the simple way to quickly parse an RJSON string. Currently
161             C only takes a single parameter, the string itself. So in the
162             following example, C parses and returns the structure defined in
163             C<$rjson>.
164              
165             $structure = from_rjson($rjson);
166              
167             =cut
168              
169             sub from_rjson {
170 2     2 1 424 my ($raw) = @_;
171 2         10 my $parser = JSON::Relaxed::Parser->new();
172 2         5 return $parser->parse($raw);
173             }
174             #
175             # from_rjson
176             #------------------------------------------------------------------------------
177              
178              
179             #------------------------------------------------------------------------------
180             # object-oriented parsing
181             #
182              
183             =head2 Object-oriented parsing
184              
185             To parse using an object, create a C object, like this:
186              
187             $parser = JSON::Relaxed::Parser->new();
188              
189             Then call the parser's parse method, passing in the RJSON string:
190              
191             $structure = $parser->parse($rjson);
192              
193             B
194              
195             =over 4
196              
197             =item * $parser->extra_tokens_ok()
198              
199             C sets/gets the C property. By default,
200             C is false. If by C is true then the
201             C isn't triggered and the parser returns the first
202             structure it finds. So, for example, the following code would return undef and
203             sets the C error:
204              
205             $parser = JSON::Relaxed::Parser->new();
206             $structure = $parser->parse('{"x":1} []');
207              
208             However, by setting C to true, a hash structure is
209             returned, the extra code after that first hash is ignored, and no error is set:
210              
211             $parser = JSON::Relaxed::Parser->new();
212             $parser->extra_tokens_ok(1);
213             $structure = $parser->parse('{"x":1} []');
214              
215             =back
216              
217             =cut
218              
219             #
220             # object-oriented parsing
221             #------------------------------------------------------------------------------
222              
223              
224              
225             #------------------------------------------------------------------------------
226             # error codes
227             #
228              
229             =head2 Error codes
230              
231             When JSON::Relaxed encounters a parsing error it returns C and sets two
232             global variables:
233              
234             =over 4
235              
236             =item * $JSON::Relaxed::err_id
237              
238             C<$err_id> is a unique code for a specific error. Every code is set in only
239             one place in JSON::Relaxed.
240              
241             =item * $JSON::Relaxed::err_msg
242              
243             C<$err_msg> is an English description of the code. It would be cool to migrate
244             towards multi-language support for C<$err_msg>.
245              
246             =back
247              
248             Following is a list of all error codes in JSON::Relaxed:
249              
250             =over 4
251              
252             =item * C
253              
254             The string to be parsed was not sent to $parser->parse(). For example:
255              
256             $parser->parse()
257              
258             =item * C
259              
260             The string to be parsed is undefined. For example:
261              
262             $parser->parse(undef)
263              
264             =item * C
265              
266             The string to be parsed is zero-length. For example:
267              
268             $parser->parse('')
269              
270             =item * C
271              
272             The string to be parsed has no content beside space characters. For example:
273              
274             $parser->parse(' ')
275              
276             =item * C
277              
278             The string to be parsed has no content. This error is slightly different than
279             C in that it is triggered when the input contains only
280             comments, like this:
281              
282             $parser->parse('/* whatever */')
283              
284              
285             =item * C
286              
287             A comment was started with /* but was never closed. For example:
288              
289             $parser->parse('/*')
290              
291             =item * C
292              
293             The document opens with an invalid structural character like a comma or colon.
294             The following examples would trigger this error.
295              
296             $parser->parse(':')
297             $parser->parse(',')
298             $parser->parse('}')
299             $parser->parse(']')
300              
301             =item * C
302              
303             The document has multiple structures. JSON and RJSON only allow a document to
304             consist of a single hash, a single array, or a single string. The following
305             examples would trigger this error.
306              
307             $parse->parse('{}[]')
308             $parse->parse('{} "whatever"')
309             $parse->parse('"abc" "def"')
310              
311             =item * C
312              
313             A hash key may only be followed by the closing hash brace or a colon. Anything
314             else triggers C. So, the following examples would
315             trigger this error.
316              
317             $parse->parse("{a [ }") }
318             $parse->parse("{a b") }
319              
320             =item * C
321              
322             The parser encountered something besides a string where a hash key should be.
323             The following are examples of code that would trigger this error.
324              
325             $parse->parse('{{}}')
326             $parse->parse('{[]}')
327             $parse->parse('{]}')
328             $parse->parse('{:}')
329              
330             =item * C
331              
332             A hash has an opening brace but no closing brace. For example:
333              
334             $parse->parse('{x:1')
335              
336             =item * C
337              
338             An array has an opening brace but not a closing brace. For example:
339              
340             $parse->parse('["x", "y"')
341              
342             =item * C
343              
344             In a hash, a colon must be followed by a value. Anything else triggers this
345             error. For example:
346              
347             $parse->parse('{"a":,}')
348             $parse->parse('{"a":}')
349              
350             =item * C
351              
352             In an array, a comma must be followed by a value, another comma, or the closing
353             array brace. Anything else triggers this error. For example:
354              
355             $parse->parse('[ "x" "y" ]')
356             $parse->parse('[ "x" : ]')
357              
358             =item * C
359              
360             This error exists just in case there's an invalid token in an array that
361             somehow wasn't caught by C. This error
362             shouldn't ever be triggered. If it is please L.
363              
364             =item * C
365              
366             This error is triggered when a quote isn't closed. For example:
367              
368             $parse->parse("'whatever")
369             $parse->parse('"whatever') }
370              
371             =back
372              
373              
374             =cut
375              
376             #
377             # error codes
378             #------------------------------------------------------------------------------
379              
380              
381             #------------------------------------------------------------------------------
382             # export
383             #
384 1     1   5 use base 'Exporter';
  1         1  
  1         98  
385 1     1   4 use vars qw[@EXPORT_OK %EXPORT_TAGS];
  1         4  
  1         257  
386              
387             # the following functions accept a value and return a modified version of
388             # that value
389             push @EXPORT_OK, qw[from_rjson];
390              
391             %EXPORT_TAGS = ('all' => [@EXPORT_OK]);
392             #
393             # export
394             #------------------------------------------------------------------------------
395              
396              
397             #------------------------------------------------------------------------------
398             # JSON::Relaxed POD
399             #
400              
401             =head1 INTERNALS
402              
403             The following documentation is for if you want to edit the code of
404             JSON::Relaxed itself.
405              
406             =head2 JSON::Relaxed
407              
408             C is the parent package. Not a lot actually happens in
409             C, it mostly contains L and
410             definitions of various structures.
411              
412             =over 4
413              
414             =cut
415              
416             #
417             # JSON::Relaxed POD
418             #------------------------------------------------------------------------------
419              
420              
421             #------------------------------------------------------------------------------
422             # special character and string definitions
423             #
424              
425             =item Special character and string definitions
426              
427             The following hashes provide information about characters and strings that have
428             special meaning in RJSON.
429              
430             =over 4
431              
432             =item * Escape characters
433              
434             The C<%esc> hash defines the six escape characters in RJSON that are
435             changed to single characters. C<%esc> is defined as follows.
436              
437             our %esc = (
438             'b' => "\b", # Backspace
439             'f' => "\f", # Form feed
440             'n' => "\n", # New line
441             'r' => "\r", # Carriage return
442             't' => "\t", # Tab
443             'v' => chr(11), # Vertical tab
444             );
445              
446             =cut
447              
448             # escape characters
449             our %esc = (
450             'b' => "\b", # Backspace
451             'f' => "\f", # Form feed
452             'n' => "\n", # New line
453             'r' => "\r", # Carriage return
454             't' => "\t", # Tab
455             'v' => chr(11), # Vertical tab
456             );
457              
458             =item * Structural characters
459              
460             The C<%structural> hash defines the six characters in RJSON that define
461             the structure of the data object. The structural characters are defined as
462             follows.
463              
464             our %structural = (
465             '[' => 1, # beginning of array
466             ']' => 1, # end of array
467             '{' => 1, # beginning of hash
468             '}' => 1, # end of hash
469             ':' => 1, # delimiter between name and value of hash element
470             ',' => 1, # separator between elements in hashes and arrays
471             );
472              
473             =cut
474              
475             # structural
476             our %structural = (
477             '[' => 1, # beginning of array
478             ']' => 1, # end of array
479             '{' => 1, # beginning of hash
480             '}' => 1, # end of hash
481             ':' => 1, # delimiter between name and value of hash element
482             ',' => 1, # separator between elements in hashes and arrays
483             );
484              
485             =item * Quotes
486              
487             The C<%quotes> hash defines the two types of quotes recognized by RJSON: single
488             and double quotes. JSON only allows the use of double quotes to define strings.
489             Relaxed also allows single quotes. C<%quotes> is defined as follows.
490              
491             our %quotes = (
492             '"' => 1,
493             "'" => 1,
494             );
495              
496             =cut
497              
498             # quotes
499             our %quotes = (
500             '"' => 1,
501             "'" => 1,
502             );
503              
504             =item * End of line characters
505              
506             The C<%newlines> hash defines the three ways a line can end in a RJSON
507             document. Lines in Windows text files end with carriage-return newline
508             ("\r\n"). Lines in Unixish text files end with newline ("\n"). Lines in some
509             operating systems end with just carriage returns ("\n"). C<%newlines> is
510             defined as follows.
511              
512             our %newlines = (
513             "\r\n" => 1,
514             "\r" => 1,
515             "\n" => 1,
516             );
517              
518             =cut
519              
520             # newline tokens
521             our %newlines = (
522             "\r\n" => 1,
523             "\r" => 1,
524             "\n" => 1,
525             );
526              
527             =item * Boolean
528              
529             The C<%boolean> hash defines strings that are boolean values: true, false, and
530             null. (OK, 'null' isn't B a boolean value, but I couldn't think of what
531             else to call this hash.) C<%boolean> is defined as follows.
532              
533             our %boolean = (
534             'null' => 1,
535             'true' => 1,
536             'false' => 1,
537             );
538              
539             =back
540              
541             =cut
542              
543             # boolean values
544             our %boolean = (
545             'null' => undef,
546             'true' => 1,
547             'false' => 0,
548             );
549              
550             #
551             # special character definitions
552             #------------------------------------------------------------------------------
553              
554              
555             #------------------------------------------------------------------------------
556             # closing POD for JSON::Relaxed
557             #
558              
559             =back
560              
561             =cut
562              
563             #
564             # closing POD for JSON::Relaxed
565             #------------------------------------------------------------------------------
566              
567              
568             ###############################################################################
569             # JSON::Relaxed::Parser
570             #
571             package JSON::Relaxed::Parser;
572 1     1   4 use strict;
  1         1  
  1         1226  
573              
574              
575             # debugging
576             # use Debug::ShowStuff ':all';
577              
578              
579             #------------------------------------------------------------------------------
580             # POD
581             #
582              
583             =head2 JSON::Relaxed::Parser
584              
585             A C object parses the raw RJSON string. You don't
586             need to instantiate a parser if you just want to use the default settings.
587             In that case just use L.
588              
589             You would create a C object if you want to customize how
590             the string is parsed. I say "would" because there isn't actually any
591             customization in these early releases. When there is you'll use a parser
592             object.
593              
594             To parse in an object oriented manner, create the parser, then parse.
595              
596             $parser = JSON::Relaxed::Parser->new();
597             $structure = $parser->parse($string);
598              
599             =over 4
600              
601             =cut
602              
603             #
604             # POD
605             #------------------------------------------------------------------------------
606              
607              
608             #------------------------------------------------------------------------------
609             # new
610             #
611              
612             =item new
613              
614             Cnew()> creates a parser object. Its simplest and most
615             common use is without any parameters.
616              
617             my $parser = JSON::Relaxed::Parser->new();
618              
619             =over 4
620              
621             =item B unknown
622              
623             The C option sets the character which creates the
624             L. The unknown object
625             exists only for testing JSON::Relaxed. It has no purpose in production use.
626              
627             my $parser = JSON::Relaxed::Parser->new(unknown=>'~');
628              
629             =back
630              
631             =cut
632              
633             sub new {
634 77     77   18361 my ($class, %opts) = @_;
635 77         176 my $parser = bless({}, $class);
636            
637             # TESTING
638             # println subname(class=>1); ##i
639            
640             # "unknown" object character
641 77 100       152 if (defined $opts{'unknown'}) {
642 2         4 $parser->{'unknown'} = $opts{'unknown'};
643             }
644            
645             # return
646 77         216 return $parser;
647             }
648             #
649             # new
650             #------------------------------------------------------------------------------
651              
652              
653             #------------------------------------------------------------------------------
654             # extra_tokens_ok
655             #
656             sub extra_tokens_ok {
657 16     16   112 my ($parser) = @_;
658            
659             # set value
660 16 100       32 if (@_ > 1) {
661 2 100       6 $parser->{'extra_tokens_ok'} = $_[1] ? 1 : 0;
662             }
663            
664             # return
665 16 100       44 return $parser->{'extra_tokens_ok'} ? 1 : 0;
666             }
667             #
668             # extra_tokens_ok
669             #------------------------------------------------------------------------------
670              
671              
672             #------------------------------------------------------------------------------
673             # error
674             #
675             sub error {
676 40     40   46 my ($parser, $id, $msg) = @_;
677            
678             # set errors
679 40         34 $JSON::Relaxed::err_id = $id;
680 40         29 $JSON::Relaxed::err_msg = $msg;
681            
682             # return undef
683 40         104 return undef;
684             }
685             #
686             # error
687             #------------------------------------------------------------------------------
688              
689              
690             #------------------------------------------------------------------------------
691             # is_error
692             #
693             sub is_error {
694 77     77   71 my ($parser) = @_;
695            
696             # return true if there is an error, false otherwise
697 77 100       85 if ($JSON::Relaxed::err_id)
698 22         46 { return 1 }
699             else
700 55         104 { return 0 }
701             }
702             #
703             # is_error
704             #------------------------------------------------------------------------------
705              
706              
707              
708              
709             #------------------------------------------------------------------------------
710             # "is" methods
711             #
712              
713             =item Parser "is" methods
714              
715             The following methods indicate if a token has some specific property, such as
716             being a string object or a structural character.
717              
718             =over 4
719              
720             =cut
721              
722              
723              
724             =item * is_string()
725              
726             Returns true if the token is a string object, i.e. in the class
727             C.
728              
729             =cut
730              
731             # the object is a string object
732             sub is_string {
733 163     163   146 my ($parser, $object) = @_;
734 163         584 return UNIVERSAL::isa($object, 'JSON::Relaxed::Parser::Token::String');
735             }
736              
737              
738              
739             =item * is_struct_char()
740              
741             Returns true if the token is one of the structural characters of JSON, i.e.
742             one of the following:
743              
744             { } [ ] : ,
745              
746             =cut
747              
748             # the object is a structural character
749             sub is_struct_char {
750 0     0   0 my ($parser, $object) = @_;
751            
752             # if it's a reference, it's not a structural character
753 0 0       0 if (ref $object) {
    0          
754 0         0 return 0;
755             }
756            
757             # else if the object is defined
758             elsif (defined $object) {
759 0         0 return $JSON::Relaxed::structural{$object};
760             }
761            
762             # else whatever it is it isn't a structural character
763             else {
764 0         0 return 0;
765             }
766             }
767              
768              
769              
770             =item * is_unknown_char()
771              
772             Returns true if the token is the
773             L.
774              
775             =cut
776              
777             # the object is the "unknown" character
778             sub is_unknown_char {
779 63     63   71 my ($parser, $char) = @_;
780            
781             # if there even is a "unknown" character
782 63 100       115 if (defined $parser->{'unknown'}) {
783 2 50       5 if ($char eq $parser->{'unknown'})
784 2         5 { return 1 }
785             }
786            
787             # it's not the "unknown" character
788 61         95 return 0;
789             }
790              
791              
792              
793             =item * is_list_opener()
794              
795             Returns true if the token is the opening character for a hash or an array,
796             i.e. it is one of the following two characters:
797              
798             { [
799              
800             =cut
801              
802             # is_list_opener
803             sub is_list_opener {
804 50     50   48 my ($parser, $token) = @_;
805            
806             # if not defined, return false
807 50 50       87 if (! defined $token)
808 0         0 { return 0 }
809            
810             # if it's an object, return false
811 50 100       71 if (ref $token)
812 22         67 { return 0 }
813            
814             # opening brace for hash
815 28 100       47 if ($token eq '{')
816 4         11 { return 1 }
817            
818             # opening brace for array
819 24 100       38 if ($token eq '[')
820 5         9 { return 1 }
821            
822             # it's not a list opener
823 19         54 return 0;
824             }
825              
826              
827             =item * is_comment_opener()
828              
829             Returns true if the token is the opening character for a comment,
830             i.e. it is one of the following two couplets:
831              
832             /*
833             //
834              
835             =cut
836              
837             # is_comment_opener
838             sub is_comment_opener {
839 215     215   180 my ($parser, $token) = @_;
840            
841             # if not defined, return false
842 215 50       284 if (! defined $token)
843 0         0 { return 0 }
844            
845             # if it's an object, return false
846 215 50       261 if (ref $token)
847 0         0 { return 0 }
848            
849             # opening inline comment
850 215 100       268 if ($token eq '/*')
851 1         2 { return 1 }
852            
853             # opening line comment
854 214 100       263 if ($token eq '//')
855 1         3 { return 1 }
856            
857             # it's not a comment opener
858 213         326 return 0;
859             }
860              
861              
862              
863             =back
864              
865             =cut
866              
867             #
868             # "is" methods
869             #------------------------------------------------------------------------------
870              
871              
872             #------------------------------------------------------------------------------
873             # parse
874             #
875              
876             =item parse()
877              
878             C is the method that does the work of parsing the RJSON string.
879             It returns the data structure that is defined in the RJSON string.
880             A typical usage would be as follows.
881              
882             my $parser = JSON::Relaxed::Parser->new();
883             my $structure = $parser->parse('["hello world"]');
884              
885             C does not take any options.
886              
887             =cut
888              
889             sub parse {
890 68     68   385 my ($parser, $raw) = @_;
891 68         51 my (@chars, @tokens, $rv);
892            
893             # TESTING
894             # println subname(class=>1); ##i
895            
896             # clear global error information
897 68         62 undef $JSON::Relaxed::err_id;
898 68         47 undef $JSON::Relaxed::err_msg;
899            
900             # must have at least two params
901 68 100       129 if (@_ < 2) {
902 1         3 return $parser->error(
903             'missing-parameter',
904             'the string to be parsed was not sent to $parser->parse()'
905             )
906             }
907            
908             # $raw must be defined
909 67 100       102 if (! defined $raw) {
910 1         2 return $parser->error(
911             'undefined-input',
912             'the string to be parsed is undefined'
913             );
914             }
915            
916             # $raw must not be an empty string
917 66 100       100 if ($raw eq '') {
918 1         3 return $parser->error(
919             'zero-length-input',
920             'the string to be parsed is zero-length'
921             );
922             }
923            
924             # $raw must have content
925 65 100       224 if ($raw !~ m|\S|s) {
926 1         1 return $parser->error(
927             'space-only-input',
928             'the string to be parsed has no content beside space characters'
929             );
930             }
931            
932             # get characters
933 64         98 @chars = $parser->parse_chars($raw);
934            
935             # get tokens
936 64         139 @tokens = $parser->tokenize(\@chars);
937            
938             # special case: entire structure is a single scalar
939             # NOTE: Some versions of JSON do not allow a single scalar as an entire
940             # JSON document.
941             #if (@tokens == 1) {
942             # # if single scalar is a string
943             # if ( $parser->is_string($tokens[0]) )
944             # { return $tokens[0]->as_perl() }
945             #}
946            
947             # must be at least one token
948 64 100       507 if (! @tokens) {
949 2         6 return $parser->error(
950             'no-content',
951             'the string to be parsed has no content'
952             )
953             }
954            
955             # build structure
956 62         114 $rv = $parser->structure(\@tokens, top=>1);
957             }
958             #
959             # parse
960             #------------------------------------------------------------------------------
961              
962              
963             #------------------------------------------------------------------------------
964             # parse_chars
965             #
966              
967             =item parse_chars()
968              
969             C parses the RJSON string into either individual characters
970             or two-character couplets. This method returns an array. The only input is the
971             raw RJSON string. So, for example, the following string:
972              
973             $raw = qq|/*x*/["y"]|;
974             @chars = $parser->parse_chars($raw);
975              
976             would be parsed into the following array:
977              
978             ( "/*", "x", "*/", "[", "\"", "y", "\""", "]" )
979              
980             Most of the elements in the array are single characters. However, comment
981             delimiters, escaped characters, and Windows-style newlines are parsed as
982             two-character couplets:
983              
984             =over 4
985              
986             =item * C<\> followed by any character
987              
988             =item * C<\r\n>
989              
990             =item * C
991              
992             =item * C
993              
994             =item * C<*/>
995              
996             =back
997              
998             C should not produce any fatal errors.
999              
1000             =cut
1001              
1002             sub parse_chars {
1003 78     78   241 my ($parser, $raw) = @_;
1004 78         69 my (@rv);
1005            
1006             # clear global error information
1007 78         57 undef $JSON::Relaxed::err_id;
1008 78         66 undef $JSON::Relaxed::err_msg;
1009            
1010             # split on any of the following couplets, or on single characters
1011             # \{any character}
1012             # \r\n
1013             # //
1014             # /*
1015             # */
1016             # {any character}
1017 78         1078 @rv = split(m/(\\.|\r\n|\/\/|\/\*|\*\/|.)/sx, $raw);
1018            
1019             # remove empty strings
1020 78         180 @rv = grep {length($_)} @rv;
  2942         2672  
1021            
1022             # return
1023 78         502 return @rv;
1024             }
1025             #
1026             # parse_chars
1027             #------------------------------------------------------------------------------
1028              
1029              
1030             #------------------------------------------------------------------------------
1031             # tokenize
1032             #
1033              
1034             =item tokenize()
1035              
1036             C organizes the characters from
1037             C> into tokens. Those tokens can then be
1038             organized into a data structure with
1039             C>.
1040              
1041             Each token represents an item that is recognized by JSON. Those items include
1042             structural characters such as C<{> or C<}>, or strings such as
1043             C<"hello world">. Comments and insignificant whitespace are filtered out
1044             by C.
1045              
1046             For example, this code:
1047              
1048             $parser = JSON::Relaxed::Parser->new();
1049             $raw = qq|/*x*/ ["y"]|;
1050             @chars = $parser->parse_chars($raw);
1051             @tokens = $parser->tokenize(\@chars);
1052              
1053             would produce an array like this:
1054              
1055             (
1056             '[',
1057             JSON::Relaxed::Parser::Token::String::Quoted=HASH(0x20bf0e8),
1058             ']'
1059             )
1060              
1061             Strings are tokenized into string objects. When the parsing is complete they
1062             are returned as scalar variables, not objects.
1063              
1064             C should not produce any fatal errors.
1065              
1066             =cut
1067              
1068             sub tokenize {
1069 77     77   480 my ($parser, $chars_org) = @_;
1070 77         58 my (@chars, @tokens);
1071            
1072             # TESTING
1073             # println subname(class=>1); ##i
1074            
1075             # create own array of characters
1076 77         248 @chars = @$chars_org;
1077            
1078             # loop through characters
1079             CHAR_LOOP:
1080 77         150 while (@chars) {
1081 454         379 my $char = shift(@chars);
1082            
1083             # // - line comment
1084             # remove everything up to and including the end of line
1085 454 100       1781 if ($char eq '//') {
    100          
    50          
    100          
    100          
    100          
    100          
1086             LINE_COMMENT_LOOP:
1087 27         36 while (@chars) {
1088 565         426 my $next = shift(@chars);
1089            
1090             # if character is any of the end of line strings
1091 565 100       1090 if ($newlines{$next})
1092 27         44 { last LINE_COMMENT_LOOP }
1093             }
1094             }
1095            
1096             # /* */ - inline comments
1097             # remove everything until */
1098             elsif ($char eq '/*') {
1099             INLINE_COMMENT_LOOP:
1100 7         35 while (@chars) {
1101 75         59 my $next = shift(@chars);
1102            
1103             # if character is any of the end of line strings
1104 75 100       130 if ($next eq '*/')
1105 6         14 { next CHAR_LOOP }
1106             }
1107            
1108             # if we get this far then the comment was never closed
1109 1         3 return $parser->error(
1110             'unclosed-inline-comment',
1111             'a comment was started with /* but was never closed'
1112             );
1113             }
1114            
1115             # /* */ - inline comments
1116             # remove everything until */
1117             elsif ($char eq '/*') {
1118             INLINE_COMMENT_LOOP:
1119 0         0 while (@chars) {
1120 0         0 my $next = shift(@chars);
1121            
1122             # if character is any of the end of line strings
1123 0 0       0 if ($next eq '*/')
1124 0         0 { last INLINE_COMMENT_LOOP }
1125             }
1126             }
1127            
1128             # white space: ignore
1129             elsif ($char !~ m|\S|) {
1130             }
1131            
1132             # structural characters
1133             elsif ($JSON::Relaxed::structural{$char}) {
1134 189         315 push @tokens, $char;
1135             }
1136            
1137             # quotes
1138             # remove everything until next quote of same type
1139             elsif ($JSON::Relaxed::quotes{$char}) {
1140 38         95 my $str = JSON::Relaxed::Parser::Token::String::Quoted->new($parser, $char, \@chars);
1141 38         79 push @tokens, $str;
1142             }
1143            
1144             # "unknown" object string
1145             elsif ($parser->is_unknown_char($char)) {
1146 2         6 my $unknown = JSON::Relaxed::Parser::Token::Unknown->new($char);
1147 2         5 push @tokens, $unknown;
1148             }
1149            
1150             # else it's an unquoted string
1151             else {
1152 61         124 my $str = JSON::Relaxed::Parser::Token::String::Unquoted->new($parser, $char, \@chars);
1153 61         125 push @tokens, $str;
1154             }
1155             }
1156            
1157             # return tokens
1158 76         182 return @tokens;
1159             }
1160             #
1161             # tokenize
1162             #------------------------------------------------------------------------------
1163              
1164              
1165             #------------------------------------------------------------------------------
1166             # structure
1167             #
1168              
1169             =item structure()
1170              
1171             C<$parser->structure()> organizes the tokens from C>
1172             into a data structure. C<$parser->structure()> returns a single string, single
1173             array reference, a single hash reference, or (if there are errors) undef.
1174              
1175             =cut
1176              
1177             sub structure {
1178 71     71   119 my ($parser, $tokens, %opts) = @_;
1179 71         53 my ($rv, $opener);
1180            
1181             # TESTING
1182             # println subname(class=>1); ##i
1183            
1184             # get opening token
1185 71 100       103 if (defined $opts{'opener'})
1186 9         11 { $opener = $opts{'opener'} }
1187             else
1188 62         70 { $opener = shift(@$tokens) }
1189            
1190             # if no opener that's an error, so we're done
1191 71 100       112 if (! defined $opener)
1192 3         14 { return undef }
1193            
1194             # string
1195 68 100       96 if ($parser->is_string($opener)) {
    100          
    100          
1196 14         20 $rv = $opener->as_perl();
1197             }
1198            
1199             # opening of hash
1200             elsif ($opener eq '{') {
1201 31         70 $rv = JSON::Relaxed::Parser::Structure::Hash->build($parser, $tokens);
1202             }
1203            
1204             # opening of array
1205             elsif ($opener eq '[') {
1206 19         45 $rv = JSON::Relaxed::Parser::Structure::Array->build($parser, $tokens);
1207             }
1208            
1209             # else invalid opening character
1210             else {
1211 4         6 return $parser->error(
1212             'invalid-structure-opening-character',
1213             'expected { or [ but got ' .
1214             $parser->invalid_token($opener) . ' ' .
1215             'instead'
1216             );
1217             }
1218            
1219             # If this is the outer structure, and there are any tokens left, then
1220             # that's a multiple structure document. We don't allow that sort of thing
1221             # around here unless extra_tokens_ok is explicitly set to ok
1222 64 100       118 if ($opts{'top'}) {
1223 55 100       70 if (! $parser->is_error) {
1224 36 100       58 if (@$tokens) {
1225 11 100       19 unless ($parser->extra_tokens_ok()) {
1226 8         13 return $parser->error(
1227             'multiple-structures',
1228             'the string being parsed contains two separate structures, only one is allowed'
1229             );
1230             }
1231             }
1232             }
1233             }
1234            
1235             # return
1236 56         213 return $rv;
1237             }
1238             #
1239             # structure
1240             #------------------------------------------------------------------------------
1241              
1242              
1243             #------------------------------------------------------------------------------
1244             # invalid_token
1245             #
1246             sub invalid_token {
1247 16     16   17 my ($parser, $token) = @_;
1248            
1249             # string
1250 16 100       19 if ($parser->is_string($token)) {
    100          
1251 2         7 return 'string';
1252             }
1253            
1254             # object
1255             elsif (ref $token) {
1256 1         4 return ref($token) . ' object';
1257             }
1258            
1259             # scalar
1260             else {
1261 13         38 return $token;
1262             }
1263             }
1264             #
1265             # invalid_token
1266             #------------------------------------------------------------------------------
1267              
1268              
1269             #------------------------------------------------------------------------------
1270             # closing POD
1271             #
1272              
1273             =back
1274              
1275             =cut
1276              
1277             #
1278             # closing POD
1279             #------------------------------------------------------------------------------
1280              
1281              
1282             #
1283             # JSON::Relaxed::Parser
1284             ###############################################################################
1285              
1286              
1287              
1288             ###############################################################################
1289             # JSON::Relaxed::Parser::Structure::Hash
1290             #
1291             package JSON::Relaxed::Parser::Structure::Hash;
1292 1     1   5 use strict;
  1         1  
  1         342  
1293              
1294             # debugging
1295             # use Debug::ShowStuff ':all';
1296              
1297             #------------------------------------------------------------------------------
1298             # POD
1299             #
1300              
1301             =head2 JSON::Relaxed::Parser::Structure::Hash
1302              
1303             This package parses Relaxed into hash structures. It is a static package, i.e.
1304             it is not instantiated.
1305              
1306             =over 4
1307              
1308             =cut
1309              
1310             #
1311             # POD
1312             #------------------------------------------------------------------------------
1313              
1314              
1315             #------------------------------------------------------------------------------
1316             # build
1317             #
1318              
1319             =item build()
1320              
1321             This static method accepts the array of tokens and works through them building
1322             the hash reference that they represent. When C reaches the closing
1323             curly brace (C<}>) it returns the hash reference.
1324              
1325             =cut
1326              
1327             sub build {
1328 31     31   31 my ($class, $parser, $tokens) = @_;
1329 31         41 my $rv = {};
1330            
1331             # TESTING
1332             # println subname(class=>1); ##i
1333            
1334             # build hash
1335             # work through tokens until closing brace
1336             TOKENLOOP:
1337 31         83 while (@$tokens) {
1338 79         69 my $next = shift(@$tokens);
1339             # what is allowed after opening brace:
1340             # closing brace
1341             # comma
1342             # string
1343            
1344             # if closing brace, return
1345 79 100       184 if ($next eq '}') {
    100          
    100          
1346 16         25 return $rv;
1347             }
1348            
1349             # if comma, do nothing
1350             elsif ($next eq ',') {
1351             }
1352            
1353             # string
1354             # If the token is a string then it is a key. The token after that
1355             # should be a value.
1356             elsif ( $parser->is_string($next) ) {
1357 30         29 my ($key, $value, $t0);
1358 30         33 $t0 = $tokens->[0];
1359            
1360             # set key using string
1361 30         40 $key = $next->as_perl(always_string=>1);
1362            
1363             # if anything follows the string
1364 30 50       65 if (defined $t0) {
1365             # if next token is a colon then it should be followed by a value
1366 30 100       46 if ( $t0 eq ':' ) {
    100          
    50          
1367             # remove the colon
1368 24         23 shift(@$tokens);
1369            
1370             # if at end of token array, exit loop
1371 24 100       43 @$tokens or last TOKENLOOP;
1372            
1373             # get hash value
1374 22         37 $value = $class->get_value($parser, $tokens);
1375            
1376             # if there is a global error, return undef
1377 22 100       35 $parser->is_error() and return undef;
1378             }
1379            
1380             # a comma or closing brace is acceptable after a string
1381             elsif ($t0 eq ',') {
1382             }
1383             elsif ($t0 eq '}') {
1384             }
1385            
1386             # anything else is an error
1387             else {
1388 2         4 return $parser->error(
1389             'unknown-token-after-key',
1390             'expected comma or closing brace after a ' .
1391             'hash key, but got ' .
1392             $parser->invalid_token($t0) . ' ' .
1393             'instead'
1394             );
1395             }
1396             }
1397            
1398             # else nothing followed the string, so break out of token loop
1399             else {
1400 0         0 last TOKENLOOP;
1401             }
1402            
1403             # set key and value in return hash
1404 23         72 $rv->{$key} = $value;
1405             }
1406            
1407             # anything else is an error
1408             else {
1409 4         8 return $parser->error(
1410             'unknown-token-for-hash-key',
1411             'expected string, comma, or closing brace in a ' .
1412             'hash key, but got ' .
1413             $parser->invalid_token($next) . ' ' .
1414             'instead'
1415             );
1416             }
1417             }
1418            
1419             # if we get this far then unclosed brace
1420 6         10 return $parser->error(
1421             'unclosed-hash-brace',
1422             'do not find closing brace for hash'
1423             );
1424             }
1425             #
1426             # build
1427             #------------------------------------------------------------------------------
1428              
1429              
1430             #------------------------------------------------------------------------------
1431             # get_value
1432             #
1433              
1434             =item get_value
1435              
1436             This static method gets the value of a hash element. This method is called
1437             after a hash key is followed by a colon. A colon must be followed by a value.
1438             It may not be followed by the end of the tokens, a comma, or a closing brace.
1439              
1440             =cut
1441              
1442             sub get_value {
1443 22     22   25 my ($class, $parser, $tokens) = @_;
1444 22         18 my ($next);
1445            
1446             # TESTING
1447             # println subname(); ##i
1448            
1449             # get next token
1450 22         19 $next = shift(@$tokens);
1451            
1452             # next token must be string, array, or hash
1453             # string
1454 22 100       31 if ($parser->is_string($next)) {
    100          
1455 12         22 return $next->as_perl();
1456             }
1457            
1458             # token opens a hash
1459             elsif ($parser->is_list_opener($next)) {
1460 8         19 return $parser->structure($tokens, opener=>$next);
1461             }
1462            
1463             # at this point it's an illegal token
1464 2         4 return $parser->error(
1465             'unexpected-token-after-colon',
1466             'expected a value after a colon in a hash, got ' .
1467             $parser->invalid_token($next) . ' ' .
1468             'instead'
1469             );
1470             }
1471             #
1472             # get_value
1473             #------------------------------------------------------------------------------
1474              
1475              
1476             #------------------------------------------------------------------------------
1477             # closing POD
1478             #
1479              
1480             =back
1481              
1482             =cut
1483              
1484             #
1485             # closing POD
1486             #------------------------------------------------------------------------------
1487              
1488              
1489             #
1490             # JSON::Relaxed::Parser::Structure::Hash
1491             ###############################################################################
1492              
1493              
1494             ###############################################################################
1495             # JSON::Relaxed::Parser::Structure::Array
1496             #
1497             package JSON::Relaxed::Parser::Structure::Array;
1498 1     1   5 use strict;
  1         1  
  1         319  
1499              
1500             # debugging
1501             # use Debug::ShowStuff ':all';
1502              
1503              
1504             #------------------------------------------------------------------------------
1505             # POD
1506             #
1507              
1508             =head2 JSON::Relaxed::Parser::Structure::Array
1509              
1510             This package parses Relaxed into array structures. It is a static package, i.e.
1511             it is not instantiated.
1512              
1513             =over 4
1514              
1515             =cut
1516              
1517             #
1518             # POD
1519             #------------------------------------------------------------------------------
1520              
1521              
1522              
1523             #------------------------------------------------------------------------------
1524             # build
1525             #
1526              
1527             =item build()
1528              
1529             This static method accepts the array of tokens and works through them building
1530             the array reference that they represent. When C reaches the closing
1531             square brace (C<]>) it returns the array reference.
1532              
1533             =cut
1534              
1535             sub build {
1536 19     19   15 my ($class, $parser, $tokens) = @_;
1537 19         22 my $rv = [];
1538            
1539             # TESTING
1540             # println subname(class=>1); ##i
1541            
1542             # build array
1543             # work through tokens until closing brace
1544 19         29 while (@$tokens) {
1545 54         52 my $next = shift(@$tokens);
1546            
1547             # closing brace: we're done building this array
1548 54 100       94 if ($next eq ']') {
    100          
    100          
    100          
1549 14         27 return $rv;
1550             }
1551            
1552             # opening of hash or array
1553             elsif ($parser->is_list_opener($next)) {
1554 1         4 my $object = $parser->structure($tokens, opener=>$next);
1555 1 50       4 defined($object) or return undef;
1556 1         4 push @$rv, $object;
1557             }
1558            
1559             # comma: if we get to a comma at this point, do nothing with it
1560             elsif ($next eq ',') {
1561             }
1562            
1563             # if string, add it to the array
1564             elsif ($parser->is_string($next)) {
1565             # add the string to the array
1566 21         34 push @$rv, $next->as_perl();
1567            
1568             # check following token, which must be either a comma or
1569             # the closing brace
1570 21 100       38 if (@$tokens) {
1571 20   50     34 my $n2 = $tokens->[0] || '';
1572            
1573             # the next element must be a comma or the closing brace,
1574             # anything else is an error
1575 20 100 100     96 unless ( ($n2 eq ',') || ($n2 eq ']') ) {
1576 2         5 return missing_comma($parser, $n2);
1577             }
1578             }
1579             }
1580            
1581             # else unkown object or character, so throw error
1582             else {
1583 2         5 return invalid_array_token($parser, $next);
1584             }
1585             }
1586            
1587             # if we get this far then unclosed brace
1588 1         2 return $parser->error(
1589             'unclosed-array-brace',
1590             'do not find closing brace for array'
1591             );
1592             }
1593             #
1594             # build
1595             #------------------------------------------------------------------------------
1596              
1597              
1598             #------------------------------------------------------------------------------
1599             # missing_comma
1600             #
1601              
1602             =item missing_comma()
1603              
1604             This static method build the C error
1605             message.
1606              
1607             =cut
1608              
1609             sub missing_comma {
1610 2     2   2 my ($parser, $token) = @_;
1611            
1612             # initialize error message
1613 2         4 return $parser->error(
1614             'missing-comma-between-array-elements',
1615             'expected comma or closing array brace, got ' .
1616             $parser->invalid_token($token) . ' ' .
1617             'instead'
1618             );
1619             }
1620             #
1621             # missing_comma
1622             #------------------------------------------------------------------------------
1623              
1624              
1625             #------------------------------------------------------------------------------
1626             # invalid_array_token
1627             #
1628              
1629             =item invalid_array_token)
1630              
1631             This static method build the C error message.
1632              
1633             =cut
1634              
1635             sub invalid_array_token {
1636 2     2   2 my ($parser, $token) = @_;
1637            
1638             # initialize error message
1639 2         4 return $parser->error(
1640             'unknown-array-token',
1641             'unexpected item in array: got ' .
1642             $parser->invalid_token($token)
1643             );
1644             }
1645             #
1646             # invalid_array_token
1647             #------------------------------------------------------------------------------
1648              
1649              
1650             #------------------------------------------------------------------------------
1651             # closing POD
1652             #
1653              
1654             =back
1655              
1656             =cut
1657              
1658             #
1659             # closing POD
1660             #------------------------------------------------------------------------------
1661              
1662              
1663              
1664             #
1665             # JSON::Relaxed::Parser::Structure::Array
1666             ###############################################################################
1667              
1668              
1669              
1670             ###############################################################################
1671             # JSON::Relaxed::Parser::Token::String::Quoted
1672             #
1673             package JSON::Relaxed::Parser::Token::String;
1674 1     1   5 use strict;
  1         1  
  1         36  
1675              
1676             # debugging
1677             # use Debug::ShowStuff ':all';
1678              
1679              
1680             #------------------------------------------------------------------------------
1681             # POD
1682             #
1683              
1684             =head2 JSON::Relaxed::Parser::Token::String
1685              
1686             Base class . Nothing actually happens in this package, it's just a base class
1687             for JSON::Relaxed::Parser::Token::String::Quoted and
1688             JSON::Relaxed::Parser::Token::String::Unquoted.
1689              
1690             =cut
1691              
1692             #
1693             # POD
1694             #------------------------------------------------------------------------------
1695              
1696              
1697             #
1698             # JSON::Relaxed::Parser::Token::String
1699             ###############################################################################
1700              
1701              
1702              
1703             ###############################################################################
1704             # JSON::Relaxed::Parser::Token::String::Quoted
1705             #
1706             package JSON::Relaxed::Parser::Token::String::Quoted;
1707 1     1   4 use strict;
  1         1  
  1         20  
1708 1     1   4 use base 'JSON::Relaxed::Parser::Token::String';
  1         1  
  1         485  
1709              
1710             # debugging
1711             # use Debug::ShowStuff ':all';
1712              
1713              
1714             #------------------------------------------------------------------------------
1715             # POD
1716             #
1717              
1718             =head2 JSON::Relaxed::Parser::Token::String::Quoted
1719              
1720             A C object represents a string
1721             in the document that is delimited with single or double quotes. In the
1722             following example, I and I would be represented by C
1723             objects by I would not.
1724              
1725             [
1726             "Larry",
1727             'Curly',
1728             Moe
1729             ]
1730              
1731             C objects are created by C<$parser-Etokenize()> when it works
1732             through the array of characters in the document.
1733              
1734             =over 4
1735              
1736             =cut
1737              
1738             #
1739             # POD
1740             #------------------------------------------------------------------------------
1741              
1742              
1743              
1744             #------------------------------------------------------------------------------
1745             # new
1746             #
1747              
1748             =item * C
1749              
1750             C instantiates a C object
1751             and slurps in all the characters in the characters array until it gets to the
1752             closing quote. Then it returns the new C object.
1753              
1754             A C object has the following two properties:
1755              
1756             C: the string that is inside the quotes. If the string contained any
1757             escape characters then the escapes are processed and the unescaped characters
1758             are in C. So, for example, C<\n> would become an actual newline.
1759              
1760             C: the delimiting quote, i.e. either a single quote or a double quote.
1761              
1762              
1763             =cut
1764              
1765             sub new {
1766 38     38   46 my ($class, $parser, $quote, $chars) = @_;
1767 38         96 my $str = bless({}, $class);
1768            
1769             # TESTING
1770             # println subname(class=>1); ##i
1771            
1772             # initialize hash
1773 38         60 $str->{'quote'} = $quote;
1774 38         48 $str->{'raw'} = '';
1775            
1776             # loop through remaining characters until we find another quote
1777             CHAR_LOOP:
1778 38         100 while (@$chars) {
1779 150         129 my $next = shift(@$chars);
1780            
1781             # if this is the matching quote, we're done
1782 150 100       235 if ($next eq $str->{'quote'})
1783 36         55 { return $str }
1784            
1785             # if leading slash, check if it's a special escape character
1786 114 100       177 if ($next =~ s|^\\(.)|$1|s) {
1787 9 100       17 if ($JSON::Relaxed::esc{$next})
1788 6         6 { $next = $JSON::Relaxed::esc{$next} }
1789             }
1790            
1791             # add to raw
1792 114         189 $str->{'raw'} .= $next;
1793             }
1794            
1795             # if we get this far then we never found the closing quote
1796 2         4 return $parser->error(
1797             'unclosed-quote',
1798             'string does not have closing quote before end of file'
1799             );
1800             }
1801             #
1802             # new
1803             #------------------------------------------------------------------------------
1804              
1805              
1806             #------------------------------------------------------------------------------
1807             # as_perl
1808             #
1809              
1810             =item * C
1811              
1812             C returns the string that was in quotes (without the quotes).
1813              
1814             =cut
1815              
1816             sub as_perl {
1817 20     20   18 my ($str) = @_;
1818 20         35 return $str->{'raw'};
1819             }
1820             #
1821             # as_perl
1822             #------------------------------------------------------------------------------
1823              
1824              
1825             #------------------------------------------------------------------------------
1826             # close POD item list
1827             #
1828              
1829             =back
1830              
1831             =cut
1832              
1833             #
1834             # close POD item list
1835             #------------------------------------------------------------------------------
1836              
1837              
1838             #
1839             # JSON::Relaxed::Parser::Token::String::Quoted
1840             ###############################################################################
1841              
1842              
1843             ###############################################################################
1844             # JSON::Relaxed::Parser::Token::String::Unquoted
1845             #
1846             package JSON::Relaxed::Parser::Token::String::Unquoted;
1847 1     1   6 use strict;
  1         2  
  1         25  
1848 1     1   4 use base 'JSON::Relaxed::Parser::Token::String';
  1         1  
  1         445  
1849              
1850             # debugging
1851             # use Debug::ShowStuff ':all';
1852              
1853              
1854              
1855              
1856             #------------------------------------------------------------------------------
1857             # POD
1858             #
1859              
1860             =head2 JSON::Relaxed::Parser::Token::String::Unquoted
1861              
1862             A C object represents a string
1863             in the document that was not delimited quotes. In the following example,
1864             I would be represented by an C object, but I and I
1865             would not.
1866              
1867             [
1868             "Larry",
1869             'Curly',
1870             Moe
1871             ]
1872              
1873             C objects are created by C<$parser-Etokenize()> when it works
1874             through the array of characters in the document.
1875              
1876             An C object has one property, C, which is the string. Escaped
1877             characters are resolved in C.
1878              
1879             =over 4
1880              
1881             =cut
1882              
1883             #
1884             # POD
1885             #------------------------------------------------------------------------------
1886              
1887              
1888              
1889             #------------------------------------------------------------------------------
1890             # new
1891             #
1892              
1893             =item * C
1894              
1895             C instantiates a C
1896             object and slurps in all the characters in the characters array until it gets
1897             to a space character, a comment, or one of the structural characters such as
1898             C<{> or C<:>.
1899              
1900             =cut
1901              
1902             sub new {
1903 61     61   60 my ($class, $parser, $char, $chars) = @_;
1904 61         142 my $str = bless({}, $class);
1905            
1906             # TESTING
1907             # println subname(class=>1); ##i
1908            
1909             # initialize hash
1910 61         104 $str->{'raw'} = $char;
1911            
1912             # loop while not space or structural characters
1913             TOKEN_LOOP:
1914 61         91 while (@$chars) {
1915             # if structural character, we're done
1916 269 100       389 if ($JSON::Relaxed::structural{$chars->[0]})
1917 45         50 { last TOKEN_LOOP }
1918            
1919             # if space character, we're done
1920 224 100       477 if ($chars->[0] !~ m|\S|s)
1921 9         13 { last TOKEN_LOOP }
1922            
1923             # if opening of a comment, we're done
1924 215 100       282 if ($parser->is_comment_opener($chars->[0]))
1925 2         3 { last TOKEN_LOOP }
1926            
1927             # add to raw string
1928 213         361 $str->{'raw'} .= shift(@$chars);
1929             }
1930            
1931             # return
1932 61         70 return $str;
1933             }
1934             #
1935             # new
1936             #------------------------------------------------------------------------------
1937              
1938              
1939             #------------------------------------------------------------------------------
1940             # as_perl
1941             #
1942              
1943             =item * C
1944              
1945             C returns the unquoted string or a boolean value, depending on how
1946             it is called.
1947              
1948             If the string is a boolean value, i.e. I, I, then the C
1949             return 1 (for true), 0 (for false) or undef (for null), B the
1950             C option is sent, in which case the string itself is returned.
1951             If the string does not represent a boolean value then it is returned as-is.
1952              
1953             C<$parser-Estructure()> sends the C when the token is a key
1954             in a hash. The following example should clarify how C is used:
1955              
1956             {
1957             // key: the literal string "larry"
1958             // value: 1
1959             larry : true,
1960            
1961             // key: the literal string "true"
1962             // value: 'x'
1963             true : 'x',
1964            
1965             // key: the literal string "null"
1966             // value: 'y'
1967             null : 'y',
1968            
1969             // key: the literal string "z"
1970             // value: undef
1971             z : null,
1972             }
1973              
1974             =cut
1975              
1976             sub as_perl {
1977 57     57   62 my ($str, %opts) = @_;
1978 57         59 my $rv = $str->{'raw'};
1979            
1980             # if string is one of the unquoted boolean values
1981             # unless options indicate to always return the value as a string, check it
1982             # the value is one of the boolean string
1983 57 100       79 unless ($opts{'always_string'}) {
1984 34 100       68 if (exists $JSON::Relaxed::boolean{lc $rv}) {
1985 13         14 $rv = $JSON::Relaxed::boolean{lc $rv};
1986             }
1987             }
1988            
1989             # return
1990 57         101 return $rv;
1991             }
1992             #
1993             # as_perl
1994             #------------------------------------------------------------------------------
1995              
1996              
1997             #------------------------------------------------------------------------------
1998             # close POD item list
1999             #
2000              
2001             =back
2002              
2003             =cut
2004              
2005             #
2006             # close POD item list
2007             #------------------------------------------------------------------------------
2008              
2009              
2010             #
2011             # JSON::Relaxed::Parser::Token::String::Unquoted
2012             ###############################################################################
2013              
2014              
2015             ###############################################################################
2016             # JSON::Relaxed::Parser::Token::Unknown
2017             #
2018             package JSON::Relaxed::Parser::Token::Unknown;
2019 1     1   8 use strict;
  1         1  
  1         78  
2020              
2021             #------------------------------------------------------------------------------
2022             # POD
2023             #
2024              
2025             =head2 JSON::Relaxed::Parser::Token::Unknown
2026              
2027             This class is just used for development of JSON::Relaxed. It has no use in
2028             production. This class allows testing for when a token is an unknown object.
2029              
2030             To implement this class, add the 'unknown' option to JSON::Relaxed->new(). The
2031             value of the option should be the character that creates an unknown object.
2032             For example, the following option sets the tilde (~) as an unknown object.
2033              
2034             my $parser = JSON::Relaxed::Parser->new(unknown=>'~');
2035              
2036             The "unknown" character must not be inside quotes or inside an unquoted string.
2037              
2038             =cut
2039              
2040             #
2041             # POD
2042             #------------------------------------------------------------------------------
2043              
2044              
2045              
2046              
2047             #------------------------------------------------------------------------------
2048             # new
2049             #
2050             sub new {
2051 2     2   3 my ($class, $char) = @_;
2052 2         5 my $unknown = bless({}, $class);
2053 2         8 $unknown->{'raw'} = $char;
2054 2         4 return $unknown;
2055             }
2056             #
2057             # new
2058             #------------------------------------------------------------------------------
2059              
2060             #
2061             # JSON::Relaxed::Parser::Token::Unknown
2062             ###############################################################################
2063              
2064              
2065             # return true
2066             1;
2067              
2068              
2069             __END__