File Coverage

blib/lib/Tie/Scalar/Sticky.pm
Criterion Covered Total %
statement 27 27 100.0
branch 4 4 100.0
condition n/a
subroutine 9 9 100.0
pod n/a
total 40 40 100.0


line stmt bran cond sub pod time code
1             package Tie::Scalar::Sticky;
2              
3 2     2   31285 use strict;
  2         5  
  2         61  
4 2     2   12 use warnings;
  2         4  
  2         101  
5             our $VERSION = '1.12';
6              
7 2     2   1658 use Symbol;
  2         2032  
  2         167  
8 2     2   1808 use Tie::Scalar;
  2         1283  
  2         57  
9 2     2   12 use base 'Tie::StdScalar';
  2         4  
  2         1500  
10              
11             sub TIESCALAR {
12 2     2   638 my $class = shift;
13 2         3 my $self = *{gensym()};
  2         12  
14 2         50 @$self = ('',@_);
15 2         9 return bless \$self, $class;
16             }
17              
18             sub STORE {
19 16     16   9224 my($self,$val) = @_;
20 16 100       63 return unless defined $val;
21 12 100       116 $$$self = $val unless grep $val eq $_, @$$self;
22             }
23              
24             sub FETCH {
25 16     16   357 my $self = shift;
26 16         73 return $$$self;
27             }
28              
29             sub DESTROY {
30 2     2   678 my $self = shift;
31 2         53 undef $$$self;
32             }
33              
34             qw(jeffa);
35              
36             =pod
37              
38             =head1 NAME
39              
40             Tie::Scalar::Sticky - Just another scalar assignment blocker.
41              
42             =head1 SYNOPSIS
43              
44             use strict;
45             use Tie::Scalar::Sticky;
46              
47             tie my $sticky, 'Tie::Scalar::Sticky';
48              
49             $sticky = 42;
50             $sticky = ''; # still 42
51             $sticky = undef; # still 42
52             $sticky = 0; # now it's zero
53              
54             tie my $sticky, 'Tie::Scalar::Sticky' => qw/ foo bar /;
55              
56             $sticky = 42;
57             $sticky = 'foo'; # still 42
58             $sticky = 'bar'; # still 42
59             $sticky = 0; # now it's zero
60              
61             =head1 DESCRIPTION
62              
63             Scalars tie'ed to this module will 'reject' any assignments
64             of undef or the empty string or any of the extra arugments
65             provided to C. It simply removes the need for
66             you to validate assignments, such as:
67              
68             $var = $val unless grep $val eq $_, qw(not one of these);
69              
70             Actually, that is the exact idea used in this module ...
71              
72             So, why do this? Because i recently had to loop through a
73             list where some items were undefined and the previously
74             defined value should be used instead. In a nutshell:
75              
76             tie my $sticky, 'Tie::Scalar::Sticky' => 9, 'string';
77             for (3,undef,'string',2,'',1,9,0) {
78             $sticky = $_;
79             print $sticky, ' ';
80             }
81              
82             should print: 3 3 2 2 1 0
83              
84             =head1 BUGS AND LIMITATIONS
85              
86             Please report any bugs or feature requests to either
87              
88             =over 4
89              
90             =item * Email: C
91              
92             =item * Web: L
93              
94             =back
95              
96             I will be notified, and then you'll automatically be notified of progress
97             on your bug as I make changes.
98              
99             =head1 GITHUB
100              
101             The Github project is L
102              
103             =head1 SUPPORT
104              
105             You can find documentation for this module with the perldoc command.
106              
107             perldoc Tie::Scalar::Sticky
108              
109             You can also look for information at:
110              
111             =over 4
112              
113             =item * RT: CPAN's request tracker (report bugs here) L
114              
115             =item * AnnoCPAN: Annotated CPAN documentation L
116              
117             =item * CPAN Ratings L
118              
119             =item * Search CPAN L
120              
121             =back
122              
123             =head1 AUTHOR
124              
125             Jeff Anderson, C<< >>
126              
127             =head1 CREDITS
128              
129             Dan Brook added support for user-defined strings by changing
130             C<$self> to a glob. His patch was applied to Version 1.02
131             verbatim, i later 'simplified' the code by assuming that
132             undef and the empty strings (the only two items Version
133             1.00 will block) are already waiting inside C<@$$self>.
134             Dan then removed undef from C<@$$self>, and i added a simple
135             check that returns from C unless C<$val> is defined.
136              
137             =head1 COPYRIGHT
138              
139             Copyright 2016 Jeff Anderson.
140              
141             Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
142              
143             The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
144              
145             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
146              
147             =cut