Option to sort hashes

Message-ID: <20010930214556.D26392@ttul.org>

(remember also the #12289)

p4raw-id: //depot/perl@12288

diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 8fc7ac3..d0eb917 100644 (file)
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -29,7 +29,7 @@ static I32 DD_dump (pTHX_ SV *val, char *name, STRLEN namelen, SV *retval,
                    SV *pad, SV *xpad, SV *apad, SV *sep,
                    SV *freezer, SV *toaster,
                    I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
-                   I32 maxdepth);
+                   I32 maxdepth, SV *sortkeys);
 
 /* does a string need to be protected? */
 static I32
@@ -179,7 +179,7 @@ static I32
 DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
        AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
        SV *apad, SV *sep, SV *freezer, SV *toaster, I32 purity,
-       I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth)
+       I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys)
 {
     char tmpbuf[128];
     U32 i;
@@ -354,7 +354,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
                        postav, levelp, indent, pad, xpad, apad, sep,
                        freezer, toaster, purity, deepcopy, quotekeys, bless,
-                       maxdepth);
+                       maxdepth, sortkeys);
                sv_catpvn(retval, ")}", 2);
            }                                                /* plain */
            else {
@@ -362,7 +362,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
                        postav, levelp, indent, pad, xpad, apad, sep,
                        freezer, toaster, purity, deepcopy, quotekeys, bless,
-                       maxdepth);
+                       maxdepth, sortkeys);
            }
            SvREFCNT_dec(namesv);
        }
@@ -374,7 +374,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
            DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
                    postav, levelp,     indent, pad, xpad, apad, sep,
                    freezer, toaster, purity, deepcopy, quotekeys, bless,
-                   maxdepth);
+                   maxdepth, sortkeys);
            SvREFCNT_dec(namesv);
        }
        else if (realtype == SVt_PVAV) {
@@ -443,7 +443,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
                        levelp, indent, pad, xpad, apad, sep,
                        freezer, toaster, purity, deepcopy, quotekeys, bless,
-                       maxdepth);
+                       maxdepth, sortkeys);
                if (ix < ixmax)
                    sv_catpvn(retval, ",", 1);
            }
@@ -468,6 +468,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
            char *key;
            I32 klen;
            SV *hval;
+           AV *keys = Nullav;
        
            iname = newSVpvn(name, namelen);
            if (name[0] == '%') {
@@ -497,9 +498,42 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
            sv_catsv(totpad, pad);
            sv_catsv(totpad, apad);
        
-           (void)hv_iterinit((HV*)ival);
+           /* If requested, get a sorted/filtered array of hash keys */
+           if (sortkeys) {
+               if (sortkeys == &PL_sv_yes) {
+                   keys = newAV();
+                   (void)hv_iterinit((HV*)ival);
+                   while (entry = hv_iternext((HV*)ival)) {
+                       sv = hv_iterkeysv(entry);
+                       SvREFCNT_inc(sv);
+                       av_push(keys, sv);
+                   }
+                   sortsv(AvARRAY(keys), 
+                          av_len(keys)+1, 
+                          Perl_sv_cmp_locale);
+               }
+               else {
+                   dSP; ENTER; SAVETMPS; PUSHMARK(sp);
+                   XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK;
+                   i = perl_call_sv(sortkeys, G_SCALAR | G_EVAL);
+                   SPAGAIN;
+                   if (i) {
+                       sv = POPs;
+                       if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVAV))
+                           keys = (AV*)SvREFCNT_inc(SvRV(sv));
+                   }
+                   if (! keys)
+                       warn("Sortkeys subroutine did not return ARRAYREF\n");
+                   PUTBACK; FREETMPS; LEAVE;
+               }
+               if (keys)
+                   sv_2mortal((SV*)keys);
+           }
+           else
+               (void)hv_iterinit((HV*)ival);
            i = 0;
-           while ((entry = hv_iternext((HV*)ival)))  {
+           while (sortkeys ? (void*)(keys && (i <= av_len(keys))) : 
+                             (void*)((entry = hv_iternext((HV*)ival))) )                   {
                char *nkey = NULL;
                I32 nticks = 0;
                SV* keysv;
@@ -508,9 +542,21 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                
                if (i)
                    sv_catpvn(retval, ",", 1);
+
+               if (sortkeys) {
+                   char *key;
+                   svp = av_fetch(keys, i, FALSE);
+                   keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
+                   key = SvPV(keysv, keylen);
+                   svp = hv_fetch((HV*)ival, key, keylen, 0);
+                   hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
+               }
+               else {
+                   keysv = hv_iterkeysv(entry);
+                   hval = hv_iterval((HV*)ival, entry);
+               }
+
                i++;
-               keysv = hv_iterkeysv(entry);
-               hval  = hv_iterval((HV*)ival, entry);
 
                do_utf8 = DO_UTF8(keysv);
                key = SvPV(keysv, keylen);
@@ -571,7 +617,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                DD_dump(aTHX_ hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
                        postav, levelp, indent, pad, xpad, newapad, sep,
                        freezer, toaster, purity, deepcopy, quotekeys, bless,
-                       maxdepth);
+                       maxdepth, sortkeys);
                SvREFCNT_dec(sname);
                Safefree(nkey);
                if (indent >= 2)
@@ -713,7 +759,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                        DD_dump(aTHX_ e, SvPVX(nname), SvCUR(nname), postentry,
                                seenhv, postav, &nlevel, indent, pad, xpad,
                                newapad, sep, freezer, toaster, purity,
-                               deepcopy, quotekeys, bless, maxdepth);
+                               deepcopy, quotekeys, bless, maxdepth, 
+                               sortkeys);
                        SvREFCNT_dec(e);
                    }
                }
