File Coverage

lib/Tie/Hash/Random.pm
Criterion Covered Total %
statement 30 32 93.7
branch 2 2 100.0
condition n/a
subroutine 9 10 90.0
pod n/a
total 41 44 93.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Tie::Hash::Random - Generates random for different fetched keys
4              
5             =head1 SYNOPSIS
6              
7             use Tie::Hash::Random;
8              
9             my %hash;
10             tie %hash, 'Tie::Hash::Random';
11              
12             my $a_random_number = $hash{foo};
13             my $an_other_random_number = $hash{bar};
14              
15             $a_random_number == $hash{foo}; ## True
16              
17             ## Set a seed
18             tie %hash, 'Tie::Hash::Random', { set=> 'alpha', min=>5, max=>5 }};
19              
20             =head1 DESCRIPTION
21              
22             Tie::Hash::Random generates a random number each time a different key is fetched.
23              
24             The actual random data is generated using Data::Random rand_chars function. The default arguments are
25             ( set => 'all', min => 5, max => 8 )
26             which can be modifed using tie parameters as shown in the SYNOPSIS.
27              
28             =cut
29              
30             package Tie::Hash::Random;
31              
32 1     1   651 use 5.006;
  1         4  
  1         43  
33 1     1   6 use strict;
  1         1  
  1         32  
34 1     1   5 use warnings;
  1         11  
  1         37  
35 1     1   6 use vars qw($VERSION @ISA);
  1         1  
  1         62  
36 1     1   827 use Tie::Hash;
  1         882  
  1         26  
37 1     1   819 use Data::Random qw(:all);
  1         3517  
  1         405  
38              
39             $VERSION = '1.02';
40             @ISA = qw(Tie::Hash);
41              
42              
43             sub TIEHASH {
44 3     3   692 my $storage = bless {}, shift;
45              
46 3         4 my $args = shift;
47              
48 3         17 $storage->{__rand_config} = { set => 'numeric', min => 5, max => 8 };
49              
50 3         12 foreach (keys %$args) {
51 4         10 $storage->{__rand_config}->{$_} = $args->{$_};
52             }
53            
54 3         13 return $storage;
55             }
56              
57              
58             =head2 STORE
59              
60             Stores data
61              
62             =cut
63              
64             sub STORE {
65 1     1   3 my ($self, $key, $val) = @_;
66 1         4 $self->{$key} = $val;
67             }
68              
69             =head2 FETCH
70              
71             Fetchs
72              
73             =cut
74              
75             sub FETCH {
76 6     6   644 my ($self, $key) = @_;
77              
78 6 100       18 $self->{$key} = join '', rand_chars( %{$self->{__rand_config}} ) if ! exists $self->{$key};
  4         19  
79              
80 6         691 return $self->{$key};
81             }
82              
83              
84             =head2 FIRSTKEY
85              
86              
87             =cut
88              
89             sub FIRSTKEY {
90 0     0     my ($self) = @_;
91 0           return 1;
92             }
93              
94              
95             1;
96             __END__