File Coverage

blib/lib/MooseX/LocalAttribute.pm
Criterion Covered Total %
statement 22 22 100.0
branch 4 4 100.0
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 33 33 100.0


line stmt bran cond sub pod time code
1              
2             use strict;
3 7     7   1195872 use warnings;
  7         56  
  7         161  
4 7     7   30  
  7         13  
  7         147  
5             use Scope::Guard 'guard';
6 7     7   2400 use Exporter 'import';
  7         2457  
  7         316  
7 7     7   38  
  7         14  
  7         1006  
8             our @EXPORT = qw/ local_attribute /;
9              
10             our $VERSION = '0.04';
11              
12             =head1 NAME
13              
14             MooseX::LocalAttribute - local-ize attributes on Moose-ish objects
15              
16             =head1 SYNOPSIS
17              
18             use MooseX::LocalAttribute;
19              
20             my $freddy = Person->new( name => 'Freddy' );
21             print $freddy->name; # Freddy
22             {
23             my $temporary_name = 'Mr Orange';
24             my $guard = local_attribute( $freddy, "name", \$temporary_name );
25             print $freddy->name; # Mr Orange
26             steal_diamonds( $freddy );
27             }
28             print $freddy->name; # Freddy
29              
30             =head1 DESCRIPTION
31              
32             This module provides a mechanism to temporarily replace the value of an
33             object attribute with a different variable. In typical object oriented Perl
34             code, an object contains a blessed hash reference, so it's possible to reach
35             into the internals to localise data.
36              
37             my $local_bar;
38             local $foo->{bar} = \$local_bar;
39              
40             This has a few problems though. It is generally a better idea to use accessors
41             rather than to rumage around in the internals of an object. This is especially
42             true if one does not know whether the object is in fact a hash reference under
43             the hood.
44              
45             When a variable is localised with C<local>, a backup of that variable is made.
46             Perl then places a directive on the stack that restores the variable when it
47             is goes out of scope. This module does the same thing for attributes of
48             objects.
49              
50             =head1 WHICH OBJECTS DOES THIS WORK FOR
51              
52             While this module is called MooseX::LocalAttribute, it will work for all kinds
53             of objects, as long as there is a read/write accessor. It has been tested for
54             L<Moose>, L<Mouse>, L<Moo>, L<Mo>, L<Mojo::Base>, L<Class::Accessor>,
55             L<Util::H2O>, L<Object::PAD> and classic Perl OO code using C<bless> with
56             hand-rolled accessors. There is a good chance it will work on other object
57             implementations too.
58              
59             =head1 EXPORTS
60              
61             =head2 local_attribute($obj, $attr, $val)
62              
63             Takes an object C<$obj> and temporarily localizes the attribute C<$attr> on
64             it to C<$val>. It returns a L<Scope::Guard> object that will restore the
65             original value of C<$attr> when it goes out of scope.
66              
67             my $guard = local_attribute( $bob, 'name', 'joe' ); # $bob->name eq 'joe'
68              
69             You B<must> always capture the return value of C<local_attribute> and store it
70             in a variable. It will die if called in void context, because the underlying
71             L<Scope::Guard> object cannot work in void context. Your attribute would be
72             replaced permanently.
73              
74             local_attribute( $foo, 'attr', 'new value' ); # BOOM
75              
76             This function is exported by default.
77              
78             =cut
79              
80             my $obj = shift;
81             my $attr = shift;
82 28     28 1 61051 my $val = shift; ## optional, default to undef
83 28         56  
84 28         33 die qq{local_attribute must not be called in void context}
85             unless defined wantarray;
86 28 100       120 die qq{Attribute '$attr' does not exist} unless $obj->can($attr);
87              
88 21 100       149 my $backup = $obj->$attr();
89             my $guard = guard {
90 14         98 $obj->$attr($backup)
91             };
92 14     14   26411  
93 14         122 $obj->$attr($val);
94              
95 14         257 return $guard;
96             }
97 14         98  
98             =head1 OBJECTS THIS DOES NOT WORK FOR
99              
100             =over
101              
102             =item *
103              
104             L<Class::Std> - this does not support combined getter/setter methods
105              
106             =item *
107              
108             L<Object::Tiny> - this creates read-only accessors
109              
110             =back
111              
112             =head1 SEE ALSO
113              
114             =over
115              
116             =item *
117              
118             L<Scope::Guard>
119              
120             =item *
121              
122             L<Moose>
123              
124             =item *
125              
126             L<Moo>
127              
128             =back
129              
130             =head1 AUTHOR
131              
132             Julien Fiegehenn <simbabque@cpan.org>
133              
134             =head1 COPYRIGHT
135              
136             Copyright (c) 2022, Julien Fiegehenn.
137              
138             This is free software; you can redistribute it and/or modify it under the same
139             terms as the Perl 5 programming language system itself.
140              
141             =cut
142              
143             1;