File Coverage

blib/lib/Tie/Hash/Cannabinol.pm
Criterion Covered Total %
statement 24 24 100.0
branch 4 4 100.0
condition n/a
subroutine 9 9 100.0
pod n/a
total 37 37 100.0


line stmt bran cond sub pod time code
1             # $Id$
2              
3             =head1 NAME
4              
5             Tie::Hash::Cannabinol - Perl extension for creating hashes that forget things
6              
7             =head1 SYNOPSIS
8              
9             use Tie::Hash::Cannabinol;
10              
11             my %hash;
12             tie %hash, 'Tie::Hash::Cannabinol';
13              
14             or
15              
16             my %hash : Stoned;
17              
18             # % hash can now be treated exactly like a normal hash - but don't trust
19             # anything it tells you.
20              
21             =head1 DESCRIPTION
22              
23             Tie::Hash::Cannabinol is a completely useless demonstration of how to use
24             Tie::StdHash to pervert the behaviour of Perl hashes. Once a hash has been
25             Cd to Tie::Hash::Cannabinol, there is a 25% chance that it will forget
26             anything that you tell it immediately and a further 25% chance that it
27             won't be able to retrieve any information you ask it for. Any information
28             that it does return will be pulled at random from its keys.
29              
30             Oh, and the return value from C isn't to be trusted either :)
31              
32             =cut
33              
34             package Tie::Hash::Cannabinol;
35              
36 2     2   27763 use 5.006;
  2         37  
37 2     2   8 use strict;
  2         2  
  2         36  
38 2     2   4 use warnings;
  2         2  
  2         65  
39 2     2   6 use vars qw($VERSION @ISA);
  2         4  
  2         97  
40 2     2   886 use Tie::Hash;
  2         1462  
  2         53  
41 2     2   952 use Attribute::Handlers autotie => { "__CALLER__::Stoned" => __PACKAGE__ };
  2         7572  
  2         13  
42              
43             $VERSION = 1.10;
44             @ISA = qw(Tie::StdHash);
45              
46             =head2 STORE
47              
48             Stores data in the hash 3 times out of 4.
49              
50             =cut
51              
52             sub STORE {
53 8     8   3045 my ($self, $key, $val) = @_;
54              
55 8 100       42 return if rand > .75;
56              
57 6         20 $self->{$key} = $val;
58             }
59              
60             =head2 FETCH
61              
62             Fetchs I from the hash 3 times out of 4.
63              
64             =cut
65              
66             sub FETCH {
67 9072     9072   47266 my ($self, $key) = @_;
68              
69 9072 100       12840 return if rand > .75;
70              
71 6750         13325 return $self->{(keys %$self)[rand keys %$self]};
72             }
73              
74             =head2 EXISTS
75              
76             Gives very dodgy information about the existance of keys in the hash.
77              
78             =cut
79              
80             sub EXISTS {
81 6001     6001   15785 return rand > .5;
82             }
83              
84             1;
85             __END__