File Coverage

blib/lib/Tie/Hash/FixedKeys.pm
Criterion Covered Total %
statement 32 32 100.0
branch 4 4 100.0
condition n/a
subroutine 10 10 100.0
pod n/a
total 46 46 100.0


line stmt bran cond sub pod time code
1             # $Id$
2              
3             =head1 NAME
4              
5             Tie::Hash::FixedKeys - Perl extension for hashes with fixed keys
6              
7             =head1 SYNOPSIS
8              
9             use Tie::Hash::FixedKeys;
10              
11             my @keys = qw(forename surname date_of_birth gender);
12             my %person;
13             tie %person, 'Tie;::Hash::FixedKeys', @keys;
14              
15             @person{@keys} = qw(Fred Bloggs 19700101 M);
16              
17             $person{height} = "6'"; # generates a warning
18              
19             or (new! improved!)
20              
21             use Tie::Hash::FixedKeys;
22              
23             my %person : FixedKeys(qw(forename surname date_of_birth gender));
24              
25             =head1 DESCRIPTION
26              
27             Tie::Hash::FixedKeys is a class which changes the behaviour of Perl hashes.
28             Any hash which is tied to this class can only contain a fixed set of keys.
29             This set of keys is given when the hash is tied. For example, after running
30             the code:
31              
32             my @keys = qw(forename surename date_of_birth gender);
33             my %person;
34             tie %person, 'Tie;::Hash::FixedKeys', @keys;
35              
36             the hash C<%person> can only contain the keys forename, surname,
37             date_of_birth and gender. Any attempt to set a value for another key
38             will generate a run-time warning.
39              
40             =head2 ATTRIBUTE INTERFACE
41              
42             From version 1.5, you can use attributes to set the keys for your hash.
43             You will need Attribute::Handlers version 0.76 or greater.
44              
45             =head2 CAVEAT
46              
47             The tied hash will always contain exactly one value for each of the keys
48             in the list. These values are initialised to C when the hash is
49             tied. If you try to C one if the keys, the effect is that the
50             value is reset to C.
51              
52             =head2 NOTE
53              
54             Versions of Perl from 5.8.0 include a module called L which
55             contains a function called C which does the same as this module
56             but in a faster and more powerful way. I recommend that you use that
57             method in place of this module.
58              
59             This module is left on CPAN as an example of tied hashes.
60              
61             =cut
62              
63             package Tie::Hash::FixedKeys;
64              
65 1     1   69190 use 5.006;
  1         15  
66 1     1   6 use strict;
  1         2  
  1         30  
67 1     1   4 use warnings;
  1         2  
  1         25  
68              
69 1     1   550 use Tie::Hash;
  1         1094  
  1         30  
70 1     1   6 use Carp;
  1         2  
  1         58  
71              
72 1     1   668 use Attribute::Handlers autotie => { "__CALLER__::FixedKeys" => __PACKAGE__ };
  1         5089  
  1         7  
73              
74             our @ISA = qw(Tie::StdHash);
75              
76             our $VERSION = '1.13.1';
77              
78             =head1 METHODS
79              
80             =head2 TIEHASH
81              
82             Creates a tied hash containing all the keys initialised to C.
83              
84             =cut
85              
86             sub TIEHASH {
87 1     1   2813 my $class = shift;
88              
89 1         2 my %hash;
90 1         5 @hash{@_} = (undef) x @_;
91              
92 1         5 bless \%hash, $class;
93             }
94              
95             =head2 STORE
96              
97             Attempts to store a value in the hash. If the key isn't in the valid
98             list (i.e. it doesn't already exist) the program croaks.
99              
100             =cut
101              
102             sub STORE {
103 3     3   740 my ($self, $key, $val) = @_;
104              
105 3 100       13 unless (exists $self->{$key}) {
106 1         136 croak "invalid key [$key] in hash\n";
107             }
108 2         7 $self->{$key} = $val;
109             }
110              
111             =head2 DELETE
112              
113             Delete a value from the hash. Actually it just sets the value back to
114             C.
115              
116             =cut
117              
118             sub DELETE {
119 2     2   1239 my ($self, $key) = @_;
120              
121 2 100       8 return unless exists $self->{$key};
122              
123 1         3 my $ret = $self->{$key};
124              
125 1         2 $self->{$key} = undef;
126              
127 1         3 return $ret;
128             }
129              
130             =head2 CLEAR
131              
132             Clears all values but resetting them to C.
133              
134             =cut
135              
136             sub CLEAR {
137 1     1   532 my $self = shift;
138              
139 1         16 $self->{$_} = undef foreach keys %$self;
140             }
141              
142             1;
143             __END__