view release on metacpan or  search on metacpan

lib/Data/Dumper/Interp.pm  view on Meta::CPAN

  my $r = [
    sort { my @a = split /(?<=\d)(?=\D)|(?<=\D)(?=\d)/,$a;
           my @b = split /(?<=\d)(?=\D)|(?<=\D)(?=\d)/,$b;
           for (my $i=0; $i <= $#a; ++$i) {
             return 1 if $i > $#b;  # a is longer
             my $r = ($a[$i] =~ /^\d+$/ && $b[$i] =~ /^\d+$/)
                      ? ($a[$i] <=> $b[$i]) : ($a[$i] cmp $b[$i]) ;
             return $r if $r != 0;
           }
           return -1 if $#a < $#b; # a is shorter
           return 0;
         }
         keys %$hash
  ];
  $r
}

my $quoted_re = RE_quoted(-delim => q{'"});

my $balanced_re = RE_balanced(-parens=>'{}[]()');

# cf man perldata
my $userident_re = qr/ (?: (?=\p{Word})\p{XID_Start} | _ )
                           (?: (?=\p{Word})\p{XID_Continue}  )* /x;

my $pkgname_re = qr/ ${userident_re} (?: :: ${userident_re} )* /x;

our $curlies_re = RE_balanced(-parens=>'{}');
our $parens_re = RE_balanced(-parens=>'()');
our $curliesorsquares_re = RE_balanced(-parens=>'{}[]');

my $anyvname_re =
  qr/ ${pkgname_re} | [0-9]+ | \^[A-Z]
                    | [-+!\$\&\;i"'().,\@\/:<>?\[\]\~\^\\] /x;

my $anyvname_or_refexpr_re = qr/ ${anyvname_re} | ${curlies_re} /x;

my $addrvis_re = qr/\<\d+:(?:\Q${\_ADDRVIS_SHARED_MARK}\E)?[\da-fA-F]+\>/;

sub __unmagic_atom() {  # edits $_
##  # FIXME this probably could omit the ([^'"]*?) bc there is never anything
##  # between the open quote and the _MAGIC_NOQUOTES_PFX
##  s/(['"])([^'"]*?)
##    (?:\Q${\_MAGIC_NOQUOTES_PFX}\E)
##    (.*?)(\1)/$2$3/xgs;

  s/(['"])
    (?:\Q${\_MAGIC_NOQUOTES_PFX}\E) (.*?)
    (\1)/do{ local $_ = $2;
             s!\\(.)!$1!g;  # undo double-quotish backslash escapes
             $_ }/xegs;

  s/\Q${\_MAGIC_KEEPQUOTES_PFX}\E//gs;
}

sub __unesc_unicode() {  # edits $_
  if (/^"/) {
    # Data::Dumper with Useqq(1) outputs wide characters as hex escapes;
    # turn them back into the original characters if "printable".
    # That means "Graph" category EXCEPT:
    #   BOM (which is ZERO WIDTH NO-BREAK SPACE so is considered "Graphical")
    #   and any other "Format" category Unicode characters; we want see those
    #   in hex.
    s{
       \G (?: [^\\]++ | \\[^x] )*+ \K (?<w> \\x\x{7B} (?<hex>[a-fA-F0-9]+) \x{7D} )
     }{
       my $orig = $+{w};
       local $_ = hex( length($+{hex}) > 6 ? '0' : $+{hex} );
       $_ = $_ > 0x10FFFF ? "\0" : chr($_); # 10FFFF is Unicode limit
       # Using 'lc' so regression tests do not depend on Data::Dumper's
       # choice of case when escaping wide characters.
       (m<\P{XPosixGraph}|[\0-\177]>
          || m<\p{General_Category=Format}>) ? lc($orig) : $_
     }xesg;
  }
}

my %ctlesc2codepoint = (
  '\\a' => ord("\a"),
  '\\b' => ord("\b"),
  '\\t' => ord("\t"),
  '\\n' => ord("\n"),
  '\\f' => ord("\f"),
  '\\r' => ord("\r"),
  '\\e' => ord("\e"),
);
sub __unesc_nonoctal () {  # edits $_
  # Change backslash escapes like \n back to octal escapes.
  # This is to better visualize binary octet streams
  if (/^"/) {
    s{
       \G (?: [^\\]++ | \\[x0-7] )*+ \K (?<w> \\[abtnfre])(?<digitnext>\d?)
     }{
      $+{digitnext}
        ? sprintf("\\%03o", ($ctlesc2codepoint{$+{w}} // oops))
        : sprintf("\\%01o", ($ctlesc2codepoint{$+{w}} // oops))
     }xesg;
  }
}

sub __change_quotechars($$$) {  # edits $_
  if (s/^"//) {
    oops unless s/"$//;
    my ($pfx, $l, $r) = @_;
    s/\\"/"/g;
    s/([\Q$l\E])/\\$1/g if length($l)==1; # assume traditional qqLR
    s/([\Q$r\E])/\\$1/g if length($r)==1; # with single-character brackets
    $_ = $pfx.$l.$_.$r;
  }
}

my %qqesc2controlpic = (
  '\0' => "\N{SYMBOL FOR NULL}",   # occurs if next char is not a digit
  '\000' => "\N{SYMBOL FOR NULL}", # occurs if next char is a digit
  '\a' => "\N{SYMBOL FOR BELL}",
  '\b' => "\N{SYMBOL FOR BACKSPACE}",
  '\e' => "\N{SYMBOL FOR ESCAPE}",
  '\f' => "\N{SYMBOL FOR FORM FEED}",
  '\n' => "\N{SYMBOL FOR NEWLINE}",
  '\r' => "\N{SYMBOL FOR CARRIAGE RETURN}",
  '\t' => "\N{SYMBOL FOR HORIZONTAL TABULATION}",