public
Last active

As per Hercynium's suggestion...

  • Download Gist
AcmeConstructorPythonic.pm
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
use strict;
use warnings;
 
BEGIN {
package Acme::Constructor::Pythonic;
no thanks;
use Data::OptList qw(mkopt);
use Sub::Install qw(install_sub);
use Module::Runtime qw(use_module);
sub import {
shift;
my $caller = caller;
for my $arg (@{ mkopt(\@_) })
{
my ($class, $opts) = @$arg;
$opts->{class} = $class unless defined $opts->{class};
$opts->{constructor} = 'new' unless defined $opts->{constructor};
$opts->{alias} = $class unless defined $opts->{alias};
if ($opts->{alias} =~ /::(\w+)$/) {
$opts->{alias} = $1;
}
install_sub {
into => $caller,
as => $opts->{alias},
code => sub {
use_module($opts->{class}) unless $opts->{no_require};
my $method = $opts->{class}->can($opts->{constructor});
unshift @_, $opts->{class};
goto $method;
}
}
}
}
}
 
# Simple example
#
 
use Acme::Constructor::Pythonic qw( LWP::UserAgent HTTP::Request );
 
my $req = Request(GET => 'http://www.example.com/');
my $ua = UserAgent();
my $res = $ua->request($req);
print $res->message, "\n";
 
# More complex example
#
 
{
package Foo;
sub create { bless [], shift };
sub method { return "OK" };
}
 
use Acme::Constructor::Pythonic
Foo => { no_require => 1, constructor => 'create', alias => 'Bar' };
 
my $foo = Bar();
print $foo->method, "\n";

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.