package CGI::Ex::JSONDump; =head1 NAME CGI::Ex::JSONDump - Comprehensive data to JSON dump. =cut ###----------------------------------------------------------------### # Copyright 2007 - Paul Seamons # # Distributed under the Perl Artistic License without warranty # ###----------------------------------------------------------------### use vars qw($VERSION @EXPORT @EXPORT_OK); use strict; use base qw(Exporter); BEGIN { $VERSION = '2.07'; @EXPORT = qw(JSONDump); @EXPORT_OK = @EXPORT; }; sub JSONDump { my ($data, $args) = @_; return __PACKAGE__->new($args)->dump($data); } ###----------------------------------------------------------------### sub new { my $class = shift || __PACKAGE__; my $args = shift || {}; my $self = bless {%$args}, $class; $self->{'skip_keys'} = {map {$_ => 1} ref($self->{'skip_keys'}) eq 'ARRAY' ? @{ $self->{'skip_keys'} } : $self->{'skip_keys'}} if $self->{'skip_keys'} && ref $self->{'skip_keys'} ne 'HASH'; $self->{'sort_keys'} = 1 if ! exists $self->{'sort_keys'}; return $self; } sub dump { my ($self, $data, $args) = @_; $self = $self->new($args) if ! ref $self; local $self->{'indent'} = ! $self->{'pretty'} ? '' : defined($self->{'indent'}) ? $self->{'indent'} : ' '; local $self->{'hash_sep'} = ! $self->{'pretty'} ? ':' : defined($self->{'hash_sep'}) ? $self->{'hash_sep'} : ' : '; local $self->{'hash_nl'} = ! $self->{'pretty'} ? '' : defined($self->{'hash_nl'}) ? $self->{'hash_nl'} : "\n"; local $self->{'array_nl'} = ! $self->{'pretty'} ? '' : defined($self->{'array_nl'}) ? $self->{'array_nl'} : "\n"; local $self->{'str_nl'} = ! $self->{'pretty'} ? '' : defined($self->{'str_nl'}) ? $self->{'str_nl'} : "\n"; return $self->_dump($data, ''); } sub _dump { my ($self, $data, $prefix) = @_; my $ref = ref $data; if ($ref eq 'CODE' && $self->{'play_coderefs'}) { $data = $data->(); $ref = ref $data; } if ($ref eq 'HASH') { my @keys = (grep { my $r = ref $data->{$_}; ! $r || $self->{'handle_unknown_types'} || $r eq 'HASH' || $r eq 'ARRAY' || ($r eq 'CODE' && $self->{'play_coderefs'})} grep { ! $self->{'skip_keys'} || ! $self->{'skip_keys'}->{$_} } grep { ! $self->{'skip_keys_qr'} || $_ !~ $self->{'skip_keys_qr'} } ($self->{'sort_keys'} ? (sort keys %$data) : (keys %$data))); return "{}" if ! @keys; return "{$self->{hash_nl}${prefix}$self->{indent}" . join(",$self->{hash_nl}${prefix}$self->{indent}", map { $self->js_escape($_, "${prefix}$self->{indent}") . $self->{'hash_sep'} . $self->_dump($data->{$_}, "${prefix}$self->{indent}") } @keys) . "$self->{hash_nl}${prefix}}"; } elsif ($ref eq 'ARRAY') { return "[]" if ! @$data; return "[$self->{array_nl}${prefix}$self->{indent}" . join(",$self->{array_nl}${prefix}$self->{indent}", map { $self->_dump($_, "${prefix}$self->{indent}") } @$data) . "$self->{array_nl}${prefix}]"; } elsif ($ref) { return $self->{'handle_unknown_types'}->($self, $data, $ref) if ref($self->{'handle_unknown_types'}) eq 'CODE'; return '"'.$data.'"'; ### don't do anything } else { return $self->js_escape($data, "${prefix}$self->{indent}"); } } sub js_escape { my ($self, $str, $prefix) = @_; return 'null' if ! defined $str; ### allow things that look like numbers to show up as numbers (and those that aren't quite to not) return $str if $str =~ /^ -? (?: [0-9]{0,13} \. \d* [1-9] | [1-9][0-9]{0,12}) $/x; my $quote = $self->{'single_quote'} ? "'" : '"'; $str =~ s/\\/\\\\/g; $str =~ s/\r/\\r/g; $str =~ s/\t/\\t/g; $self->{'single_quote'} ? $str =~ s/\'/\\\'/g : $str =~ s/\"/\\\"/g; ### allow for really odd chars $str =~ s/([\x00-\x07\x0b\x0e-\x1f])/'\\u00' . unpack('H2',$1)/eg; # from JSON::Converter utf8::decode($str) if $self->{'utf8'} && &utf8::decode; ### escape and tags in the text $str =~ s{() )}{$1$quote+$quote}gx; ### add nice newlines (unless pretty is off) if ($self->{'str_nl'} && length($str) > 80) { if ($self->{'single_quote'}) { $str =~ s/\'\s*\+\'$// if $str =~ s/\n/\\n\'$self->{str_nl}${prefix}+\'/g; } else { $str =~ s/\"\s*\+\"$// if $str =~ s/\n/\\n\"$self->{str_nl}${prefix}+\"/g; } } else { $str =~ s/\n/\\n/g; } return $quote . $str . $quote; } 1; __END__ =head1 SYNOPSIS use CGI::Ex::JSONDump; my $js = JSONDump(\%complex_data, {pretty => 0}); ### OR my $js = CGI::Ex::JSONDump->new({pretty => 0})->dump(\%complex_data); =head1 DESCRIPTION CGI::Ex::JSONDump is a very lightweight and fast perl data structure to javascript object notation dumper. This is useful for AJAX style methods, or dynamic page creation that needs to embed perl data in the presented page. CGI::Ex::JSONDump has roughly the same output as JSON::objToJson, but with the following differences: - CGI::Ex::JSONDump is much much lighter and smaller (a whopping 134 lines). - It dumps Javascript in more browser friendly format (handling of tags). - It removes unknown key types by default instead of dying. - It allows for a general handler to handle unknown key types. - It allows for fine grain control of all whitespace. - It allows for skipping keys by name or by regex. - It dumps both data structures and scalar types. =head1 METHODS =over 4 =item new Create a CGI::Ex::JSONDump object. Takes arguments hashref as single argument. my $obj = CGI::Ex::JSONDump->new(\%args); See the arguments section for a list of the possible arguments. =item dump Takes a perl data structure or scalar string or number and returns a string containing the javascript representation of that string (in Javascript object notation - JSON). =item js_escape Takes a scalar string or number and returns a javascript escaped string that will embed properly in javascript. All numbers and strings of nested data structures are passed through this method. =back =head1 FUNCTIONS =over 4 =item JSONDump A wrapper around the new and dump methods. Takes a structure to dump and optional args to pass to the new routine. JSONDump($data, $args); Is the same as: CGI::Ex::JSONDump->new($args)->dump($data); =back =head1 ARGUMENTS The following arguments may be passed to the new method or as the second argument to the JSONDump function. =over 4 =item pretty 0 or 1. Default 0 (false). If true then dumped structures will include whitespace to make them more readable. JSONDump({a => [1, 2]}, {pretty => 0}); JSONDump({a => [1, 2]}, {pretty => 1}); Would print {"a":[1,2]} { "a" : [ 1, 2 ] } =item single_quote 0 or 1. Default 0 (false). If true then escaped values will be quoted with single quotes. Otherwise values are quoted with double quotes. JSONDump("a", {single_quote => 0}); JSONDump("a", {single_quote => 1}); Would print "a" 'a' =item sort_keys 0 or 1. Default 1 (true) If true, then key/value pairs of hashrefs will be output in sorted order. =item play_coderefs 0 or 1. Default 0 (false). If true, then any code refs will be executed and the returned string will be dumped. If false, then keys of hashrefs that contain coderefs will be skipped (unless the handle_unknown_types property is set). Coderefs that are in arrayrefs will show up as "CODE(0x814c648)" unless the handle_unknown_types property is set. =item handle_unknown_types Default undef. If true it should contain a coderef that will be called if any unknown types are encountered. The only default known types are scalar string or number values, unblessed HASH refs and ARRAY refs (and CODE refs if the play_coderefs property is set). All other types will be passed to the handle_unknown_types method call. JSONDump({a => bless({}, 'A'), b => 1}, { handle_unknown_types => sub { my $self = shift; # a JSON object my $data = shift; # the object to dump return $self->js_escape("Ref=" . ref $data); }, pretty => 0, }); Would print {"a":"Ref=A","b":1} If the handle_unknown_types method is not set then keys hashrefs that have values with unknown types will not be included in the javascript output. JSONDump({a => bless({}, 'A'), b => 1}, {pretty => 0}); Would print {"b":1} =item skip_keys Should contain an arrayref of keys or a hashref whose keys are the keys to skip. Default is unset. Any keys of hashrefs (including nested hashrefs) that are listed in the skip_keys item will not be included in the javascript output. JSONDump({a => 1, b => 1}, {skip_keys => ['a'], pretty => 0}); Would print {"b":1} =item skip_keys_qr Similar to skip_keys but should contain a regex. Any keys of hashrefs (including nested hashrefs) that match the skip_keys_qr regex will not be included in the javascript output. JSONDump({a => 1, _b => 1}, {skip_keys_qr => qr/^_/, pretty => 0}); Would print {"a":1} =item indent The level to indent each nested data structure level if pretty is true. Default is " " (two spaces). =item hash_nl The whitespace to add after each hashref key/value pair if pretty is true. Default is "\n". =item hash_sep The separator and whitespace to put between each hashref key/value pair if pretty is true. Default is " : ". =item array_nl The whitespace to add after each arrayref entry if pretty is true. Default is "\n". =item str_nl The whitespace to add in between newline separated strings if pretty is true or the output line is greater than 80 characters. Default is "\n" (if pretty is true). JSONDump("This is a long string\n" ."with plenty of embedded newlines\n" ."and is greater than 80 characters.\n", {pretty => 1}); Would print "This is a long string\n" +"with plenty of embedded newlines\n" +"and is greater than 80 characters.\n" JSONDump("This is a long string\n" ."with plenty of embedded newlines\n" ."and is greater than 80 characters.\n", {pretty => 1, str_nl => ""}); Would print "This is a long string\nwith plenty of embedded newlines\nand is greater than 80 characters.\n" If the string is less than 80 characters, or if str_nl is set to "", then the escaped string will be contained on a single line. Setting pretty to 0 effectively sets str_nl equal to "". =back =head1 AUTHORS Paul Seamons =cut