Data::Dumper: add Trailingcomma option
authorAaron Crane <arc@cpan.org>
Mon, 7 Dec 2015 22:49:19 +0000 (22:49 +0000)
committerAaron Crane <arc@cpan.org>
Wed, 16 Dec 2015 00:01:09 +0000 (00:01 +0000)
This is as suggested in RT#126813.

The refactoring to use a structure for the style variables has now paid off:
the additional variable is mentioned only where it's directly relevant,
rather than needing to be passed explicitly to every recursive call.

MANIFEST
dist/Data-Dumper/Dumper.pm
dist/Data-Dumper/Dumper.xs
dist/Data-Dumper/t/trailing_comma.t [new file with mode: 0644]

index 2a5a6a3..2adf881 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3076,6 +3076,7 @@ dist/Data-Dumper/t/sortkeys.t     See if Data::Dumper::Sortkeys works
 dist/Data-Dumper/t/sparseseen.t        See if Data::Dumper::Sparseseen works
 dist/Data-Dumper/t/terse.t     See if Data::Dumper terse option works
 dist/Data-Dumper/t/toaster.t   See if Data::Dumper::Toaster works
+dist/Data-Dumper/t/trailing_comma.t    See if Data::Dumper::Trailingcomma works
 dist/Data-Dumper/t/values.t    See if Data::Dumper::Values works
 dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm        Generate stubs for SelfLoader.pm
 dist/Devel-SelfStubber/t/Devel-SelfStubber.t   See if Devel::SelfStubber works
index 7801511..ace9b78 100644 (file)
@@ -41,6 +41,7 @@ my $IS_ASCII  = ord 'A' ==  65;
 
 # module vars and their defaults
 $Indent     = 2         unless defined $Indent;
+$Trailingcomma = 0      unless defined $Trailingcomma;
 $Purity     = 0         unless defined $Purity;
 $Pad        = ""        unless defined $Pad;
 $Varname    = "VAR"     unless defined $Varname;
@@ -76,6 +77,7 @@ sub new {
   my($s) = {
         level      => 0,           # current recursive depth
         indent     => $Indent,     # various styles of indenting
+        trailingcomma => $Trailingcomma, # whether to add comma after last elem
         pad        => $Pad,        # all lines prefixed by this string
         xpad       => "",          # padding-per-level
         apad       => "",          # added padding for hash keys n such
@@ -413,7 +415,9 @@ sub _dump {
         $out .= $pad . $ipad . '#' . $i
           if $s->{indent} >= 3;
         $out .= $pad . $ipad . $s->_dump($v, $sname);
-        $out .= "," if $i++ < $#$val;
+        $out .= ","
+            if $i++ < $#$val
+            || ($s->{trailingcomma} && $s->{indent} >= 1);
       }
       $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
       $out .= ($name =~ /^\@/) ? ')' : ']';
@@ -473,7 +477,7 @@ sub _dump {
           if $s->{indent} >= 2;
       }
       if (substr($out, -1) eq ',') {
-        chop $out;
+        chop $out if !$s->{trailingcomma} || !$s->{indent};
         $out .= $pad . ($s->{xpad} x ($s->{level} - 1));
       }
       $out .= ($name =~ /^\%/) ? ')' : '}';
@@ -633,6 +637,11 @@ sub Indent {
   }
 }
 
+sub Trailingcomma {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{trailingcomma} = $v), return $s) : $s->{trailingcomma};
+}
+
 sub Pair {
     my($s, $v) = @_;
     defined($v) ? (($s->{pair} = $v), return $s) : $s->{pair};
@@ -1032,6 +1041,15 @@ consumes twice the number of lines).  Style 2 is the default.
 
 =item *
 
+$Data::Dumper::Trailingcomma  I<or>  I<$OBJ>->Trailingcomma(I<[NEWVAL]>)
+
+Controls whether a comma is added after the last element of an array or
+hash. Even when true, no comma is added between the last element of an array
+or hash and a closing bracket when they appear on the same line. The default
+is false.
+
+=item *
+
 $Data::Dumper::Purity  I<or>  I<$OBJ>->Purity(I<[NEWVAL]>)
 
 Controls the degree to which the output can be C<eval>ed to recreate the
index f6e363d..3440891 100644 (file)
@@ -62,6 +62,7 @@ typedef struct {
     I32 maxdepth;
     I32 useqq;
     int use_sparse_seen_hash;
+    int trailingcomma;
 } Style;
 
 static I32 num_q (const char *s, STRLEN slen);
@@ -863,7 +864,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
                sv_catsv(retval, ipad);
                DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
                        level+1, apad, style);
-               if (ix < ixmax)
+               if (ix < ixmax || (style->trailingcomma && style->indent >= 1))
                    sv_catpvs(retval, ",");
            }
            if (ixmax >= 0) {
@@ -1080,6 +1081,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
            if (i) {
                 SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad),
                                 SvCUR(style->xpad), level);
+                if (style->trailingcomma && style->indent >= 1)
+                    sv_catpvs(retval, ",");
                sv_catsv(retval, totpad);
                sv_catsv(retval, opad);
                SvREFCNT_dec(opad);
