MikeM
MikeM

Reputation: 33

Experimental keys on scalar is now forbidden warning

This isn't my code but seems to be for an older version of Perl. I get:

Experimental keys on scalar is now forbidden at jdoodle.pl line 32. Type of arg 1 to keys must be hash or array (not hash element) at jdoodle.pl line 32, near "}) "

errors when I try to run the program. I've tried altering the hash/scalar statements to the best of my knowledge as I'm not a programmer.


use strict;
my $file = $ARGV[0] || die "You must supply a file to read.";

if (!open(FP, $file)) {
  print STDERR "ERROR: Unable to open $file: $!\n";
  exit(1);
}

my $data = join('', <FP>);
close(FP);

$data =~ s/\{\s*\}/{}/g;
$data =~ s/\/\*.*?\*\/\n*//g;

hash2sets(config2hash($data));

exit(0);

sub hash2sets {
  my $config = shift;
  my $start = shift || 'set';

  if (ref($config) ne 'HASH') {
    print STDERR "ERROR: '$config' is not a HASH at '$start'\n";
    exit(1);
  }

  foreach my $key (sort(keys(%{$config}))) {
    if (ref($config->{$key}) eq 'HASH') {
      if (keys($config->{$key}) == 0) {
        print "$start $key\n";
      } else {
        hash2sets($config->{$key}, "$start $key");
      }
    } elsif (ref($config->{$key}) eq 'ARRAY') {
      foreach my $val (sort(@{$config->{$key}})) {
        print "$start $key $val\n";
      }
    } else {
      print "$start $key " . $config->{$key} . "\n";
    }
  }
}

sub config2hash {
  my $config = shift;
  my $pad = shift || '';

  my (%hash);
  while ($config =~ m/^$pad(\S+)\s+(".+?"|\S+ \{\}|\S+\s+\{.*?\n$pad\}|{.*?\n$pad\}|\S+)/gsm) {
    my $tag = $1;
    my $info = $2;

    if ($info =~ m/^(\S+)\s+\{\n(\s*)(.*?)\n$pad\}/sm) {
      my $name = $1;
      $hash{$tag}{$name} = config2hash("$2$3", $2);
      next;
    } elsif ($info =~ m/^(\S+)\s+\{\}/sm) {
      $hash{$tag}{$1} = {};
      next;
    }

    if (ref($info) ne 'HASH' && $info =~ m/\{\n(\s*)(.*?)\n$pad\}/sm) {
      $info = config2hash("$1$2", $1);
    } elsif ($info eq '{}') {
      $info = {};
    }

    if (!exists($hash{$tag})) {
      $hash{$tag} = $info;
    } else {
      if (ref($hash{$tag}) ne 'ARRAY') {
        $hash{$tag} = [$hash{$tag}];
      }
      push(@{$hash{$tag}}, $info);
    }
  }

  return(\%hash);
}

It seems to work for the first few lines, but then the output doesn't come out right. I tried doing some debugging at looking at the hash, but I'm lost on what pattern isn't working now:

Input:
firewall {
    all-ping enable
    broadcast-ping disable
    group {
        port-group CloudKey {
            description "Unifi Cloudkey"
            port 80
            port 3478
            port 11143
        }
        port-group VPN {
            description "Sts vpn"
            port 500
            port 1701
            port 50
            port 4500
        }
    }
    ipv6-name STS-VPN-6 {
        default-action drop
        enable-default-log
        rule 1 {
            action accept
            state {
                established enable
                related enable
            }
        }
        rule 2 {
            action drop
            log enable
            state {
                invalid enable
            }
        }
        rule 100 {
            action accept
            log enable
            protocol icmp
        }
    }

Output:
set firewall all-ping enable
set firewall broadcast-ping disable
set firewall group port-group CloudKey description "Unifi Cloudkey"
set firewall group port-group CloudKey port 11143
set firewall group port-group CloudKey port 3478
set firewall group port-group CloudKey port 80
set firewall group port-group VPN description "Sts vpn"
set firewall group port-group VPN port 1701
set firewall group port-group VPN port 4500
set firewall group port-group VPN port 50
set firewall group port-group VPN port 500
set firewall ip-src-route disable
set firewall ipv6-name STS-VPN-6 default-action drop
set firewall ipv6-name STS-VPN-6 enable-default-log rule
set firewall ipv6-name STS-VPN-6 } rule
set firewall ipv6-name STS-VPN-6 } rule

Upvotes: 2

Views: 2411

Answers (1)

toolic
toolic

Reputation: 62154

I get a warning on Perl version 5.22, but not on the older 5.16.

I coaxed more information about the warning using diagnostics:

perl -Mdiagnostics jdoodle.pl jdoodle.pl
keys on reference is experimental at ...
    (S experimental::autoderef) keys with a scalar argument is experimental
    and may change or be removed in a future Perl version.  If you want to
    take the risk of using this feature, simply disable this warning:

        no warnings "experimental::autoderef";

If I add the following to the code, the warning disappears:

        no warnings "experimental::autoderef";

But, that feels like a temporary bandaid. I believe you can change:

  if (keys($config->{$key}) == 0) {

to:

  if (keys(%{ $config->{$key} }) == 0) {

That will dereference the hash.

Upvotes: 3

Related Questions