File Coverage

blib/lib/LV.pm
Criterion Covered Total %
statement 22 25 88.0
branch 2 4 50.0
condition n/a
subroutine 9 9 100.0
pod 3 3 100.0
total 36 41 87.8


line stmt bran cond sub pod time code
1 4     4   47303 use 5.006;
  4         15  
  4         169  
2 4     4   22 use strict;
  4         8  
  4         135  
3 4     4   21 use warnings;
  4         16  
  4         635  
4              
5             package LV;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.006';
9              
10             BEGIN {
11 4         4118 *_subname = eval { require Sub::Name }
12             ? \&Sub::Name::subname
13 0         0 : sub { $_[1] }
14 4 50   4   11 };
15              
16 4     4   4288 use Exporter ();
  4         18  
  4         1799  
17             our @ISA = qw( Exporter );
18             our @EXPORT = qw( lvalue );
19             our @EXPORT_OK = qw( get set );
20              
21 15     15 1 67 sub get (&;@) { my $caller = (caller(1))[3]; get => _subname("$caller~get", shift), @_ }
  15         133  
22 15     15 1 6458 sub set (&;@) { my $caller = (caller(1))[3]; set => _subname("$caller~set", shift), @_ }
  15         216  
23              
24             {
25             my $i;
26            
27             sub implementation
28             {
29 3     3 1 36 return $i;
30             }
31            
32             sub _set_implementation
33             {
34 4     4   9 my $module = shift;
35 4 50       66 *lvalue = $module->can('lvalue') or do {
36 0         0 require Carp;
37 0         0 Carp::croak("$module does not appear to be an LV backend");
38             };
39 4         16 $i = $module;
40             }
41             }
42              
43             if ( $ENV{PERL_LV_IMPLEMENTATION} )
44             {
45             my $module = sprintf('LV::Backend::%s', $ENV{PERL_LV_IMPLEMENTATION});
46             eval "require $module; 1" or do {
47             require Carp;
48             Carp::croak("Could not load LV backend $module");
49             };
50             _set_implementation($module);
51             }
52              
53             else
54             {
55             my @implementations = qw(
56             LV::Backend::Sentinel
57             LV::Backend::Magic
58             LV::Backend::Tie
59             );
60            
61             for my $module (@implementations)
62             {
63             if (eval "require $module; 1")
64             {
65             _set_implementation($module);
66             last;
67             }
68             }
69             }
70              
71             unless (__PACKAGE__->can('lvalue'))
72             {
73             require Carp;
74             Carp::croak("No suitable backend found for lv");
75             }
76              
77             1;
78              
79             __END__
80              
81             =pod
82              
83             =encoding utf-8
84              
85             =for stopwords lvaluedness rvalue
86              
87             =head1 NAME
88              
89             LV - LV ♥ lvalue
90              
91             =head1 SYNOPSIS
92              
93             use LV qw( lvalue get set );
94            
95             my $xxx;
96             sub xxx :lvalue {
97             lvalue
98             get { $xxx }
99             set { $xxx = $_[0] }
100             }
101            
102             xxx() = 42;
103             say xxx(); # says 42
104              
105             =head1 DESCRIPTION
106              
107             This module makes lvalue subroutines easy and practical to use.
108             It's inspired by the L<lvalue> module which is sadly problematic
109             because of the existence of another module on CPAN called L<Lvalue>.
110             (They can get confused on file-systems that have case-insensitive
111             file names.)
112              
113             LV comes with three different implementations, based on
114             L<Variable::Magic>, L<Sentinel> and C<tie>; it will choose and
115             use the best available one. You can force LV to pick a particular
116             implementation using:
117              
118             $ENV{PERL_LV_IMPLEMENTATION} = 'Magic'; # or 'Sentinel' or 'Tie'
119              
120             The tie implementation is the slowest, but will work on Perl 5.6
121             with only core modules.
122              
123             =head2 Functions
124              
125             =over
126              
127             =item C<< lvalue(%args) >>
128              
129             Creates the magic lvalue. This must be the last expression evaluated
130             by the lvalue sub (and thus will be returned by the sub) but also
131             must not be returned using an explicit C<return> keyword (which would
132             break its lvaluedness).
133              
134             As a matter of style, you may like to omit the optional semicolon
135             after calling this function, which will act as a reminder that no
136             statement should follow this one.
137              
138             The arguments are C<get> and C<set>, which each take a coderef:
139              
140             sub xxx :lvalue {
141             lvalue(
142             get => sub { $xxx },
143             set => sub { $xxx = $_[0] },
144             ); # semicolon
145             }
146              
147             Note that the C<set> coderef gets passed the rvalue part as
148             C<< $_[0] >>.
149              
150             =item C<< get { BLOCK } >>, C<< set { BLOCK } >>
151              
152             Convenience functions for defining C<get> and C<set> arguments for
153             C<lvalue>:
154              
155             sub xxx :lvalue {
156             lvalue
157             get { $xxx }
158             set { $xxx = $_[0] }
159             }
160              
161             As well as populating C<< %args >> for C<lvalue>, these functions also
162             use L<Sub::Name> (if it's installed) to ensure that the anonymous
163             coderefs have sensible names for the purposes of stack traces, etc.
164              
165             These functions are not exported by default.
166              
167             =item C<< implementation() >>
168              
169             Can be used to determine the current backend.
170              
171             Cannot be exported.
172              
173             =back
174              
175             =head1 BUGS
176              
177             Please report any bugs to
178             L<http://rt.cpan.org/Dist/Display.html?Queue=LV>.
179              
180             =head1 SEE ALSO
181              
182             L<lvalue>, L<Sentinel>.
183              
184             =head1 AUTHOR
185              
186             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
187              
188             =head1 COPYRIGHT AND LICENCE
189              
190             This software is copyright (c) 2013 by Toby Inkster.
191              
192             This is free software; you can redistribute it and/or modify it under
193             the same terms as the Perl 5 programming language system itself.
194              
195             =head1 DISCLAIMER OF WARRANTIES
196              
197             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
198             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
199             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
200