@@ -1399,7 +1402,7 @@ Data_Dumper_Dumpxs(href, ...)
             style.quotekeys = 1;
             style.maxrecurse = 1000;
             style.purity = style.deepcopy = style.useqq = style.maxdepth
-                = style.use_sparse_seen_hash = 0;
+                = style.use_sparse_seen_hash = style.trailingcomma = 0;
             style.pad = style.xpad = style.sep = style.pair = style.sortkeys
                 = style.freezer = style.toaster = style.bless = &PL_sv_undef;
            seenhv = NULL;
@@ -1448,6 +1451,8 @@ Data_Dumper_Dumpxs(href, ...)
                     style.deepcopy = SvTRUE(*svp);
                if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
                     style.quotekeys = SvTRUE(*svp);
+                if ((svp = hv_fetch(hv, "trailingcomma", 13, FALSE)))
+                    style.trailingcomma = SvTRUE(*svp);
                if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
                     style.bless = *svp;
                if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
diff --git a/dist/Data-Dumper/t/trailing_comma.t b/dist/Data-Dumper/t/trailing_comma.t
new file mode 100644 (file)
index 0000000..8767bdf
--- /dev/null
@@ -0,0 +1,116 @@
+#!./perl -w
+# t/trailing_comma.t - Test TrailingComma()
+
+BEGIN {
+    if ($ENV{PERL_CORE}){
+        require Config; import Config;
+        no warnings 'once';
+        if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+            print "1..0 # Skip: Data::Dumper was not built\n";
+            exit 0;
+        }
+    }
+}
+
+use strict;
+
+use Data::Dumper;
+use Test::More;
+use lib qw( ./t/lib );
+use Testing qw( _dumptostr );
+
+my @cases = ({
+    input  => [],
+    output => "[]",
+    desc   => 'empty array',
+}, {
+    input  => [17],
+    output => "[17]",
+    desc   => 'single-element array, no indent',
+    conf   => { Indent => 0 },
+}, {
+    input  => [17],
+    output => "[\n  17,\n]",
+    desc   => 'single-element array, indent=1',
+    conf   => { Indent => 1 },
+}, {
+    input  => [17],
+    output => "[\n          17,\n        ]",
+    desc   => 'single-element array, indent=2',
+    conf   => { Indent => 2 },
+}, {
+    input  => [17, 18],
+    output => "[17,18]",
+    desc   => 'two-element array, no indent',
+    conf   => { Indent => 0 },
+}, {
+    input  => [17, 18],
+    output => "[\n  17,\n  18,\n]",
+    desc   => 'two-element array, indent=1',
+    conf   => { Indent => 1 },
+}, {
+    input  => [17, 18],
+    output => "[\n          17,\n          18,\n        ]",
+    desc   => 'two-element array, indent=2',
+    conf   => { Indent => 2 },
+}, {
+    input  => {},
+    output => "{}",
+    desc   => 'empty hash',
+}, {
+    input  => {foo => 17},
+    output => "{'foo' => 17}",
+    desc   => 'single-element hash, no indent',
+    conf   => { Indent => 0 },
+}, {
+    input  => {foo => 17},
+    output => "{\n  'foo' => 17,\n}",
+    desc   => 'single-element hash, indent=1',
+    conf   => { Indent => 1 },
+}, {
+    input  => {foo => 17},
+    output => "{\n          'foo' => 17,\n        }",
+    desc   => 'single-element hash, indent=2',
+    conf   => { Indent => 2 },
+}, {
+    input  => {foo => 17, quux => 18},
+    output => "{'foo' => 17,'quux' => 18}",
+    desc   => 'two-element hash, no indent',
+    conf   => { Indent => 0 },
+}, {
+    input  => {foo => 17, quux => 18},
+    output => "{\n  'foo' => 17,\n  'quux' => 18,\n}",
+    desc   => 'two-element hash, indent=1',
+    conf   => { Indent => 1 },
+}, {
+    input  => {foo => 17, quux => 18},
+    output => "{\n          'foo' => 17,\n          'quux' => 18,\n        }",
+    desc   => 'two-element hash, indent=2',
+    conf   => { Indent => 2 },
+});
+
+my $xs_available = !$Data::Dumper::Useperl;
+my $tests_per_case = $xs_available ? 2 : 1;
+
+plan tests => $tests_per_case * @cases;
+
+for my $case (@cases) {
+    run_case($case, $xs_available ? 'XS' : 'PP');
+    if ($xs_available) {
+        local $Data::Dumper::Useperl = 1;
+        run_case($case, 'PP');
+    }
+}
+
+sub run_case {
+    my ($case, $mode) = @_;
+    my ($input, $output, $desc, $conf) = @$case{qw<input output desc conf>};
+    my $obj = Data::Dumper->new([$input]);
+    $obj->Trailingcomma(1);     # default to on for these tests
+    $obj->Sortkeys(1);
+    for my $k (sort keys %{ $conf || {} }) {
+        $obj->$k($conf->{$k});
+    }
+    chomp(my $got = _dumptostr($obj));
+    is($got, "\$VAR1 = $output;", "$desc (in $mode mode)");
+}