MooX-Thunking-0.08/0000755000076400007640000000000013243700714012637 5ustar useruserMooX-Thunking-0.08/META.json0000644000076400007640000000304313243700714014260 0ustar useruser{ "abstract" : "Allow Moo attributes to be \"thunked\"", "author" : [ "Ed J " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150005", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "MooX-Thunking", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::CheckManifest" : "0.9", "Test::Pod" : "1.22", "Test::Pod::Coverage" : "1.08" } }, "runtime" : { "requires" : { "Moo" : "0", "Type::Tiny" : "0", "perl" : "5.014" } }, "test" : { "requires" : { "Test::Exception" : "0.42", "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "web" : "https://github.com/mohawk2/moox-thunking" }, "x_IRC" : "irc://irc.perl.org/#graphql-perl" }, "version" : "0.08", "x_serialization_backend" : "JSON::PP version 2.97000" } MooX-Thunking-0.08/MANIFEST0000644000076400007640000000054013243700714013767 0ustar useruserChanges lib/MooX/Thunking.pm Makefile.PL MANIFEST This list of files README.md t/basic-multi-attr.t t/basic-noisa.t t/basic-role.t t/basic.t xt/manifest.t xt/pod-coverage.t xt/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) MooX-Thunking-0.08/README.md0000644000076400007640000000156413153704702014125 0ustar useruser# NAME MooX::Thunking - Allow Moo attributes to be "thunked" # SYNOPSIS package Thunking; use Moo; use MooX::Thunking; use Types::TypeTiny -all; use Types::Standard -all; has children => ( is => 'thunked', isa => CodeLike | ArrayRef[InstanceOf['Thunking']], required => 1, ); package main; my $obj; $obj = Thunking->new(children => sub { [$obj] }); # DESCRIPTION This is a [Moo](https://metacpan.org/pod/Moo) extension. It allows another value for the `is` parameter to ["has" in Moo](https://metacpan.org/pod/Moo#has): "thunked". If used, this will allow you to transparently provide either a real value for the attribute, or a ["CodeLike" in Types::TypeTiny](https://metacpan.org/pod/Types::TypeTiny#CodeLike) that when called will return such a real value. # AUTHOR Ed J # LICENCE The same terms as Perl itself. MooX-Thunking-0.08/META.yml0000644000076400007640000000141213243700714014106 0ustar useruser--- abstract: 'Allow Moo attributes to be "thunked"' author: - 'Ed J ' build_requires: ExtUtils::MakeMaker: '0' Test::Exception: '0.42' Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150005' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MooX-Thunking no_index: directory: - t - inc requires: Moo: '0' Type::Tiny: '0' perl: '5.014' resources: IRC: irc://irc.perl.org/#graphql-perl license: http://dev.perl.org/licenses/ repository: https://github.com/mohawk2/moox-thunking version: '0.08' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' MooX-Thunking-0.08/xt/0000755000076400007640000000000013243700714013272 5ustar useruserMooX-Thunking-0.08/xt/pod.t0000644000076400007640000000053613153702221014240 0ustar useruser#!perl -T use 5.014; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); MooX-Thunking-0.08/xt/pod-coverage.t0000644000076400007640000000125013153702221016023 0ustar useruser#!perl -T use 5.014; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); MooX-Thunking-0.08/xt/manifest.t0000644000076400007640000000047013153702221015261 0ustar useruser#!perl -T use 5.014; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } my $min_tcm = 0.9; eval "use Test::CheckManifest $min_tcm"; plan skip_all => "Test::CheckManifest $min_tcm required" if $@; ok_manifest(); MooX-Thunking-0.08/Changes0000644000076400007640000000117713243700642014140 0ustar useruser0.08 Fri Feb 23 02:50:56 GMT 2018 - avoid pollute global $@ - found by @nohuhu 0.07 Fri Sep 15 16:02:26 BST 2017 - no more need for `isa` to pass `CodeLike` 0.06 Fri Sep 15 14:55:20 BST 2017 - support multiple attributes per `has` 0.05 Tue Sep 12 04:40:22 BST 2017 - test, fix working with non-thunk value 0.04 Tue Sep 12 03:12:48 BST 2017 - use 'rwp' setter - add test of validation 0.03 Wed Sep 6 07:39:03 BST 2017 - switch back to "before" technique so works with roles - add test of roles behaviour 0.02 Wed Sep 6 06:36:49 BST 2017 - switch to BUILDARGS technique 0.01 Wed Sep 6 06:36:49 BST 2017 - initial release MooX-Thunking-0.08/lib/0000755000076400007640000000000013243700714013405 5ustar useruserMooX-Thunking-0.08/lib/MooX/0000755000076400007640000000000013243700714014267 5ustar useruserMooX-Thunking-0.08/lib/MooX/Thunking.pm0000644000076400007640000000505113243700663016420 0ustar useruserpackage MooX::Thunking; our $VERSION = '0.08'; # this bit would be MooX::Utils but without initial _ on func name use strict; use warnings; use Moo (); use Moo::Role (); use Carp qw(croak); #use base qw(Exporter); #our @EXPORT = qw(override_function); sub _override_function { my ($target, $name, $func) = @_; my $orig = $target->can($name) or croak "Override '$target\::$name': not found"; my $install_tracked = Moo::Role->is_role($target) ? \&Moo::Role::_install_tracked : \&Moo::_install_tracked; $install_tracked->($target, $name, sub { $func->($orig, @_) }); } # end MooX::Utils; use Types::TypeTiny -all; use Type::Utils -all; use Class::Method::Modifiers qw(install_modifier); sub import { my $target = scalar caller; _override_function($target, 'has', sub { my ($orig, $namespec, %opts) = @_; $orig->($namespec, %opts), return if $opts{is} ne 'thunked'; $opts{is} = 'rwp'; $opts{isa} = union [ CodeLike, $opts{isa} ] if $opts{isa}; $orig->($namespec, %opts); # so we have method to modify for my $name (ref $namespec ? @$namespec : $namespec) { my $resolved_name = "_${name}_resolved"; $orig->($resolved_name, is => 'rw'); # cache whether resolved install_modifier $target, 'before', $name => sub { my $self = shift; return if @_; # attempt at setting, hand to auto return if $self->$resolved_name; # already resolved $self->$resolved_name(1); local $@; return if !eval { CodeLike->($self->{$name}); 1 }; # not a thunk my $setter = "_set_$name"; $self->$setter($self->{$name}->()); }; } }); } =head1 NAME MooX::Thunking - Allow Moo attributes to be "thunked" =head1 SYNOPSIS package Thunking; use Moo; use MooX::Thunking; use Types::TypeTiny -all; use Types::Standard -all; has children => ( is => 'thunked', isa => ArrayRef[InstanceOf['Thunking']], required => 1, ); package main; my $obj; $obj = Thunking->new(children => sub { [$obj] }); =head1 DESCRIPTION This is a L extension. It allows another value for the C parameter to L: "thunked". If used, this will allow you to transparently provide either a real value for the attribute, or a L that when called will return such a real value. Note that in earlier versions of this module (up to 0.06), any C had to pass a C. This is now taken care of by this module. It will continue to do the right thing if no C is supplied. =head1 AUTHOR Ed J =head1 LICENCE The same terms as Perl itself. =cut 1; MooX-Thunking-0.08/Makefile.PL0000644000076400007640000000225013153702340014605 0ustar useruseruse 5.014; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'MooX::Thunking', AUTHOR => q{Ed J }, VERSION_FROM => 'lib/MooX/Thunking.pm', ABSTRACT_FROM => 'lib/MooX/Thunking.pm', LICENSE => 'artistic_2', MIN_PERL_VERSION => '5.014', CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '0', }, TEST_REQUIRES => { 'Test::More' => '0.88', # done_testing 'Test::Exception' => '0.42', }, PREREQ_PM => { 'Moo' => '0', 'Type::Tiny' => '0', }, clean => { FILES => 'MooX-Thunking-*' }, META_MERGE => { "meta-spec" => { version => 2 }, dynamic_config => 0, resources => { x_IRC => 'irc://irc.perl.org/#graphql-perl', repository => { type => 'git', url => 'git@github.com:mohawk2/moox-thunking.git', web => 'https://github.com/mohawk2/moox-thunking', }, license => [ 'http://dev.perl.org/licenses/' ], }, prereqs => { develop => { requires => { 'Test::CheckManifest' => '0.9', 'Test::Pod::Coverage' => '1.08', 'Test::Pod' => '1.22', }, }, }, }, ); MooX-Thunking-0.08/t/0000755000076400007640000000000013243700714013102 5ustar useruserMooX-Thunking-0.08/t/basic-role.t0000644000076400007640000000072613156766017015327 0ustar useruseruse Test::More; BEGIN { $INC{'ThunkingRole.pm'} = 1; package ThunkingRole; use Moo::Role; use Test::More; BEGIN { use_ok('MooX::Thunking') } use Types::Standard -all; use Types::TypeTiny -all; has children => ( is => 'thunked', isa => ArrayRef[InstanceOf['Thunking']], required => 1, ); } package Thunking; use Moo; with 'ThunkingRole'; package main; my $obj; $obj = Thunking->new(children => sub { [$obj] }); is_deeply $obj->children, [ $obj ]; done_testing; MooX-Thunking-0.08/t/basic-noisa.t0000644000076400007640000000063013156765737015501 0ustar useruseruse Test::More; package Thunking; use Moo; use Test::More; BEGIN { use_ok('MooX::Thunking') } use Types::Standard -all; use Types::TypeTiny -all; has children => ( is => 'thunked', required => 1, ); package main; my $obj; $obj = Thunking->new(children => sub { [$obj] }); is_deeply $obj->children, [ $obj ]; $obj = Thunking->new(children => [$obj]); is_deeply $obj->children, [ $obj ]; done_testing; MooX-Thunking-0.08/t/basic.t0000644000076400007640000000134713243700335014354 0ustar useruseruse Test::More; package Thunking; use Moo; use Test::More; BEGIN { use_ok('MooX::Thunking') } use Types::Standard -all; use Types::TypeTiny -all; has children => ( is => 'thunked', isa => ArrayRef[InstanceOf['Thunking']], required => 1, ); package main; my $obj; $obj = Thunking->new(children => sub { [$obj] }); is_deeply $obj->children, [ $obj ]; $obj = Thunking->new(children => [$obj]); $@ = ''; is_deeply $obj->children, [ $obj ]; is $@, '', '$@ still empty'; $obj = Thunking->new(children => sub { { key => 'delayed wrong type' } }); eval { $obj->children }; isnt $@, '', 'exception on wrong type from thunk'; eval { Thunking->new(children => { key => 'wrong type' }) }; isnt $@, '', 'exception on wrong type'; done_testing; MooX-Thunking-0.08/t/basic-multi-attr.t0000644000076400007640000000127513156766017016470 0ustar useruseruse Test::More; package Thunking; use Moo; use Test::More; BEGIN { use_ok('MooX::Thunking') } use Types::Standard -all; use Types::TypeTiny -all; has [qw(children parent)] => ( is => 'thunked', isa => ArrayRef[InstanceOf['Thunking']], ); package main; my $obj; $obj = Thunking->new(children => sub { [$obj] }); is_deeply $obj->children, [ $obj ]; $obj = Thunking->new(children => [$obj]); is_deeply $obj->children, [ $obj ]; $obj = Thunking->new(children => sub { { key => 'delayed wrong type' } }); eval { $obj->children }; isnt $@, '', 'exception on wrong type from thunk'; eval { Thunking->new(children => { key => 'wrong type' }) }; isnt $@, '', 'exception on wrong type'; done_testing;