]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/JSONDump.pm
92d08379e9537d7c4b83c78528c7391a19b8b87d
1 package CGI
::Ex
::JSONDump
;
5 CGI::Ex::JSONDump - Comprehensive data to JSON dump.
9 ###----------------------------------------------------------------###
10 # Copyright 2006 - 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 =~ /^ -? (?: \d{0,13} \. \d* [1-9] | \d{1,13}) $/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;
122 ### add nice newlines (unless pretty is off)
123 if ($self->{'str_nl'} && length($str) > 80) {
124 if ($self->{'single_quote'}) {
125 $str =~ s/\'\s*\+\'$// if $str =~ s/\n/\\n\'$self->{str_nl}${prefix}+\'/g;
127 $str =~ s/\"\s*\+\"$// if $str =~ s/\n/\\n\"$self->{str_nl}${prefix}+\"/g;
133 return $quote . $str . $quote;
142 use CGI::Ex::JSONDump;
144 my $js = JSONDump(\%complex_data, {pretty => 0});
148 my $js = CGI::Ex::JSONDump->new({pretty => 0})->dump(\%complex_data);
152 CGI::Ex::JSONDump is a very lightweight and fast perl data structure to javascript object
153 notation dumper. This is useful for AJAX style methods, or dynamic page creation that
154 needs to embed perl data in the presented page.
156 CGI::Ex::JSONDump has roughly the same output as JSON::objToJson, but with the following
159 - CGI::Ex::JSONDump is much much lighter and smaller (a whopping 134 lines).
160 - It dumps Javascript in more browser friendly format (handling of </script> tags).
161 - It removes unknown key types by default instead of dying.
162 - It allows for a general handler to handle unknown key types.
163 - It allows for fine grain control of all whitespace.
164 - It allows for skipping keys by name or by regex.
165 - It dumps both data structures and scalar types.
173 Create a CGI::Ex::JSONDump object. Takes arguments hashref as single argument.
175 my $obj = CGI::Ex::JSONDump->new(\%args);
177 See the arguments section for a list of the possible arguments.
181 Takes a perl data structure or scalar string or number and returns a string
182 containing the javascript representation of that string (in Javascript object
187 Takes a scalar string or number and returns a javascript escaped string that will
188 embed properly in javascript. All numbers and strings of nested data structures
189 are passed through this method.
199 A wrapper around the new and dump methods. Takes a structure to dump
200 and optional args to pass to the new routine.
202 JSONDump($data, $args);
206 CGI::Ex::JSONDump->new($args)->dump($data);
212 The following arguments may be passed to the new method or as the second
213 argument to the JSONDump function.
219 0 or 1. Default 0 (false). If true then dumped structures will
220 include whitespace to make them more readable.
222 JSONDump({a => [1, 2]}, {pretty => 0});
223 JSONDump({a => [1, 2]}, {pretty => 1});
237 0 or 1. Default 0 (false). If true then escaped values will be quoted
238 with single quotes. Otherwise values are quoted with double quotes.
240 JSONDump("a", {single_quote => 0});
241 JSONDump("a", {single_quote => 1});
250 0 or 1. Default 1 (true)
252 If true, then key/value pairs of hashrefs will be output in sorted order.
256 0 or 1. Default 0 (false). If true, then any code refs will be executed
257 and the returned string will be dumped.
259 If false, then keys of hashrefs that contain coderefs will be skipped (unless
260 the handle_unknown_types property is set). Coderefs
261 that are in arrayrefs will show up as "CODE(0x814c648)" unless
262 the handle_unknown_types property is set.
264 =item handle_unknown_types
266 Default undef. If true it should contain a coderef that will be called if any
267 unknown types are encountered. The only default known types are scalar string
268 or number values, unblessed HASH refs and ARRAY refs (and CODE refs if the
269 play_coderefs property is set). All other types will be passed to the
270 handle_unknown_types method call.
272 JSONDump({a => bless({}, 'A'), b => 1}, {
273 handle_unknown_types => sub {
274 my $self = shift; # a JSON object
275 my $data = shift; # the object to dump
277 return $self->js_escape("Ref=" . ref $data);
286 If the handle_unknown_types method is not set then keys hashrefs that have values
287 with unknown types will not be included in the javascript output.
289 JSONDump({a => bless({}, 'A'), b => 1}, {pretty => 0});
297 Should contain an arrayref of keys or a hashref whose keys are the
298 keys to skip. Default is unset. Any keys of hashrefs (including
299 nested hashrefs) that are in the skip_keys item will not be included
300 in the javascript output.
302 JSONDump({a => 1, b => 1}, {skip_keys => ['a'], pretty => 0});
310 Similar to skip_keys but should contain a regex. Any keys of hashrefs
311 (including nested hashrefs) that match the skip_keys_qr regex will not
312 be included in the javascript output.
314 JSONDump({a => 1, _b => 1}, {skip_keys_qr => qr/^_/, pretty => 0});
322 The level to indent each nested data structure level if pretty is true. Default is " ".
326 The whitespace to add after each hashref key/value pair if pretty is true. Default is "\n".
330 The separator and whitespace to put between each hashref key/value pair if pretty is true. Default is " : ".
334 The whitespace to add after each arrayref entry if pretty is true. Default is "\n".
338 The whitespace to add in between newline separated strings if pretty is true or the output line is
339 greater than 80 characters. Default is "\n".
341 JSONDump("This is a long string\n"
342 ."with plenty of embedded newlines\n"
343 ."and is greater than 80 characters.\n", {pretty => 1, str_nl => "\n"});
347 "This is a long string\n"
348 +"with plenty of embedded newlines\n"
349 +"and is greater than 80 characters.\n"
351 If the string is less than 80 characters, or if str_nl is set to "", then the escaped
352 string will be contained on a single line.
358 Paul Seamons <paul at seamons dot com>
This page took 0.053788 seconds and 4 git commands to generate.