File Coverage

blib/lib/Class/NonOO.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Class::NonOO;
2             $Class::NonOO::VERSION = 'v0.3.0';
3             # ABSTRACT: Use methods as functions with an implicit singleton
4              
5 3     3   134013 use v5.10.1;
  3         11  
  3         114  
6              
7 3     3   13 use strict;
  3         3  
  3         66  
8 3     3   10 use warnings;
  3         12  
  3         93  
9              
10 3     3   12 use Exporter qw/ import /;
  3         3  
  3         78  
11 3     3   2057 use List::MoreUtils qw/ uniq /;
  0            
  0            
12             use Package::Stash;
13             use Scalar::Util qw/ blessed /;
14              
15             {
16             use version;
17             $Class::NonOO::VERSION = version->declare('v0.3.0');
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.
72              
73             =head1 EXPORTS
74              
75             =cut
76              
77             our @EXPORT = qw/ as_function _Class_NonOO_instance /;
78              
79             sub _Class_NonOO_instance {
80             my $class = shift;
81             my $user = shift;
82             state $symbol = '%_DEFAULT_SINGLETONS';
83             my $stash = Package::Stash->new($class);
84             my $instances = $stash->get_or_add_symbol($symbol);
85             return $instances->{$user} //= $class->new(@_);
86             }
87              
88             =head2 C
89              
90             as_function
91             export => [ ... ], # @EXPORT
92             export_ok => [ ... ], # @EXPORT_OK (optional)
93             export_tags => { ... }, # %EXPORT_TAGS (optional)
94             args => [ ... ], # constructor args (optional)
95             global => 0; # no global state (default)
96              
97             This wraps methods in a function that checks the first argument. If
98             the argument is an instance of the class, then it assumes it is a
99             normal method call. Otherwise it assumes it is a function call, and
100             it calls the method with the singleton instance.
101              
102             Note that this will not work properly on methods that take an instance
103             of the class as the first argument.
104              
105             By default, there is no global state. That means that there is a
106             different implicit singleton for each namespace. This offers some
107             protection when the state is changed in one module, so that it does
108             not affect the state in another module.
109              
110             If you want to enable global state, you can set C to a true
111             value. This is not recommended for CPAN modules.
112              
113             You might work around this by using something like
114              
115             local %MyClass::_DEFAULT_SINGLETONS;
116              
117             but this is not recommended. If you need to modify state and share it
118             across modules, you should be passing around individual objects
119             instead of singletons.
120              
121             =cut
122              
123             sub as_function {
124             my %opts = @_;
125              
126             my $global = $opts{global} // 0;
127             my @args = @{ $opts{args} // [] };
128             my @export = @{ $opts{export} // [] };
129             my @export_ok = @{ $opts{export_ok} // [] };
130             my %export_tags = %{ $opts{export_tags} // {} };
131              
132             my ($caller) = caller;
133             my $stash = Package::Stash->new($caller);
134              
135             my $export = $stash->get_or_add_symbol('@EXPORT');
136             my $export_ok = $stash->get_or_add_symbol('@EXPORT_OK');
137             my $export_tags = $stash->get_or_add_symbol('%EXPORT_TAGS');
138              
139             foreach
140             my $name ( uniq @export, @export_ok, map { @$_ } values %export_tags )
141             {
142              
143             $stash->add_symbol( '&import', \&Exporter::import );
144              
145             my $symbol = '&' . $name;
146             if ( my $method = $stash->get_symbol($symbol) ) {
147              
148             my $new = sub {
149             if ( blessed( $_[0] ) && $_[0]->isa($caller) ) {
150             return $method->(@_);
151             }
152             else {
153             my $user = $global ? 'default' : caller;
154             my $self = $caller->_Class_NonOO_instance( $user, @args );
155             return $self->$method(@_);
156             }
157             };
158             $stash->add_symbol( $symbol, $new );
159              
160             push @{$export_ok}, $name;
161             }
162             else {
163             die "No method named ${name}";
164             }
165             }
166              
167             push @{$export}, $_ for @export;
168              
169             $export_tags->{all} = $export_ok;
170             }
171              
172             =head1 AUTHOR
173              
174             Robert Rothenberg, C<< >>
175              
176             =head1 LICENSE AND COPYRIGHT
177              
178             Copyright 2015 Robert Rothenberg.
179              
180             This program is free software; you can redistribute it and/or modify it
181             under the terms of the the Artistic License (2.0). You may obtain a
182             copy of the full license at:
183              
184             L
185              
186             =for readme stop
187              
188             Any use, modification, and distribution of the Standard or Modified
189             Versions is governed by this Artistic License. By using, modifying or
190             distributing the Package, you accept this license. Do not use, modify,
191             or distribute the Package, if you do not accept this license.
192              
193             If your Modified Version has been derived from a Modified Version made
194             by someone other than you, you are nevertheless required to ensure that
195             your Modified Version complies with the requirements of this license.
196              
197             This license does not grant you the right to use any trademark, service
198             mark, tradename, or logo of the Copyright Holder.
199              
200             This license includes the non-exclusive, worldwide, free-of-charge
201             patent license to make, have made, use, offer to sell, sell, import and
202             otherwise transfer the Package with respect to any patent claims
203             licensable by the Copyright Holder that are necessarily infringed by the
204             Package. If you institute patent litigation (including a cross-claim or
205             counterclaim) against any party alleging that the Package constitutes
206             direct or contributory patent infringement, then this Artistic License
207             to you shall terminate on the date that such litigation is filed.
208              
209             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
210             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
211             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
212             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
213             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
214             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
215             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
216             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
217              
218             =for readme continue
219              
220             =cut
221              
222             1;