File Coverage

blib/lib/Variable/Disposition.pm
Criterion Covered Total %
statement 22 26 84.6
branch 8 12 66.6
condition n/a
subroutine 6 8 75.0
pod 3 3 100.0
total 39 49 79.5


line stmt bran cond sub pod time code
1             package Variable::Disposition;
2             # ABSTRACT: dispose of variables
3 3     3   51777 use strict;
  3         5  
  3         85  
4 3     3   16 use warnings;
  3         3  
  3         64  
5              
6 3     3   1185 use parent qw(Exporter);
  3         878  
  3         14  
7              
8             our $VERSION = '0.003';
9              
10             =head1 NAME
11              
12             Variable::Disposition - helper functions for disposing of variables
13              
14             =head1 VERSION
15              
16             version 0.003
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   273 use Scalar::Util ();
  3         3  
  3         542  
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 4016 die "Variable not defined" unless defined $_[0];
98 6 100       22 die "Variable was not a ref" unless ref $_[0];
99 5         17 delete $RETAINED{$_[0]}; # just in case we'd previously retained this one
100 5         21 Scalar::Util::weaken(my $copy = $_[0]);
101 5         6 undef $_[0];
102 5 100       29 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 1327 die "Variable not defined" unless defined $_[0];
115 1 50       4 die "Variable was not a ref" unless ref $_[0];
116 1         4 $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             }
135              
136             1;
137              
138             __END__