@@ -776,7 +823,7 @@ Data_Dumper_Dumpxs(href, ...)
            I32 indent, terse, i, imax, postlen;
            SV **svp;
            SV *val, *name, *pad, *xpad, *apad, *sep, *varname;
-           SV *freezer, *toaster, *bless;
+           SV *freezer, *toaster, *bless, *sortkeys;
            I32 purity, deepcopy, quotekeys, maxdepth = 0;
            char tmpbuf[1024];
            I32 gimme = GIMME;
@@ -858,6 +905,17 @@ Data_Dumper_Dumpxs(href, ...)
                    bless = *svp;
                if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
                    maxdepth = SvIV(*svp);
+               if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
+                   sortkeys = *svp;
+                   if (! SvTRUE(sortkeys))
+                       sortkeys = NULL;
+                   else if (! (SvROK(sortkeys) &&
+                               SvTYPE(SvRV(sortkeys)) == SVt_PVCV) )
+                   {
+                       /* flag to use qsortsv() for sorting hash keys */       
+                       sortkeys = &PL_sv_yes; 
+                   }
+               }
                postav = newAV();
 
                if (todumpav)
@@ -923,7 +981,7 @@ Data_Dumper_Dumpxs(href, ...)
                    DD_dump(aTHX_ val, SvPVX(name), SvCUR(name), valstr, seenhv,
                            postav, &level, indent, pad, xpad, newapad, sep,
                            freezer, toaster, purity, deepcopy, quotekeys,
-                           bless, maxdepth);
+                           bless, maxdepth, sortkeys);
                
                    if (indent >= 2)
                        SvREFCNT_dec(newapad);

diff --git a/ext/Data/Dumper/t/dumper.t b/ext/Data/Dumper/t/dumper.t
index bf07229..2371835 100755 (executable)
--- a/ext/Data/Dumper/t/dumper.t
+++ b/ext/Data/Dumper/t/dumper.t
@@ -61,11 +61,11 @@ sub TEST {
 
 if (defined &Data::Dumper::Dumpxs) {
   print "### XS extension loaded, will run XS tests\n";
-  $TMAX = 192; $XS = 1;
+  $TMAX = 210; $XS = 1;
 }
 else {
   print "### XS extensions not loaded, will NOT run XS tests\n";
-  $TMAX = 96; $XS = 0;
+  $TMAX = 105; $XS = 0;
 }
 
 print "1..$TMAX\n";
@@ -821,3 +821,106 @@ EOT
   TEST q(Data::Dumper->Dumpxs([$a], ['a']));
 
 }
+
+{
+  $i = 0;
+  $a = { map { ("$_$_$_", ++$i) } 'I'..'Q' };
+  local $Data::Dumper::Sortkeys = 1;
+
+############# 193
+##
+  $WANT = <<'EOT';
+#$VAR1 = {
+#  III => 1,
+#  JJJ => 2,
+#  KKK => 3,
+#  LLL => 4,
+#  MMM => 5,
+#  NNN => 6,
+#  OOO => 7,
+#  PPP => 8,
+#  QQQ => 9
+#};
+EOT
+
+TEST q(Data::Dumper->new([$a])->Dump;);
+TEST q(Data::Dumper->new([$a])->Dumpxs;)
+       if $XS;
+}
+
+{
+  $i = 5;
+  $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
+  local $Data::Dumper::Sortkeys = \&sort199;
+  sub sort199 {
+    my $hash = shift;
+    return [ sort { $b <=> $a } keys %$hash ];
+  }
+
+############# 199
+##
+  $WANT = <<'EOT';
+#$VAR1 = {
+#  '14' => 'QQQ',
+#  '13' => 'PPP',
+#  '12' => 'OOO',
+#  '11' => 'NNN',
+#  '10' => 'MMM',
+#  '9' => 'LLL',
+#  '8' => 'KKK',
+#  '7' => 'JJJ',
+#  '6' => 'III'
+#};
+EOT
+
+TEST q(Data::Dumper->new([$c])->Dump;);
+TEST q(Data::Dumper->new([$c])->Dumpxs;)
+       if $XS;
+}
+
+{
+  $i = 5;
+  $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
+  $d = { reverse %$c };
+  local $Data::Dumper::Sortkeys = \&sort205;
+  sub sort205 {
+    my $hash = shift;
+    return [ 
+      $hash eq $c ? (sort { $a <=> $b } keys %$hash)
+                 : (reverse sort keys %$hash)
+    ];
+  }
+
+############# 205
+##
+  $WANT = <<'EOT';
+#$VAR1 = [
+#  {
+#    '6' => 'III',
+#    '7' => 'JJJ',
+#    '8' => 'KKK',
+#    '9' => 'LLL',
+#    '10' => 'MMM',
+#    '11' => 'NNN',
+#    '12' => 'OOO',
+#    '13' => 'PPP',
+#    '14' => 'QQQ'
+#  },
+#  {
+#    QQQ => '14',
+#    PPP => '13',
+#    OOO => '12',
+#    NNN => '11',
+#    MMM => '10',
+#    LLL => '9',
+#    KKK => '8',
+#    JJJ => '7',
+#    III => '6'
+#  }
+#];
+EOT
+
+TEST q(Data::Dumper->new([[$c, $d]])->Dump;);
+TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;)
+       if $XS;
+}