samples/hash2array.pl

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Fatal qw/open/;
   7 use Text::Balanced qw/extract_bracketed/;
   8
   9 open my $hash_t,       '<', 't/20-hash.t';
  10 open my $array_t,      '>', 't/30-array.t';
  11 open my $array_fast_t, '>', 't/31-array-fast.t';
  12
  13 sub num { ord($_[0]) - ord('a') }
  14
  15 sub hash2array {
  16  my ($h) = @_;
  17  return $h unless $h and ref $h eq 'HASH';
  18  my @array;
  19  for (keys %$h) {
  20   $array[num($_)] = hash2array($h->{$_});
  21  }
  22  return \@array;
  23 }
  24
  25 sub dump_array {
  26  my ($a) = @_;
  27  return 'undef' unless defined $a;
  28  return $a      unless ref $a;
  29  die "Invalid argument" unless ref $a eq 'ARRAY';
  30  return '[ ' . join(', ', map dump_array($_), @$a) . ' ]';
  31 }
  32
  33 sub extract ($) { extract_bracketed $_[0], '{',  qr/.*?(?<!\\)(?:\\\\)*(?={)/ }
  34
  35 my $in_data;
  36 while (<$hash_t>) {
  37  if (/^__DATA__$/) {
  38   $in_data = 1;
  39   print $array_t      $_;
  40   print $array_fast_t $_;
  41  } elsif (!$in_data) {
  42   s{'%'}{'\@'};
  43   print $array_t      $_;
  44   print $array_fast_t $_;
  45  } else {
  46   for my $file ([ 1, $array_t ], [ 0, $array_fast_t ]) {
  47    local $_ = $_;
  48    s!(\ba\b)?(\s*)HASH\b!($1 ? 'an': '') . "$2ARRAY"!eg;
  49    s!->{([a-z])}!my $n = num($1); '->[' . ($file->[0] ? "\$N[$n]" : $n) .']'!eg;
  50    s!%(\{?)\$!\@$1\$!g;
  51    my $buf;
  52    my $suffix = $_;
  53    my ($bracket, $prefix);
  54    while (do { ($bracket, $suffix, $prefix) = extract($suffix); $bracket }) {
  55     $buf .= $prefix . dump_array(hash2array(eval $bracket));
  56    }
  57    $buf .= $suffix;
  58    $buf =~ s/\s+/ /g;
  59    $buf =~ s/\s+$//;
  60    print { $file->[1] } "$buf\n";
  61   }
  62  }
  63 }