]> git.vpit.fr Git - perl/modules/autovivification.git/blob - samples/hash2array.pl
Eliminate a quadratic behaviour at compile time
[perl/modules/autovivification.git] / 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 }