File Coverage

blib/lib/Data/Dump/JavaScript.pm

Criterion	Covered	Total	%
statement	63	65	96.9
branch	23	30	76.6
condition	7	12	58.3
subroutine	16	16	100.0
pod	3	3	100.0
total	112	126	88.8

package Data::Dump::JavaScript;
$Data::Dump::JavaScript::VERSION = '0.001';
use strict;
use warnings;
use Exporter 'import';
use Scalar::Util 'blessed';
use Encode ();

# ABSTRACT: Pretty printing of data structures as JavaScript


our @EXPORT_OK = qw( dump_javascript false true );

# Literal names
# Users may override Booleans with literal 0 or 1 if desired.
our($FALSE, $TRUE) = map { bless \(my $dummy = $_), 'Data::Dump::JavaScript::_Bool' } 0, 1;

# Escaped special character map with u2028 and u2029
my %ESCAPE = (
  '"'     => '"',
  '\\'    => '\\',
  '/'     => '/',
  'b'     => "\x08",
  'f'     => "\x0c",
  'n'     => "\x0a",
  'r'     => "\x0d",
  't'     => "\x09",
  'u2028' => "\x{2028}",
  'u2029' => "\x{2029}"
);
my %REVERSE = map { $ESCAPE{$_} => "\\$_" } keys %ESCAPE;

for(0x00 .. 0x1f) {
    my $packed = pack 'C', $_;
    $REVERSE{$packed} = sprintf '\u%.4X', $_ unless defined $REVERSE{$packed};
}

my $indent_level;
# standard and semi-standard JS default
my $indent_count = 2;


sub false () {$FALSE}  ## no critic (prototypes)


sub true () {$TRUE} ## no critic (prototypes)


sub dump_javascript {
    $indent_level = 0;
    Encode::encode 'UTF-8', _encode_value(shift);
}

sub _encode_key {
  my $str = shift;
  $str =~ s!([\x00-\x1f\x{2028}\x{2029}\\"/])!$REVERSE{$1}!gs;
  return "$str";
}

sub _encode_array {
    my $str = '[';
    $str .= "\n"
        if scalar @{$_[0]} > 1;
    $indent_level++;
    $str .= join(",\n", map { scalar @{$_[0]} > 1 ? _get_indented(_encode_value($_)) : _encode_value($_) } @{$_[0]});
    $indent_level--;
    $str .=  scalar @{$_[0]} > 1
        ? "\n" . _get_indented("]")
        : ']';
}

sub _encode_object {
  my $object = shift;
  my $str = '{';
  $str .= "\n"
    if keys %$object > 0;
  $indent_level++;
  my @pairs = map { _get_indented(_encode_key($_)) . ': ' . _encode_value($object->{$_}) }
    sort keys %$object;
  #$str .= join(",\n", @pairs) . "\n";
  $str .= join(",\n", @pairs);
  $indent_level--;
  $str .= keys %$object > 0
    ? "\n" . _get_indented("}")
    : '}';
  return $str;
}

sub _encode_string {
  my $str = shift;
  $str =~ s!([\x00-\x1f\x{2028}\x{2029}\\"/])!$REVERSE{$1}!gs;
  return "'$str'";
}

sub _encode_value {
  my $value = shift;

  # Reference
  if (my $ref = ref $value) {

    # Object
    return _encode_object($value) if $ref eq 'HASH';

    # Array
    return _encode_array($value) if $ref eq 'ARRAY';

    # True or false
    return $$value ? 'true' : 'false' if $ref eq 'SCALAR';
    return $value  ? 'true' : 'false' if $ref eq 'Data::Dump::JavaScript::_Bool';

    # Blessed reference with TO_JSON method
    if (blessed $value && (my $sub = $value->can('TO_JSON'))) {
      return _encode_value($value->$sub);
    }
  }

  # Null
  return 'null' unless defined $value;


  # Number (bitwise operators change behavior based on the internal value type)

  # "0" & $x will modify the flags on the "0" on perl < 5.14, so use a copy
  my $zero = "0";
  # "0" & $num -> 0. "0" & "" -> "". "0" & $string -> a character.
  # this maintains the internal type but speeds up the xor below.
  my $check = $zero & $value;
  return $value
    if length $check
    # 0 ^ itself          -> 0    (false)
    # $character ^ itself -> "\0" (true)
    && !($check ^ $check)
    # filter out "upgraded" strings whose numeric form doesn't strictly match
    && 0 + $value eq $value
    # filter out inf and nan
    && $value * 0 == 0;

  # String
  return _encode_string($value);
}

sub _get_indented {
    return ' ' x ( $indent_level * $indent_count ) . shift;
}

# Emulate boolean type
package Data::Dump::JavaScript::_Bool;
$Data::Dump::JavaScript::_Bool::VERSION = '0.001';
use overload '""' => sub { ${$_[0]} }, fallback => 1;


1;

__END__