Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

hash

perl

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?

like image 885
Alex Hajnal Avatar asked Dec 22 '22 15:12

Alex Hajnal


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"
like image 109
mob Avatar answered Mar 04 '23 12:03

mob


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',
);
like image 36
ikegami Avatar answered Mar 04 '23 13:03

ikegami