package JSON::Color;
use 5.010;
use strict;
use warnings;
use Scalar::Util qw(looks_like_number);
use Term::ANSIColor qw(:constants);
# PUSHCOLOR and LOCALCOLOR cannot be used, they are functions, not escape codes
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(encode_json);
our $VERSION = '0.05'; # VERSION
our %theme = (
start_quote => BOLD . BRIGHT_GREEN,
end_quote => RESET,
start_string => GREEN,
end_string => RESET,
start_string_escape => BOLD,
end_string_escape => RESET . GREEN, # back to string
start_number => BOLD . BRIGHT_MAGENTA,
end_number => RESET,
start_bool => CYAN,
end_bool => RESET,
start_null => CYAN,
end_null => RESET,
start_object_key => MAGENTA,
end_object_key => RESET,
start_object_key_escape => BOLD,
end_object_key_escape => RESET . MAGENTA, # back to object key
start_linum => REVERSE . WHITE,
end_linum => RESET,
);
my %esc = (
"\n" => '\n',
"\r" => '\r',
"\t" => '\t',
"\f" => '\f',
"\b" => '\b',
"\"" => '\"',
"\\" => '\\\\',
"\'" => '\\\'',
);
sub _string {
my ($value, $opts) = @_;
my ($sq, $eq, $ss, $es, $sse, $ese);
if ($opts->{obj_key}) {
$sq = $theme{start_object_key};
$eq = $theme{end_object_key};
$ss = $theme{start_object_key};
$es = $theme{end_object_key};
$sse = $theme{start_object_key_escape};
$ese = $theme{end_object_key_escape};
} else {
$sq = $theme{start_quote};
$eq = $theme{end_quote};
$ss = $theme{start_string};
$es = $theme{end_string};
$sse = $theme{start_string_escape};
$ese = $theme{end_string_escape};
}
$value =~ s/([\x22\x5c\n\r\t\f\b])|([\x00-\x08\x0b\x0e-\x1f])/
join("",
$sse,
$1 ? $esc{$1} : '\\u00' . unpack('H2', $2),
$ese,
)
/eg;
return join(
"",
$sq, '"', $eq,
$ss, $value, $es,
$sq, '"', $eq,
);
}
sub _number {
my ($value, $opts) = @_;
return join(
"",
$theme{start_number}, $value, $theme{end_number},
);
}
sub _null {
my ($value, $opts) = @_;
return join(
"",
$theme{start_null}, "null", $theme{end_null},
);
}
sub _bool {
my ($value, $opts) = @_;
return join(
"",
$theme{start_bool}, "$value", $theme{end_bool},
);
}
sub _array {
my ($value, $opts) = @_;
return "[]" unless @$value;
my $indent = $opts->{pretty} ? " " x $opts->{_indent} : "";
my $indent2 = $opts->{pretty} ? " " x ($opts->{_indent}+1) : "";
my $nl = $opts->{pretty} ? "\n" : "";
local $opts->{_indent} = $opts->{_indent}+1;
return join(
"",
"[$nl",
(map {
$indent2,
_encode($value->[$_], $opts),
$_ == @$value-1 ? $nl : ",$nl",
} 0..@$value-1),
$indent, "]",
);
}
sub _hash {
my ($value, $opts) = @_;
return "{}" unless keys %$value;
my $indent = $opts->{pretty} ? " " x $opts->{_indent} : "";
my $indent2 = $opts->{pretty} ? " " x ($opts->{_indent}+1) : "";
my $nl = $opts->{pretty} ? "\n" : "";
my $colon = $opts->{pretty} ? ": " : ":";
my @res;
push @res, "{$nl";
my @k = sort keys(%$value);
local $opts->{_indent} = $opts->{_indent}+1;
for (0..@k-1) {
my $k = $k[$_];
push @res, (
$indent2,
_string($k, {obj_key=>1}),
$colon,
_encode($value->{$k}, $opts),
$_ == @k-1 ? $nl : ",$nl",
);
}
push @res, $indent, "}";
join "", @res;
}
sub _encode {
my ($data, $opts) = @_;
my $ref = ref($data);
if (!defined($data)) {
return _null($data, $opts);
} elsif ($ref eq 'ARRAY') {
return _array($data, $opts);
} elsif ($ref eq 'HASH') {
return _hash($data, $opts);
} elsif ($ref eq 'JSON::XS::Boolean' || $ref eq 'JSON::PP::Boolean') {
return _bool($data, $opts);
} elsif (!$ref) {
if (looks_like_number($data) =~ /^(4|12|4352|8704)$/o) {
return _number($data, $opts);
} else {
return _string($data, $opts);
}
} else {
die "Can't encode $data";
}
}
sub encode_json {
my ($value, $opts) = @_;
$opts //= {};
$opts->{_indent} //= 0;
my $res = _encode($value , $opts);
if ($opts->{linum}) {
my $lines = 0;
$lines++ while $res =~ /^/mog;
my $fmt = "%".length($lines)."d";
my $i = 0;
$res =~ s/^/
$theme{start_linum} . sprintf($fmt, ++$i) . $theme{end_linum}
/meg;
}
$res;
}
1;
# ABSTRACT: Encode to colored JSON
__END__
=pod
=head1 NAME
JSON::Color - Encode to colored JSON
=head1 VERSION
version 0.05
=head1 SYNOPSIS
use JSON::Color qw(encode_json);
say encode_json([1, "two", {three => 4}]);
=head1 DESCRIPTION
This module generates JSON, colorized with ANSI escape sequences.
To change the color, see the C<%theme> in the source code. In theory you can
also modify it to colorize using HTML.
=head1 FUNCTIONS
=head2 encode_json($data, \%opts) => STR
Encode to JSON. Will die on error (e.g. when encountering non-encodeable data
like Regexp or file handle).
Known options:
=over
=item * pretty => BOOL (default: 0)
Pretty-print.
=item * linum => BOOL (default: 0)
Show line number.
=back
=head1 FAQ
=head2 What about loading?
Use L<JSON>.
=head1 SEE ALSO
To colorize with HTML, you can try L<Syntax::Highlight::JSON>.
L<Syntax::SourceHighlight> can also colorize JSON/JavaScript to HTML or ANSI
escape. It requires the GNU Source-highlight library.
=head1 AUTHOR
Steven Haryanto <stevenharyanto@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Steven Haryanto.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut