File Coverage

blib/lib/Class/NonOO.pm
Criterion Covered Total %
statement 63 65 96.9
branch 7 8 87.5
condition 12 19 63.1
subroutine 11 11 100.0
pod 1 1 100.0
total 94 104 90.3


line stmt bran cond sub pod time code
1             package Class::NonOO;
2              
3             # ABSTRACT: Use methods as functions with an implicit singleton
4              
5 4     4   1458380 use v5.10.1;
  4         16  
6              
7 4     4   21 use strict;
  4         6  
  4         81  
8 4     4   20 use warnings;
  4         10  
  4         116  
9              
10 4     4   19 use Exporter qw/ import /;
  4         5  
  4         151  
11 4     4   3279 use List::MoreUtils qw/ uniq /;
  4         95910  
  4         31  
12 4     4   5509 use Package::Stash;
  4         602409  
  4         147  
13 4     4   34 use Scalar::Util qw/ blessed /;
  4         5  
  4         229  
14              
15             {
16 4     4   2652 use version;
  4         8204  
  4         25  
17             $Class::NonOO::VERSION = version->declare('v0.4.1');
18             }
19              
20             # RECOMMEND PREREQ: Package::Stash::XS 0
21              
22             =head1 NAME
23              
24             Class::NonOO - Use methods as functions with an implicit singleton
25              
26             =for readme plugin version
27              
28             =head1 SYNOPSYS
29              
30             In a module:
31              
32             package MyModule;
33              
34             use Class::NonOO;
35              
36             ...
37              
38             sub my_method {
39             my ($self, @args) = @_;
40             ...
41             }
42              
43             as_function
44             export => [ 'my_method' ], # methods to export
45             args => [ ]; # constructor args
46              
47             The module can be be used with a function calling style:
48              
49             use MyModule;
50              
51             ...
52              
53             my_method(@args);
54              
55             =begin :readme
56              
57             =head1 INSTALLATION
58              
59             See
60             L.
61              
62             =for readme plugin requires heading-level=2 title="Required Modules"
63              
64             =for readme plugin changes
65              
66             =end :readme
67              
68             =head1 DESCRIPTION
69              
70             This module allows you to turn a class into a module that exports
71             methods as functions that use an implicit singleton. This allows you
72             to provide a "hybrid" object-oriented/functional interface.
73              
74             =head1 EXPORTS
75              
76             =cut
77              
78             our @EXPORT = qw/ as_function _Class_NonOO_instance /;
79              
80             sub _Class_NonOO_instance {
81 40     40   65 my $class = shift;
82 40         54 my $user = shift;
83 40         53 state $symbol = '%_DEFAULT_SINGLETONS';
84 40         273 my $stash = Package::Stash->new($class);
85 40         316 my $instances = $stash->get_or_add_symbol($symbol);
86 40   66     246 return $instances->{$user} //= $class->new(@_);
87             }
88              
89             =head2 C
90              
91             as_function
92             export => [ ... ], # @EXPORT
93             export_ok => [ ... ], # @EXPORT_OK (optional)
94             export_tags => { ... }, # %EXPORT_TAGS (optional)
95             args => [ ... ], # constructor args (optional)
96             global => 0; # no global state (default)
97              
98             This wraps methods in a function that checks the first argument. If
99             the argument is an instance of the class, then it assumes it is a
100             normal method call. Otherwise it assumes it is a function call, and
101             it calls the method with the singleton instance.
102              
103             If the C option is omitted, it will default to the contents of
104             the C<@EXPORT> variable. The same holds for the C and
105             C options and the C<@EXPORT_OK> and C<%EXPORT_TAGS>
106             variables, respectively.
107              
108             Note that this will not work properly on methods that take an instance
109             of the class as the first argument.
110              
111             By default, there is no global state. That means that there is a
112             different implicit singleton for each namespace. This offers some
113             protection when the state is changed in one module, so that it does
114             not affect the state in another module.
115              
116             If you want to enable global state, you can set C to a true
117             value. This is not recommended for CPAN modules.
118              
119             You might work around this by using something like
120              
121             local %MyClass::_DEFAULT_SINGLETONS;
122              
123             but this is not recommended. If you need to modify state and share it
124             across modules, you should be passing around individual objects
125             instead of singletons.
126              
127             =cut
128              
129             sub as_function {
130 4     4 1 20492 my %opts = @_;
131              
132 4         17 my ($caller) = caller;
133 4         133 my $stash = Package::Stash->new($caller);
134              
135 4         64 my $export = $stash->get_or_add_symbol('@EXPORT');
136 4         25 my $export_ok = $stash->get_or_add_symbol('@EXPORT_OK');
137 4         30 my $export_tags = $stash->get_or_add_symbol('%EXPORT_TAGS');
138              
139 4   100     76 my $global = $opts{global} // 0;
140 4   50     9 my @args = @{ $opts{args} // [] };
  4         22  
141 4   66     7 my @export = @{ $opts{export} // $export };
  4         28  
142 4   66     15 my @export_ok = @{ $opts{export_ok} // $export_ok };
  4         25  
143 4   33     6 my %export_tags = %{ $opts{export_tags} // $export_tags };
  4         38  
144              
145 4         9 my %in_export_ok = map { $_ => 1 } @{$export_ok};
  1         3  
  4         10  
146              
147 4         32 foreach
148 0         0 my $name ( uniq @export, @export_ok, map { @$_ } values %export_tags )
149             {
150              
151 12         67 $stash->add_symbol( '&import', \&Exporter::import );
152              
153 12         29 my $symbol = '&' . $name;
154 12 50       68 if ( my $method = $stash->get_symbol($symbol) ) {
155              
156             my $new = sub {
157 120 100 66 120   31977 if ( blessed( $_[0] ) && $_[0]->isa($caller) ) {
158 80         259 return $method->(@_);
159             }
160             else {
161 40 100       143 my $user = $global ? 'default' : caller;
162 40         443 my $self = $caller->_Class_NonOO_instance( $user, @args );
163 40         208 return $self->$method(@_);
164             }
165 12         48 };
166 12         54 $stash->add_symbol( $symbol, $new );
167              
168 12 100       39 push @{$export_ok}, $name unless $in_export_ok{$name};
  11         39  
169             }
170             else {
171 0         0 die "No method named ${name}";
172             }
173             }
174              
175 4         16 push @{$export}, $_ for @export;
  9         23  
176              
177 4         43 $export_tags->{all} = $export_ok;
178             }
179              
180              
181             =head1 SEE ALSO
182              
183             L is a similar module.
184              
185             =head1 AUTHOR
186              
187             Robert Rothenberg, C<< >>
188              
189             =head1 LICENSE AND COPYRIGHT
190              
191             Copyright 2015-2016 Robert Rothenberg.
192              
193             This program is free software; you can redistribute it and/or modify it
194             under the terms of the the Artistic License (2.0). You may obtain a
195             copy of the full license at:
196              
197             L
198              
199             =for readme stop
200              
201             Any use, modification, and distribution of the Standard or Modified
202             Versions is governed by this Artistic License. By using, modifying or
203             distributing the Package, you accept this license. Do not use, modify,
204             or distribute the Package, if you do not accept this license.
205              
206             If your Modified Version has been derived from a Modified Version made
207             by someone other than you, you are nevertheless required to ensure that
208             your Modified Version complies with the requirements of this license.
209              
210             This license does not grant you the right to use any trademark, service
211             mark, tradename, or logo of the Copyright Holder.
212              
213             This license includes the non-exclusive, worldwide, free-of-charge
214             patent license to make, have made, use, offer to sell, sell, import and
215             otherwise transfer the Package with respect to any patent claims
216             licensable by the Copyright Holder that are necessarily infringed by the
217             Package. If you institute patent litigation (including a cross-claim or
218             counterclaim) against any party alleging that the Package constitutes
219             direct or contributory patent infringement, then this Artistic License
220             to you shall terminate on the date that such litigation is filed.
221              
222             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
223             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
224             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
225             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
226             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
227             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
228             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
229             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
230              
231             =for readme continue
232              
233             =cut
234              
235             1;