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 {
  14  my ($char) = $_[0] =~ /['"]?([a-z])['"]?/;
  15  return ord($char) - ord('a')
  16 }
  17
  18 sub hash2array {
  19  my ($h) = @_;
  20  return $h unless $h and ref $h eq 'HASH';
  21  my @array;
  22  for (keys %$h) {
  23   $array[num($_)] = hash2array($h->{$_});
  24  }
  25  return \@array;
  26 }
  27
  28 sub dump_array {
  29  my ($a) = @_;
  30  return 'undef' unless defined $a;
  31  return $a      unless ref $a;
  32  die "Invalid argument" unless ref $a eq 'ARRAY';
  33  return '[ ' . join(', ', map dump_array($_), @$a) . ' ]';
  34 }
  35
  36 sub extract ($) { extract_bracketed $_[0], '{',  qr/.*?(?<!\\)(?:\\\\)*(?={)/ }
  37
  38 my $in_data;
  39 while (<$hash_t>) {
  40  if (/^__DATA__$/) {
  41   $in_data = 1;
  42   print $array_t      $_;
  43   print $array_fast_t $_;
  44  } elsif (!$in_data) {
  45   s{'%'}{'\@'};
  46   print $array_t      $_;
  47   print $array_fast_t $_;
  48  } else {
  49   for my $file ([ 1, $array_t ], [ 0, $array_fast_t ]) {
  50    local $_ = $_;
  51    s!(\ba\b)?(\s*)HASH\b!($1 ? 'an': '') . "$2ARRAY"!eg;
  52    s{
  53     {\s*(['"]?[a-z]['"]?(?:\s*,\s*['"]?[a-z]['"]?)*)\s*}
  54    }{
  55     '[' . join(', ', map { my $n = num($_); $file->[0] ? "\$N[$n]" : $n }
  56                       split /\s*,\s*/, $1) . ']'
  57    }gex;
  58    s!%(\{?)\$!\@$1\$!g;
  59    my $buf;
  60    my $suffix = $_;
  61    my ($bracket, $prefix);
  62    while (do { ($bracket, $suffix, $prefix) = extract($suffix); $bracket }) {
  63     $buf .= $prefix . dump_array(hash2array(eval $bracket));
  64    }
  65    $buf .= $suffix;
  66    $buf =~ s/\s+/ /g;
  67    $buf =~ s/\s+$//;
  68    print { $file->[1] } "$buf\n";
  69   }
  70  }
  71 }