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   1289359 use warnings;
  7         67  
  7         175  
4 7     7   42  
  7         18  
  7         159  
5             use Scope::Guard 'guard';
6 7     7   2548 use Exporter 'import';
  7         2707  
  7         330  
7 7     7   42  
  7         12  
  7         1033  
8             our @EXPORT = qw/ local_attribute /;
9              
10             our $VERSION = '0.03';
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> and classic Perl OO code using C<bless> and hand-rolled accessors,
56             but there is a good chance it will work on other object implementations too.
57              
58             =head1 EXPORTS
59              
60             =head2 local_attribute($obj, $attr, $val)
61              
62             Takes an object C<$obj> and temporarily localizes the attribute C<$attr> on
63             it to C<$val>. It returns a L<Scope::Guard> object that will restore the
64             original value of C<$attr> when it goes out of scope.
65              
66             my $guard = local_attribute( $bob, 'name', 'joe' ); # $bob->name eq 'joe'
67              
68             You B<must> always capture the return value of C<local_attribute> and store it
69             in a variable. It will die if called in void context, because the underlying
70             L<Scope::Guard> object cannot work in void context. Your attribute would be
71             replaced permanently.
72              
73             local_attribute( $foo, 'attr', 'new value' ); # BOOM
74              
75             This function is exported by default.
76              
77             =cut
78              
79             my $obj = shift;
80             my $attr = shift;
81 28     28 1 69394 my $val = shift; ## optional, default to undef
82 28         57  
83 28         45 die qq{local_attribute must not be called in void context}
84             unless defined wantarray;
85 28 100       151 die qq{Attribute '$attr' does not exist} unless $obj->can($attr);
86              
87 21 100       262 my $backup = $obj->$attr();
88             my $guard = guard {
89 14         102 $obj->$attr($backup)
90             };
91 14     14   23164  
92 14         163 $obj->$attr($val);
93              
94 14         331 return $guard;
95             }
96 14         104  
97             =head1 SEE ALSO
98              
99             =over
100              
101             =item *
102              
103             L<Scope::Guard>
104              
105             =item *
106              
107             L<Moose>
108              
109             =item *
110              
111             L<Moo>
112              
113             =back
114              
115             =head1 AUTHOR
116              
117             Julien Fiegehenn <simbabque@cpan.org>
118              
119             =head1 COPYRIGHT
120              
121             Copyright (c) 2022, Julien Fiegehenn.
122              
123             This is free software; you can redistribute it and/or modify it under the same
124             terms as the Perl 5 programming language system itself.
125              
126             =cut
127              
128             1;