Perl: Make declaration of a duplicate hash key a fatal error?

user_13481837 0
Viewed 84

Is there a way in Perl to make the presence of a duplicate hash key an error at declaration time?

For example, for a script like this:

test.pl

#!/usr/bin/perl

my %hash = (
             'a' => 'valid',
             'b' => 'valid',
             'c' => 'valid',
             'a' => 'duplicate'
           );

I'd like to see something like this when it's run:

$ perl ./test.pl
duplicate hash key at ./test.pl line 7, near 'a' => 'duplicate'
Execution of ./test.pl aborted due to compilation errors.

Ideally I'd like to keep the hash declaration syntax the same. Is there any way to accomplish this?

hash perl
2 Answers

With a tied hash, you can override the mechanics of storing a hash value.

package Hash::DupesNotAllowed;
use Carp;
sub TIEHASH  { bless {}, $_[0] }  # borrowed from  Tie::StdHash
sub FETCH    { $_[0]->{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY  { each %{$_[0]} }
sub EXISTS   { exists $_[0]->{$_[1]} }
sub DELETE   { delete $_[0]->{$_[1]} }
sub CLEAR    { %{$_[0]} = () }
sub SCALAR   { scalar %{$_[0]} }

sub STORE {
    my ($self,$key,$value) = @_;
    if (exists($self->{$key})) {
        croak "Duplicate key '$key'";
    }
    $self->{$key} = $value;
    return;
}
1;


package main;
use Hash::DupesNotAllowed;
my (%h1, %h2, %h3);
tie %h2, 'Hash::DupesNotAllowed';
tie %h3, 'Hash::DupesNotAllowed';

%h1 = (a => 'one', b => 'two', a => 'three');    # ok
%h2 = (a => 'one', b => 'two', c => 'three');    # ok
%h3 = (a => 'one', b => 'two', a => 'three');    # "Duplicate key"
user_1686570

To check for duplicates, one can use

grep !$seen{$_}++, LIST

To get the first of each duplicate, we can can modify that as follows:

grep ++$seen{$_} == 2, LIST

But say we only want to check every second value of @_. We could use any of the following:

grep ++$seen{$_} == 2, @_[ map $_*2,  0 .. $#_/2 ]

grep ++$seen{$_} == 2, map $_[$_*2],  0 .. $#_/2

grep ++$seen{ $_[$_*2] } == 2, 0 .. $#_/2

So we can use this:

sub check_for_dup_keys {
   my %seen;
   my @dups =
      grep ++$seen{ $_[$_*2] } == 2,
         0 .. $#_/2;
   die("Duplicate keys: @dups\n") if @dups;
   return @_;
}

my %hash = check_for_dup_keys(
   'a' => 'valid',
   'b' => 'valid',
   'c' => 'valid',
   'a' => 'duplicate',
);
user_5899240
Related