File Coverage

blib/lib/Variable/Disposition.pm
Criterion Covered Total %
statement 22 27 81.4
branch 8 12 66.6
condition n/a
subroutine 6 8 75.0
pod 3 3 100.0
total 39 50 78.0


line stmt bran cond sub pod time code
1             package Variable::Disposition;
2             # ABSTRACT: dispose of variables
3 3     3   62984 use strict;
  3         6  
  3         97  
4 3     3   13 use warnings;
  3         5  
  3         80  
5              
6 3     3   1468 use parent qw(Exporter);
  3         856  
  3         16  
7              
8             our $VERSION = '0.002';
9              
10             =head1 NAME
11              
12             Variable::Disposition - helper functions for disposing of variables
13              
14             =head1 VERSION
15              
16             version 0.002
17              
18             =head1 SYNOPSIS
19              
20             use feature qw(say);
21             use Variable::Disposition;
22             my $x = [];
23             dispose $x;
24             say '$x is no longer defined';
25              
26             =head1 DESCRIPTION
27              
28             Provides some basic helper functions for making sure variables go away
29             when you want them to.
30              
31             Currently provides L as a default import. To avoid this:
32              
33             use Variable::Disposition ();
34              
35             In addition, L and L are available as optional
36             imports.
37              
38             use Variable::Disposition qw(dispose retain retain_future);
39              
40             The C< :all > tag can be used to import every available function:
41              
42             use Variable::Disposition qw(:all);
43              
44             but it would be safer to use a version instead:
45              
46             use Variable::Disposition qw(:v1);
47              
48             since these are guaranteed not to change in future.
49              
50             Other functions for use with L and L are likely to be
51             added later.
52              
53             =cut
54              
55             our @EXPORT_OK = qw(dispose retain retain_future);
56              
57             our %EXPORT_TAGS = (
58             all => [ @EXPORT_OK ],
59             v1 => [ qw(dispose retain retain_future) ],
60             );
61              
62             our @EXPORT = qw(dispose);
63              
64 3     3   328 use Scalar::Util ();
  3         4  
  3         675  
65              
66             our %RETAINED;
67              
68             =head1 FUNCTIONS
69              
70             =cut
71              
72             =head2 dispose
73              
74             Undefines the given variable, then checks that the original ref was destroyed.
75              
76             my $x = [1,2,3];
77             dispose $x;
78             # $x is no longer defined.
79              
80             This is primarily intended for cases where you no longer need a variable, and want
81             to ensure that you haven't accidentally captured a strong reference to it elsewhere.
82              
83             Note that this clears the B's variable.
84              
85             This function is defined with a prototype of ($), since it is only intended for use
86             on scalar variables. To clear multiple variables, use a L loop:
87              
88             my ($x, $y, $z) = ...;
89             dispose $_ for $x, $y, $z;
90             is($x, undef);
91             is($y, undef);
92             is($z, undef);
93              
94             =cut
95              
96             sub dispose($) {
97 7 100   7 1 4489 die "Variable not defined" unless defined $_[0];
98 6 100       26 die "Variable was not a ref" unless ref $_[0];
99 5         21 delete $RETAINED{$_[0]}; # just in case we'd previously retained this one
100 5         20 Scalar::Util::weaken(my $copy = $_[0]);
101 5         8 undef $_[0];
102 5 100       34 die "Variable was not released" if defined $copy;
103             }
104              
105             =head2 retain
106              
107             Keeps a copy of this variable until program exit or L.
108              
109             Returns the original variable.
110              
111             =cut
112              
113             sub retain($) {
114 1 50   1 1 1409 die "Variable not defined" unless defined $_[0];
115 1 50       4 die "Variable was not a ref" unless ref $_[0];
116 1         3 $RETAINED{$_[0]} = $_[0];
117 1         2 $_[0]
118             }
119              
120             =head2 retain_future
121              
122             Holds a copy of the given L until it's marked ready, then releases our copy.
123             Does not use L since that could interfere with other callbacks attached
124             to the L.
125              
126             Returns the original L.
127              
128             =cut
129              
130             sub retain_future {
131 0     0 1   my ($f) = @_;
132 0 0         die "Variable does not seem to be a Future, since it has no ->on_ready method" unless $f->can('on_ready');
133 0     0     $f->on_ready(sub { undef $f });
  0            
134 0           $f
135             }
136              
137             1;
138              
139             __END__