X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=samples%2Fhash2array.pl;h=e70b69be8ea90e83c558a527dcc862c8a0beba67;hb=360c7788ca026b8d50e79ec872cdfdc1c1b359f2;hp=4e7ccaa032da344682be0a7ace71b58c2fdef2c8;hpb=6a425386b4dab23f859f51f3cc99a6ebe3c414f0;p=perl%2Fmodules%2Fautovivification.git

diff --git a/samples/hash2array.pl b/samples/hash2array.pl
index 4e7ccaa..e70b69b 100644
--- a/samples/hash2array.pl
+++ b/samples/hash2array.pl
@@ -6,10 +6,14 @@ use warnings;
 use Fatal qw/open/;
 use Text::Balanced qw/extract_bracketed/;
 
-open my $hash_t,  '<', 't/20-hash.t';
-open my $array_t, '>', 't/21-array.t';
+open my $hash_t,       '<', 't/20-hash.t';
+open my $array_t,      '>', 't/30-array.t';
+open my $array_fast_t, '>', 't/31-array-fast.t';
 
-sub num { ord($_[0]) - ord('a') }
+sub num {
+ my ($char) = $_[0] =~ /['"]?([a-z])['"]?/;
+ return ord($char) - ord('a')
+}
 
 sub hash2array {
  my ($h) = @_;
@@ -35,21 +39,33 @@ my $in_data;
 while (<$hash_t>) {
  if (/^__DATA__$/) {
   $in_data = 1;
-  print $array_t $_;
+  print $array_t      $_;
+  print $array_fast_t $_;
  } elsif (!$in_data) {
   s{'%'}{'\@'};
-  print $array_t $_;
+  print $array_t      $_;
+  print $array_fast_t $_;
  } else {
-  s!->{([a-z])}!'->[' . num($1) . ']'!eg;
-  my $buf;
-  my $suffix = $_;
-  my ($bracket, $prefix);
-  while (do { ($bracket, $suffix, $prefix) = extract($suffix); $bracket }) {
-   $buf .= $prefix . dump_array(hash2array(eval $bracket));
+  for my $file ([ 1, $array_t ], [ 0, $array_fast_t ]) {
+   local $_ = $_;
+   s!(\ba\b)?(\s*)HASH\b!($1 ? 'an': '') . "$2ARRAY"!eg;
+   s{
+    {\s*(['"]?[a-z]['"]?(?:\s*,\s*['"]?[a-z]['"]?)*)\s*}
+   }{
+    '[' . join(', ', map { my $n = num($_); $file->[0] ? "\$N[$n]" : $n }
+                      split /\s*,\s*/, $1) . ']'
+   }gex;
+   s!%(\{?)\$!\@$1\$!g;
+   my $buf;
+   my $suffix = $_;
+   my ($bracket, $prefix);
+   while (do { ($bracket, $suffix, $prefix) = extract($suffix); $bracket }) {
+    $buf .= $prefix . dump_array(hash2array(eval $bracket));
+   }
+   $buf .= $suffix;
+   $buf =~ s/\s+/ /g;
+   $buf =~ s/\s+$//;
+   print { $file->[1] } "$buf\n";
   }
-  $buf .= $suffix;
-  $buf =~ s/\s+/ /g;
-  $buf =~ s/\s+$//;
-  print $array_t "$buf\n";
  }
 }