]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/JSONDump.pm
1 package CGI
::Ex
::JSONDump
;
5 CGI::Ex::JSONDump - Comprehensive data to JSON dump.
9 ###----------------------------------------------------------------###
10 # Copyright 2007 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
17 use base
qw(Exporter);
22 @EXPORT = qw(JSONDump);
28 my ($data, $args) = @_;
29 return __PACKAGE__-
>new($args)->dump($data);
32 ###----------------------------------------------------------------###
35 my $class = shift || __PACKAGE__
;
36 my $args = shift || {};
37 my $self = bless {%$args}, $class;
39 $self->{'skip_keys'} = {map {$_ => 1} ref($self->{'skip_keys'}) eq 'ARRAY' ? @{ $self->{'skip_keys'} } : $self->{'skip_keys'}}
40 if $self->{'skip_keys'} && ref $self->{'skip_keys'} ne 'HASH';
42 $self->{'sort_keys'} = 1 if ! exists $self->{'sort_keys'};
48 my ($self, $data, $args) = @_;
49 $self = $self->new($args) if ! ref $self;
51 local $self->{'indent'} = ! $self->{'pretty'} ? '' : defined($self->{'indent'}) ? $self->{'indent'} : ' ';
52 local $self->{'hash_sep'} = ! $self->{'pretty'} ? ':' : defined($self->{'hash_sep'}) ? $self->{'hash_sep'} : ' : ';
53 local $self->{'hash_nl'} = ! $self->{'pretty'} ? '' : defined($self->{'hash_nl'}) ? $self->{'hash_nl'} : "\n";
54 local $self->{'array_nl'} = ! $self->{'pretty'} ? '' : defined($self->{'array_nl'}) ? $self->{'array_nl'} : "\n";
55 local $self->{'str_nl'} = ! $self->{'pretty'} ? '' : defined($self->{'str_nl'}) ? $self->{'str_nl'} : "\n";
57 return $self->_dump($data, '');
61 my ($self, $data, $prefix) = @_;
64 if ($ref eq 'CODE' && $self->{'play_coderefs'}) {
70 my @keys = (grep { my $r = ref $data->{$_};
71 ! $r || $self->{'handle_unknown_types'} || $r eq 'HASH' || $r eq 'ARRAY' || ($r eq 'CODE' && $self->{'play_coderefs'})}
72 grep { ! $self->{'skip_keys'} || ! $self->{'skip_keys'}->{$_} }
73 grep { ! $self->{'skip_keys_qr'} || $_ !~ $self->{'skip_keys_qr'} }
74 ($self->{'sort_keys'} ? (sort keys %$data) : (keys %$data)));
75 return "{}" if ! @keys;
76 return "{$self->{hash_nl}${prefix}$self->{indent}"
77 . join(",$self->{hash_nl}${prefix}$self->{indent}",
78 map { $self->js_escape($_, "${prefix}$self->{indent}")
80 . $self->_dump($data->{$_}, "${prefix}$self->{indent}") }
82 . "$self->{hash_nl}${prefix}}";
84 } elsif ($ref eq 'ARRAY') {
85 return "[]" if ! @$data;
86 return "[$self->{array_nl}${prefix}$self->{indent}"
87 . join(",$self->{array_nl}${prefix}$self->{indent}",
88 map { $self->_dump($_, "${prefix}$self->{indent}") }
90 . "$self->{array_nl}${prefix}]";
93 return $self->{'handle_unknown_types'}->($self, $data, $ref) if ref($self->{'handle_unknown_types'}) eq 'CODE';
94 return '"'.$data.'"'; ### don't do anything
97 return $self->js_escape($data, "${prefix}$self->{indent}");
102 my ($self, $str, $prefix) = @_;
103 return 'null' if ! defined $str;
105 ### allow things that look like numbers to show up as numbers (and those that aren't quite to not)
106 return $str if $str =~ /^ -? (?: [1-9][0-9]{0,12} | 0) (?: \. \d* [1-9])? $/x;
108 my $quote = $self->{'single_quote'} ? "'" : '"';
113 $self->{'single_quote'} ? $str =~ s/\'/\\\'/g : $str =~ s/\"/\\\"/g;
115 ### allow for really odd chars
116 $str =~ s/([\x00-\x07\x0b\x0e-\x1f])/'\\u00' . unpack('H2',$1)/eg; # from JSON::Converter
117 utf8
::decode
($str) if $self->{'utf8'} && &utf8
::decode
;
119 ### escape <html> and </html> tags in the text
120 $str =~ s{(</? (?: htm | scrip | !-) | --(?=>) )}{$1$quote+$quote}gx
121 if ! $self->{'no_tag_splitting'};
123 ### add nice newlines (unless pretty is off)
124 if ($self->{'str_nl'} && length($str) > 80) {
125 if ($self->{'single_quote'}) {
126 $str =~ s/\'\s*\+\'$// if $str =~ s/\n/\\n\'$self->{str_nl}${prefix}+\'/g;
128 $str =~ s/\"\s*\+\"$// if $str =~ s/\n/\\n\"$self->{str_nl}${prefix}+\"/g;
134 return $quote . $str . $quote;
143 use CGI::Ex::JSONDump;
145 my $js = JSONDump(\%complex_data, {pretty => 0});
149 my $js = CGI::Ex::JSONDump->new({pretty => 0})->dump(\%complex_data);
153 CGI::Ex::JSONDump is a very lightweight and fast perl data structure to javascript object
154 notation dumper. This is useful for AJAX style methods, or dynamic page creation that
155 needs to embed perl data in the presented page.
157 CGI::Ex::JSONDump has roughly the same output as JSON::objToJson, but with the following
160 - CGI::Ex::JSONDump is much much lighter and smaller (a whopping 134 lines).
161 - It dumps Javascript in more browser friendly format (handling of </script> tags).
162 - It removes unknown key types by default instead of dying.
163 - It allows for a general handler to handle unknown key types.
164 - It allows for fine grain control of all whitespace.
165 - It allows for skipping keys by name or by regex.
166 - It dumps both data structures and scalar types.
174 Create a CGI::Ex::JSONDump object. Takes arguments hashref as single argument.
176 my $obj = CGI::Ex::JSONDump->new(\%args);
178 See the arguments section for a list of the possible arguments.
182 Takes a perl data structure or scalar string or number and returns a string
183 containing the javascript representation of that string (in Javascript object
188 Takes a scalar string or number and returns a javascript escaped string that will
189 embed properly in javascript. All numbers and strings of nested data structures
190 are passed through this method.
200 A wrapper around the new and dump methods. Takes a structure to dump
201 and optional args to pass to the new routine.
203 JSONDump($data, $args);
207 CGI::Ex::JSONDump->new($args)->dump($data);
213 The following arguments may be passed to the new method or as the second
214 argument to the JSONDump function.
220 0 or 1. Default 0 (false). If true then dumped structures will
221 include whitespace to make them more readable.
223 JSONDump({a => [1, 2]}, {pretty => 0});
224 JSONDump({a => [1, 2]}, {pretty => 1});
238 0 or 1. Default 0 (false). If true then escaped values will be quoted
239 with single quotes. Otherwise values are quoted with double quotes.
241 JSONDump("a", {single_quote => 0});
242 JSONDump("a", {single_quote => 1});
251 0 or 1. Default 1 (true)
253 If true, then key/value pairs of hashrefs will be output in sorted order.
257 0 or 1. Default 0 (false). If true, then any code refs will be executed
258 and the returned string will be dumped.
260 If false, then keys of hashrefs that contain coderefs will be skipped (unless
261 the handle_unknown_types property is set). Coderefs
262 that are in arrayrefs will show up as "CODE(0x814c648)" unless
263 the handle_unknown_types property is set.
265 =item handle_unknown_types
267 Default undef. If true it should contain a coderef that will be called if any
268 unknown types are encountered. The only default known types are scalar string
269 or number values, unblessed HASH refs and ARRAY refs (and CODE refs if the
270 play_coderefs property is set). All other types will be passed to the
271 handle_unknown_types method call.
273 JSONDump({a => bless({}, 'A'), b => 1}, {
274 handle_unknown_types => sub {
275 my $self = shift; # a JSON object
276 my $data = shift; # the object to dump
278 return $self->js_escape("Ref=" . ref $data);
287 If the handle_unknown_types method is not set then keys hashrefs that have values
288 with unknown types will not be included in the javascript output.
290 JSONDump({a => bless({}, 'A'), b => 1}, {pretty => 0});
298 Should contain an arrayref of keys or a hashref whose keys are the
299 keys to skip. Default is unset. Any keys of hashrefs (including
300 nested hashrefs) that are listed in the skip_keys item will not be included
301 in the javascript output.
303 JSONDump({a => 1, b => 1}, {skip_keys => ['a'], pretty => 0});
311 Similar to skip_keys but should contain a regex. Any keys of hashrefs
312 (including nested hashrefs) that match the skip_keys_qr regex will not
313 be included in the javascript output.
315 JSONDump({a => 1, _b => 1}, {skip_keys_qr => qr/^_/, pretty => 0});
323 The level to indent each nested data structure level if pretty is true. Default is " " (two spaces).
327 The whitespace to add after each hashref key/value pair if pretty is true. Default is "\n".
331 The separator and whitespace to put between each hashref key/value pair if pretty is true. Default is " : ".
335 The whitespace to add after each arrayref entry if pretty is true. Default is "\n".
339 The whitespace to add in between newline separated strings if pretty is true or the output line is
340 greater than 80 characters. Default is "\n" (if pretty is true).
342 JSONDump("This is a long string\n"
343 ."with plenty of embedded newlines\n"
344 ."and is greater than 80 characters.\n", {pretty => 1});
348 "This is a long string\n"
349 +"with plenty of embedded newlines\n"
350 +"and is greater than 80 characters.\n"
352 JSONDump("This is a long string\n"
353 ."with plenty of embedded newlines\n"
354 ."and is greater than 80 characters.\n", {pretty => 1, str_nl => ""});
358 "This is a long string\nwith plenty of embedded newlines\nand is greater than 80 characters.\n"
360 If the string is less than 80 characters, or if str_nl is set to "", then the escaped
361 string will be contained on a single line. Setting pretty to 0 effectively sets str_nl equal to "".
363 =item no_tag_splitting
365 Default off. If JSON is embedded in an HTML document and the JSON contains C<< <html> >>,
366 C<< </html> >>, C<< <script> >>, C<< </script> >>, C<< <!-- >>, or , C<< --> >> tags, they are
367 split apart with a quote, a +, and a quote. This allows the embedded tags to not affect
368 the currently playing JavaScript.
370 However, if the JSON that is output is intended for deserialization by another non-javascript-engine
371 JSON parser, this splitting behavior may cause errors when the JSON is imported. To avoid the splitting
372 behavior in these cases you can use the no_tag_splitting flag to turn off the behavior.
374 JSONDump("<html><!-- comment --><script></script></html>");
378 "<htm"+"l><!-"+"- comment --"+"><scrip"+"t></scrip"+"t></htm"+"l>"
382 JSONDump("<html><!-- comment --><script></script></html>", {no_tag_splitting => 1});
386 "<html><!-- comment --><script></script></html>"
392 This module may distributed under the same terms as Perl itself.
396 Paul Seamons <perl at seamons dot com>
This page took 0.057866 seconds and 4 git commands to generate.