File Coverage

blib/lib/Acme/Constructor/Pythonic.pm
Criterion Covered Total %
statement 37 37 100.0
branch 21 26 80.7
condition 2 6 33.3
subroutine 7 7 100.0
pod n/a
total 67 76 88.1


line stmt bran cond sub pod time code
1 3     3   1224618 use 5.006;
  3         10  
  3         120  
2 3     3   18 use strict;
  3         6  
  3         100  
3 3     3   16 use warnings;
  3         10  
  3         85  
4              
5 3     3   3303 use Exporter::Tiny ();
  3         6497  
  3         164  
6              
7             package Acme::Constructor::Pythonic;
8              
9             BEGIN {
10 3     3   7 $Acme::Constructor::Pythonic::AUTHORITY = 'cpan:TOBYINK';
11 3         6 $Acme::Constructor::Pythonic::VERSION = '0.002';
12 3         1316 @Acme::Constructor::Pythonic::ISA = qw( Exporter::Tiny );
13             }
14              
15             sub import
16             {
17 4     4   17856 my $me = shift;
18 4 100       23 my $globals = ref($_[0]) eq 'HASH' ? shift() : {};
19            
20 4 50       23 unless (ref($globals->{into}))
21             {
22 4         20 my @caller = caller;
23 4 50       20 $globals->{into_file} = $caller[1] unless exists $globals->{into_file};
24 4 50       22 $globals->{into_line} = $caller[2] unless exists $globals->{into_line};
25             }
26            
27 4         14 unshift @_, $me, $globals;
28 4         25 goto \&Exporter::Tiny::import;
29             }
30              
31             my %_CACHE;
32             sub _exporter_expand_sub
33             {
34 5     5   428 my $me = shift;
35 5         9 my ($name, $args, $globals) = @_;
36            
37             # We want to be invisible to Carp
38 5         43 $Carp::Internal{$me} = 1;
39            
40             # Process incoming arguments, providing sensible defaults.
41 5         8 my $module = $name;
42 5 100       18 my $class = defined($args->{class}) ? $args->{class} : $name;
43 5 100       15 my $ctor = defined($args->{constructor}) ? $args->{constructor} : 'new';
44 5 100       13 my $alias = defined($args->{alias}) ? $args->{alias} : $name;
45 5 100       17 my $req = exists($args->{no_require}) ? !$args->{no_require} : !$globals->{no_require};
46            
47             # Doesn't really make sense to include a package name
48             # as part of the alias. We were just lazy in initializing
49             # the default above.
50 5 100       22 $alias = $1 if $alias =~ /::(\w+)\z/;
51            
52             # We really only need Module::Runtime if $req is on.
53             # $req is on by default, but in imagined case where
54             # the caller has been diligent enough to no_require
55             # every import, we can do them a favour and not
56             # needlessly load Module::Runtime into memory.
57 5 100       13 if ($req) { require Module::Runtime }
  2         10  
58            
59             # Compile a custom coderef instead of closing
60             # over variables.
61 5 50 33     83 my $code = join("\n",
    100          
62             sprintf('package %s;', $me),
63             defined($globals->{into_line}) && defined($globals->{into_file})
64             ? sprintf('#line %d "%s"', @$globals{qw(into_line into_file)})
65             : (),
66             sprintf('sub {'),
67             $req
68             ? sprintf('Module::Runtime::use_module(qq[%s]);', quotemeta($module))
69             : (),
70             sprintf('qq[%s]->%s(@_);', quotemeta($class), $ctor),
71             sprintf('}'),
72             );
73            
74             # Orcish maneuver
75             # This is not done for reasons of efficiency, but
76             # rather because if we're exporting the exact same
77             # sub twice, we want it to have the same refaddr.
78             # This reduces the chances of 'redefine' warnings,
79             # and conflicts (if our subs have been imported into
80             # roles).
81 5 50 33     410 my $coderef = ($_CACHE{"$class\034$ctor\034$req"} ||= eval($code))
82             or die("Something went horribly wrong!\n$code\n\n");
83            
84 5         92 return ($alias => $coderef);
85             }
86              
87             1;
88              
89             __END__
90              
91             =head1 NAME
92              
93             Acme::Constructor::Pythonic - import Python-style constructor functions
94              
95             =head1 SYNOPSIS
96              
97             use Acme::Constructor::Pythonic qw(
98             LWP::UserAgent
99             JSON
100             HTTP::Request
101             );
102            
103             my $json = JSON();
104             my $ua = UserAgent();
105             my $req = Request( GET => 'http://www.example.com/foo.json' );
106            
107             my $data = $json->decode( $ua->request($req)->content )
108              
109             =head1 DESCRIPTION
110              
111             In Python you import classes like this:
112              
113             import BankAccount from banking
114              
115             And you instantiate them with something looking like a function call:
116              
117             acct = BankAccount(9.99)
118              
119             This module allows Python-like object instantiation in Perl. The example in
120             the SYNOPSIS creates three functions C<UserAgent>, C<JSON> and <Request> each
121             of which just pass through their arguments to the real object constructors.
122              
123             =head2 Options
124              
125             Each argument to the Acme::Constructor::Pythonic is a Perl module name and
126             may be followed by a hashref of options:
127              
128             use Acme::Constructor::Pythonic
129             'A::Module',
130             'Another::Module' => \%some_options,
131             'Yes::Another::Module',
132             ;
133              
134             =over
135              
136             =item *
137              
138             B<class>
139              
140             The class to call the constructor on. This is normally the same as the module
141             name, and that's the default assumption, so there's no usually much point in
142             providing it.
143              
144             =item *
145              
146             B<constructor>
147              
148             The method name for the constructor. The default is C<new> which is usually
149             correct.
150              
151             =item *
152              
153             B<alias>
154              
155             The name of the function you want created for you. The default is the last
156             component of the module name, which is often sensible.
157              
158             =item *
159              
160             B<no_require>
161              
162             Acme::Constructor::Python will automatically load the module specified. Not
163             straight away; it waits until you actually perform an instantiation. If you
164             don't want Acme::Constructor::Python to load the module, then set this option
165             to true.
166              
167             =back
168              
169             =head1 BUGS
170              
171             Please report any bugs to
172             L<http://rt.cpan.org/Dist/Display.html?Queue=Acme-Constructor-Pythonic>.
173              
174             =head1 SEE ALSO
175              
176             L<aliased>.
177              
178             =head1 AUTHOR
179              
180             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
181              
182             (Though it was SSCAFFIDI's idea.)
183              
184             =head1 COPYRIGHT AND LICENCE
185              
186             This software is copyright (c) 2012, 2014 by Toby Inkster.
187              
188             This is free software; you can redistribute it and/or modify it under
189             the same terms as the Perl 5 programming language system itself.
190              
191             =head1 DISCLAIMER OF WARRANTIES
192              
193             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
194             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
195             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
196