File Coverage

blib/lib/Tie/Scalar/MarginOfError.pm
Criterion Covered Total %
statement 22 22 100.0
branch 4 4 100.0
condition 3 3 100.0
subroutine 7 7 100.0
pod n/a
total 36 36 100.0


line stmt bran cond sub pod time code
1             package Tie::Scalar::MarginOfError;
2              
3             =head1 NAME
4              
5             Tie::Scalar::MarginOfError - Scalars that have margins of error
6              
7             =head1 SYNOPSIS
8              
9             use Tie::Scalar::MarginOfError;
10              
11             tie my $val, 'Tie::Scalar::MarginOfError',
12             {
13             tolerance => 0.1,
14             initial_value => 1,
15             callback => \&some_sub,
16             };
17              
18              
19             =head1 DESCRIPTION
20              
21             This allows you to have a scalar which has to stay within a certain
22             margin of error. Your code will die (or execute what was passed in via
23             the 'callback' subref) if the scalar's value goes outside this range.
24              
25             You tie a variable, and give it an initial value and a tolerance. Your
26             code will die (or execute what was given in the callback subref) if the
27             value gets beyond +/- whatever you have set the tolerance to be.
28              
29             In the SYNOPSIS example, $val will cause your code to execute &some_sub
30             if it gets above 1.1 or below 0.9.
31              
32             If no callback is defined, then the code will simply croak.
33              
34             =head2 More on the callback
35              
36             If you do define a callback, then it will receive one argument, which is
37             the Tie::Scalar::MarginOfError object. This means you can get out the
38             initial value, if you wish to reset the variable once it exceeds the
39             margin of error.
40              
41             See t/Tie-Scalar-MarginOfError.t for that very example.
42              
43             =cut
44              
45 1     1   23495 use strict;
  1         1  
  1         34  
46 1     1   5 use warnings;
  1         1  
  1         39  
47              
48             our $VERSION = "0.03";
49              
50 1     1   1067 use Tie::Scalar;
  1         658  
  1         27  
51 1     1   7 use base 'Tie::StdScalar';
  1         1  
  1         631  
52              
53 1     1   7 use Carp;
  1         2  
  1         212  
54              
55             sub STORE {
56 15     15   8244 my ($self, $val) = @_;
57 15 100 100     114 if (($val > $$self->{initial_value} + $$self->{tolerance})
58             || ($val < $$self->{initial_value} - $$self->{tolerance})) {
59 3 100       429 croak "$val is outside margin of error" unless my $subref = $$self->{callback};
60 1         4 $subref->($self);
61             }
62 12         48 $$self->{value} = $val;
63             }
64              
65             sub FETCH {
66 13     13   4551 my $self = shift;
67 13         48 return $$self->{value};
68             }
69              
70             =head1 CAVEATS
71              
72             Yes, you could use this to monitor the core temperature of your nuclear
73             reactor. But the variable is tied, so it can be considered slower than
74             normal. And if you are depending on the reactor not going critical, I
75             wouldn't be using this code. Or perl, come to think of it.
76              
77             =head1 HAIKU
78              
79             Want to stay within
80             The limit set by the world
81             Breathe in this module
82              
83             This arose as Tony (http://www.tmtm.com/nothing/) suggested to me that
84             if I can't write the documentation of a module in haiku, then it is
85             doing too many things. As I (also) believe that modules should be
86             responsible for one concept, and one only.
87              
88             Also, I have no poetical ability, so forgive my clumsy attempt.
89              
90             =head1 SEE ALSO
91              
92             perldoc perltie
93              
94             =head1 THANKS
95              
96             o Dave Cross, whose talk to Belfast.pm made me write this. Blame him.
97              
98             o Geert Jan Bex for the subref idea.
99              
100             o Steve Rushe for looking it over and being my personal ispell.
101              
102             =head1 BUGS
103              
104             Let me know if you spot one. Or if your core goes critical and wipes out
105             the Mid-West of the US. But I guess I would see that on the news.
106              
107             =head1 AUTHOR
108              
109             Stray Toaster, Ecoder@stray-toaster.co.ukE
110              
111             =head1 SHOWING YOUR APPRECIATION
112              
113             There was a thread on london.pm mailing list about working in a vacumn -
114             that it was a bit depressing to keep writing modules but never get any
115             feedback. So, if you use and like this module then please send me an
116             email and make my day.
117              
118             All it takes is a few little bytes.
119              
120             (Leon wrote that, not me!)
121              
122             =head1 COPYRIGHT AND LICENSE
123              
124             Copyright (C) 2003 by Stray Toaster
125              
126             This library is free software; you can redistribute it and/or modify
127             it under the same terms as Perl itself, either Perl version 5.8.1 or,
128             at your option, any later version of Perl 5 you may have available.
129              
130              
131             =cut