File Coverage

lib/Tie/Array/Random.pm
Criterion Covered Total %
statement 35 35 100.0
branch 5 6 83.3
condition n/a
subroutine 10 10 100.0
pod n/a
total 50 51 98.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Tie::Array::Random - Generates random for different fetched indexes
4              
5             =head1 SYNOPSIS
6              
7             use Tie::Array::Random;
8              
9             my @array;
10             tie @array, 'Tie::Array::Random';
11              
12             my $a_random_number = $array[1];
13             my $an_other_random_number = $array[200];
14              
15             $a_random_number == $array[1]; ## True
16              
17             ## Set random type
18             tie %hash, 'Tie::Array::Random', { set=> 'alpha', min=>5, max=>5 }};
19              
20             =head1 DESCRIPTION
21              
22             Tie::Array::Random generates a random number each time a different index 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::Array::Random;
31              
32 1     1   23855 use 5.006;
  1         4  
  1         59  
33 1     1   5 use strict;
  1         2  
  1         35  
34 1     1   4 use warnings;
  1         6  
  1         36  
35 1     1   5 use vars qw($VERSION @ISA);
  1         1  
  1         61  
36 1     1   942 use Tie::Array;
  1         1148  
  1         23  
37 1     1   868 use Data::Random qw(:all);
  1         3603  
  1         459  
38              
39             $VERSION = '1.01';
40             @ISA = qw(Tie::Array);
41              
42              
43             sub TIEARRAY {
44 3     3   296 my $storage = bless {}, shift;
45              
46 3         6 my $args = shift;
47              
48 3         19 $storage->{__rand_config} = { set => 'numeric', min => 5, max => 8 };
49 3         6 $storage->{__max} = 0;
50              
51 3         12 foreach (keys %$args) {
52 4         12 $storage->{__rand_config}->{$_} = $args->{$_};
53             }
54            
55 3         11 return $storage;
56             }
57              
58              
59             =head2 STORE
60              
61             Stores data
62              
63             =cut
64              
65             sub STORE {
66 1     1   3 my ($self, $key, $val) = @_;
67              
68 1 50       5 $self->{__max} = $key if $key > $self->{__max} ;
69              
70 1         5 $self->{$key} = $val;
71             }
72              
73             =head2 FETCH
74              
75             Fetchs
76              
77             =cut
78              
79             sub FETCH {
80 6     6   674 my ($self, $key) = @_;
81              
82 6 100       31 $self->{$key} = join '', rand_chars( %{$self->{__rand_config}} ) if ! exists $self->{$key};
  4         21  
83              
84              
85 6 100       819 $self->{__max} = $key if $key > $self->{__max} ;
86              
87 6         25 return $self->{$key};
88             }
89              
90             =head2 FETCHSIZE
91              
92             Fetchs size
93              
94             =cut
95              
96             sub FETCHSIZE {
97 2     2   281 my ($self, $key) = @_;
98              
99 2         9 return $self->{__max};
100             }
101              
102              
103              
104              
105             1;
106             __END__