Object-Lazy-0.16000755000000000000 013625326502 14116 5ustar00unknownunknown000000000000Object-Lazy-0.16/META.json000444000000000000 336613625326500 15702 0ustar00unknownunknown000000000000{ "abstract" : "Object::Lazy - create objects late from non-owned classes", "author" : [ "Steffen Winkler " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4218", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Object-Lazy", "prereqs" : { "build" : { "requires" : { "Cwd" : "0", "Params::Validate" : "0", "Test::Differences" : "0.60", "Test::Exception" : "0", "Test::More" : "0", "Test::NoWarnings" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.42" } }, "runtime" : { "recommends" : { "Test::Pod" : "1.14", "Test::Pod::Coverage" : "1.04" }, "requires" : { "Carp" : "0", "Try::Tiny" : "0", "perl" : "5.006" } } }, "provides" : { "Object::Lazy" : { "file" : "lib/Object/Lazy.pm", "version" : "0.16" }, "Object::Lazy::Ref" : { "file" : "lib/Object/Lazy/Ref.pm", "version" : "0.12" }, "Object::Lazy::Validate" : { "file" : "lib/Object/Lazy/Validate.pm", "version" : "0.12" }, "Object::Lazy::Version" : { "file" : "lib/Object/Lazy.pm" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.16", "x_serialization_backend" : "JSON::PP version 2.27400" } Object-Lazy-0.16/MANIFEST000444000000000000 111713625326500 15402 0ustar00unknownunknown000000000000Changes example/01_short_constructor.pl example/02_extended_constructor.pl example/03_isa.pl example/04_DOES.pl example/05_VERSION.pl example/06_ref.pl lib/Object/Lazy.pm lib/Object/Lazy/Ref.pm lib/Object/Lazy/Validate.pm MANIFEST This list of files README t/01_use.t t/02_method.t t/03_can.t t/04_isa.t t/05_given_isa.t t/06_DOES.t t/07_given_DOES.t t/08_VERSION.t t/09_given_VERSION.t t/10_ref.t t/11_logger.t t/12_no_ref.t t/13_wrapped.t t/14_call_by_reference.t t/15_test_examples.t t/chars.t t/perl_critic.t t/pod.t t/pod_coverage.t t/prereq_build.t Makefile.PL META.yml META.json Object-Lazy-0.16/Changes000444000000000000 271013625326310 15543 0ustar00unknownunknown000000000000Revision history for Perl extension Object::Lazy. 0.16 Wed Feb 26 00:23:38 2020 - https://rt.cpan.org/Ticket/Display.html?id=131817 0.15 Mon Jul 6 22:51:19 2015 - fixed POD errors, thanks MAUKE 0.14 Sat Aug 31 15:44:11 2013 - https://rt.cpan.org/Public/Bug/Display.html?id=87867 0.13 Wed Sep 26 06:29:56 2012 - https://rt.cpan.org/Ticket/Display.html?id=79720 0.12 Sat Aug 18 20:03:37 2012 - https://rt.cpan.org/Public/Bug/Display.html?id=77170 - Build.PL no longer in distribution - use Try::Tiny instead of eval - a name for the builder code reference 0.11 Tue May 15 18:48:37 2012 - added lost dependency 0.10 Sat May 12 21:18:29 2012 - repaired Makefile.PL 0.09 Mon Nov 15 22:59:46 2010 - missing build dependency Test::Differences fixed 0.08 Sun Nov 14 07:57:05 2010 - methods DOES and VERSION implemented 0.07 Wed Sep 29 05:20:56 2010 - write back object on every build see RT ticket 61506 - Kevin Ryde - can() coderef return 0.06 Tue Jun 02 22:15:00 2009 - bugfix build dependencies 0.05 Fri May 29 21::00:00 2009 - bugfix build dependencies 0.04 Thu May 21 22::00:00 2009 - Perl critic - temporary fallback to the old *CORE::GLOBAL::ref (stored at compile time) and not bail out to *CORE::ref 0.03 Sat Aug 02 20:00:00 2008 - repair POD - add example - better Kwalitee 0.02 Sun Nov 25 23:00:00 2007 - Build.pl renamed to Build.PL 0.01 Fri Nov 11 19:00:00 2007 - fist version Object-Lazy-0.16/README000444000000000000 170412546556004 15140 0ustar00unknownunknown000000000000Object::Lazy version 0.15 ========================= Create objects late from non-owned classes. This module implements lazy evaluation and can create lazy objects from every class. Creates a dummy object including a subroutine which knows how to build the real object. Later, if a method of the object is called, the real object will be built. Inherited methods from UNIVERSAL.pm are implemented and so overwritten. This are isa, DOES, can and VERSION. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Carp English Params::Validate COPYRIGHT AND LICENCE Copyright (c) 2007 - 2015, Steffen Winkler steffenw at cpan.org. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Object-Lazy-0.16/META.yml000444000000000000 213213625326500 15520 0ustar00unknownunknown000000000000--- abstract: 'Object::Lazy - create objects late from non-owned classes' author: - 'Steffen Winkler ' build_requires: Cwd: '0' Params::Validate: '0' Test::Differences: '0.60' Test::Exception: '0' Test::More: '0' Test::NoWarnings: '0' configure_requires: Module::Build: '0.42' dynamic_config: 1 generated_by: 'Module::Build version 0.4218, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Object-Lazy provides: Object::Lazy: file: lib/Object/Lazy.pm version: '0.16' Object::Lazy::Ref: file: lib/Object/Lazy/Ref.pm version: '0.12' Object::Lazy::Validate: file: lib/Object/Lazy/Validate.pm version: '0.12' Object::Lazy::Version: file: lib/Object/Lazy.pm recommends: Test::Pod: '1.14' Test::Pod::Coverage: '1.04' requires: Carp: '0' Try::Tiny: '0' perl: '5.006' resources: license: http://dev.perl.org/licenses/ version: '0.16' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Object-Lazy-0.16/Makefile.PL000444000000000000 121513625326477 16237 0ustar00unknownunknown000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4218 require 5.006; use ExtUtils::MakeMaker; WriteMakefile ( 'PREREQ_PM' => { 'Test::Differences' => '0.60', 'Try::Tiny' => 0, 'Carp' => 0, 'Params::Validate' => 0, 'Cwd' => 0, 'Test::Exception' => 0, 'Test::NoWarnings' => 0, 'Test::More' => 0 }, 'PL_FILES' => {}, 'EXE_FILES' => [], 'NAME' => 'Object::Lazy', 'INSTALLDIRS' => 'site', 'VERSION_FROM' => 'lib/Object/Lazy.pm' ) ; Object-Lazy-0.16/t000755000000000000 013625326502 14361 5ustar00unknownunknown000000000000Object-Lazy-0.16/t/prereq_build.t000444000000000000 101111753522006 17346 0ustar00unknownunknown000000000000#!perl use strict; use warnings; use Test::More; $ENV{RELEASE_TESTING} or plan( skip_all => 'Author test. Set $ENV{RELEASE_TESTING} to a true value to run.' ); eval 'use Test::Prereq::Build; 1' or plan( skip_all => 'Test::Prereq::Build not installed' ); # These modules should not go into Build.PL my @skip_devel_only = qw( Test::Kwalitee Test::Perl::Critic Test::Prereq::Build ); my @skip = ( @skip_devel_only, ); prereq_ok( undef, undef, \@skip ); Object-Lazy-0.16/t/perl_critic.t000444000000000000 51612546534232 17166 0ustar00unknownunknown000000000000#!perl use strict; use warnings; use Test::More; eval 'use Test::Perl::Critic -severity => 1; 1' or plan( skip_all => 'Test::Perl::Critic required' ); $ENV{AUTHOR_TESTING} or plan( skip_all => 'Author test. Set $ENV{AUTHOR_TESTING} to a true value to run.' ); all_critic_ok( qw( lib example ) ); Object-Lazy-0.16/t/07_given_DOES.t000444000000000000 172212026067632 17135 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More; BEGIN { UNIVERSAL->can('DOES') or plan( skip_all => 'UNIVERSAL 1.04 (Perl 5.10) required for method DOES' ); plan( tests => 3 + 1 ); } use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new({ build => \&TestSample::create_object, DOES => [qw(NotExists TestSample)], }); ok( $object->DOES('NotExists'), 'parameter DOES is qw(NotExists TestSample)', ); # ask class about DOES @TestSample::ISA = qw(TestBase); ok( $object->DOES('TestBase'), 'base class of TestSample', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } # it's a sub, not a method sub create_object { return TestSample->new; } #----------------------------------------------------------------------------- package TestBase; Object-Lazy-0.16/t/06_DOES.t000444000000000000 155012026067640 15742 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More; BEGIN { UNIVERSAL->can('DOES') or plan( skip_all => 'UNIVERSAL 1.04 (Perl 5.10) required for method DOES' ); plan( tests => 4 + 1 ); } use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new(\&TestSample::create_object); isa_ok( $object, 'TestSample', 'the lazy object is a TestSample too', ); is( ref $object, 'Object::Lazy', 'ref object is Object::Lazy', ); $object->DOES('TestSample'); is( ref $object, 'TestSample', 'ref object is TestSample now', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/t/01_use.t000444000000000000 22211450520632 15745 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 1 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } Object-Lazy-0.16/t/04_isa.t000444000000000000 133012026067424 15756 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 4 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new(\&TestSample::create_object); isa_ok( $object, 'TestSample', 'the lazy object is a TestSample too', ); is( ref $object, 'Object::Lazy', 'ref object is Object::Lazy', ); $object->isa('TestSample'); is( ref $object, 'TestSample', 'ref object is TestSample now', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/t/03_can.t000444000000000000 114312026067434 15745 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 3 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new(\&TestSample::create_object); ok( $object->can('method'), 'can method', ); is( ref $object, 'TestSample', 'ref object is TestSample', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } sub method { return; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/t/15_test_examples.t000444000000000000 1275113625325734 20121 0ustar00unknownunknown000000000000#!perl use strict; use warnings; use Test::More; use Test::Differences; use Cwd qw(getcwd chdir); use English qw(-no_match_vars $CHILD_ERROR); $ENV{AUTHOR_TESTING} or plan( skip_all => 'Set $ENV{AUTHOR_TESTING} to run this test.' ); plan(tests => 6); my @data = ( { test => '01_short_constructor', path => 'example', script => '-I../lib -T 01_short_constructor.pl', result => <<'EOT', condition = 0 object = Object::Lazy=HASH(...) $my_dump = 'data'; condition = 1 object = Data::Dumper=HASH(...) EOT }, { test => '02_extended_constructor', path => 'example', script => '-I../lib -T 02_extended_constructor.pl', result => <<'EOT', condition = 0 object = Object::Lazy=HASH(...) Data::Dumper object built at ../lib/Object/Lazy.pm line 35. \tObject::Lazy::try {...} () called at Perl/site/lib/Try/Tiny.pm line \teval {...} called at Perl/site/lib/Try/Tiny.pm line \tTry::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 \tObject::Lazy::BUILD_OBJECT(Data::Dumper=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 \tObject::Lazy::AUTOLOAD(Data::Dumper=HASH(...)) called at 02_extended_constructor.pl line 29 \tmain::do_something_with(Data::Dumper=HASH(...), 1) called at 02_extended_constructor.pl line 45 $my_dump = 'data'; condition = 1 object = Data::Dumper=HASH(...) EOT }, { test => '03_isa', path => 'example', script => '-I../lib -T 03_isa.pl', result => <<'EOT', 1 = $object->isa('RealClass'); 1 = $object->isa('BaseClassOfRealClass'); RealClass object built at ../lib/Object/Lazy.pm line 35. \tObject::Lazy::try {...} () called at Perl/site/lib/Try/Tiny.pm line \teval {...} called at Perl/site/lib/Try/Tiny.pm line \tTry::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 \tObject::Lazy::BUILD_OBJECT(RealClass=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 \tObject::Lazy::AUTOLOAD(RealClass=HASH(...)) called at 03_isa.pl line 38 # Method output called! EOT }, { test => '04_DOES', path => 'example', script => '-I../lib -T 04_DOES.pl', result => <<'EOT', 1 = $object->DOES('RealClass'); 1 = $object->DOES('Role'); RealClass object built at ../lib/Object/Lazy.pm line 35. \tObject::Lazy::try {...} () called at Perl/site/lib/Try/Tiny.pm line \teval {...} called at Perl/site/lib/Try/Tiny.pm line \tTry::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 \tObject::Lazy::BUILD_OBJECT(RealClass=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 \tObject::Lazy::AUTOLOAD(RealClass=HASH(...)) called at 04_DOES.pl line 39 # Method output called! EOT }, { test => '05_VERSION', path => 'example', script => '-I../lib -T 05_VERSION.pl', result => <<'EOT', Data::Dumper version 9999 required--this is only version ... at ../lib/Object/Lazy.pm line 124. 11.12.13 = $object_2->VERSION( qv(11.12.13') ) Real object 1 object built at ../lib/Object/Lazy.pm line 35. \tObject::Lazy::try {...} () called at Perl/site/lib/Try/Tiny.pm line \teval {...} called at Perl/site/lib/Try/Tiny.pm line \tTry::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at Perl/site/lib/Try/Tiny.pm line \teval {...} called at Perl/site/lib/Try/Tiny.pm line \tTry::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 \tObject::Lazy::BUILD_OBJECT(Data::Dumper=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 \tObject::Lazy::AUTOLOAD(Data::Dumper=HASH(...)) called at 05_VERSION.pl line 51 EOT }, { test => '06_ref', path => 'example', script => '-I../lib -T 06_ref.pl', result => <<'EOT', RealClass = ref $object; RealClass object built at ../lib/Object/Lazy.pm line 35. \tObject::Lazy::try {...} () called at Perl/site/lib/Try/Tiny.pm line \teval {...} called at Perl/site/lib/Try/Tiny.pm line \tTry::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 \tObject::Lazy::BUILD_OBJECT(RealClass=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 110 \tObject::Lazy::can(RealClass=HASH(...), "new") called at 06_ref.pl line 27 CODE(...) = $object->can('new') EOT } ); for my $data (@data) { # run example my $dir = getcwd; chdir("$dir/$data->{path}"); my $result = qx{perl $data->{script} 2>&1}; $CHILD_ERROR and die "Couldn't run $data->{script} (status $CHILD_ERROR)"; chdir($dir); # normalize reference addresses $result =~ s{ ( SCALAR | ARRAY | HASH | CODE | REF ) \( 0x [0-9a-f]+ \) } {$1(...)}xmsg; # normalize version number $result =~ s{ ( \Qthis is only version\E ) \s+ \S+ } {$1 ...}xms; # ignore Try::Tiny line numbers $result =~ s{ ( \Q/lib/Try/Tiny.pm line\E ) \s+ \d+ }{$1}xmsg; # ignore Perl root path $result =~ s{ ( \Qcalled at\E \s+ ) .*? [/] ( Perl/ ) }{$1$2}xmsg; # interpolate tab only $data->{result} =~ s{\\t}{\t}xmsg; SKIP: { if ( UNIVERSAL->can('DOES') ) { eq_or_diff( $result, $data->{result}, $data->{test}, ); } else { skip('UNIVERSAL 1.04 (Perl 5.10) required for method DOES', 1); } } } Object-Lazy-0.16/t/11_logger.t000444000000000000 142112026067542 16461 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 2 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new({ build => \&TestSample::create_object, isa => [qw(NotExists TestSample)], }); # logger $object = Object::Lazy->new({ build => \&TestSample::create_object, logger => sub { like +shift, qr{\A\Qobject built at}xms, 'test log message', }, }); $object->method; #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } sub method { return; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/t/pod_coverage.t000444000000000000 33211716207672 17323 0ustar00unknownunknown000000000000#!perl -T use strict; use warnings; use Test::More; eval 'use Test::Pod::Coverage 1.04; 1' or plan( skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage' ); all_pod_coverage_ok(); Object-Lazy-0.16/t/05_given_isa.t000444000000000000 150712026067650 17156 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 3 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new({ build => \&TestSample::create_object, isa => [qw(NotExists TestSample)], }); isa_ok( $object, 'NotExists', 'parameter isa is qw(NotExists TestSample)', ); # ask class about isa @TestSample::ISA = qw(TestBase); isa_ok( $object, 'TestBase', 'base class of TestSample', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } # it's a sub, not a method sub create_object { return TestSample->new; } #----------------------------------------------------------------------------- package TestBase; Object-Lazy-0.16/t/12_no_ref.t000444000000000000 164312026067472 16463 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 3 + 1; use Test::NoWarnings; use Test::Exception; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new({ build => \&TestSample::create_object, isa => [qw(NotExists TestSample)], }); throws_ok( sub { $object = Object::Lazy->new({ build => \&TestSample::create_object, ref => 'MyClass', }); }, qr{\Qdepends use Object::Lazy::Ref}xms, 'error at paramater ref', ); $object = Object::Lazy->new({ build => \&TestSample::create_object, }); is( ref $object, 'Object::Lazy', 'ref is Object::Lazy', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/t/08_VERSION.t000444000000000000 114712026067622 16341 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 3 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } $TestSample::VERSION = '123'; my $object = Object::Lazy->new(\&TestSample::create_object); is( $object->VERSION, '123', 'VERSION', ); is( ref $object, 'TestSample', 'ref object is TestSample', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/t/02_method.t000444000000000000 204012026066372 16460 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 6 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $object = Object::Lazy->new(\&TestSample::create_object); my_sub($object); sub my_sub { my $object = shift; is( ref $object, 'Object::Lazy', 'ref object in sub is Object::Lazy', ); is( $object->method, 'method output', 'check method output', ); is( ref $object, 'TestSample', 'ref object in sub is TestSample now', ); } is( ref $object, 'Object::Lazy', 'ref object is Object::Lazy', ); $object->method, is( ref $object, 'TestSample', 'ref object is TestSample now', ); #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } sub method { return 'method output'; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/t/pod.t000444000000000000 27211716207660 15450 0ustar00unknownunknown000000000000#!perl -T use strict; use warnings; use Test::More; eval 'use Test::Pod 1.14; 1' or plan( skip_all => 'Test::Pod 1.14 required for testing POD' ); all_pod_files_ok(); Object-Lazy-0.16/t/14_call_by_reference.t000444000000000000 64313625321076 20616 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 2 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy'); } { package MyClass; sub new { return bless {}, $_[0] } sub store { $_[1] = 'mouse' } } my $object = Object::Lazy->new( sub { return MyClass->new } ); $object->store( my $lazy_out ); is $lazy_out, 'mouse', 'call by reference'; Object-Lazy-0.16/t/chars.t000444000000000000 635111753522116 16007 0ustar00unknownunknown000000000000#!perl -T use strict; use warnings; use Cwd qw(getcwd); use File::Find; use Test::More; $ENV{AUTHOR_TESTING} or plan( skip_all => 'Author test. Set $ENV{AUTHOR_TESTING} to a true value to run.' ); my $UNTAINT_FILENAME_PATTERN = qr{\A ( (?: (?: [A-Z] : ) | // )? [0-9A-Z_\-/\. ]+ ) \z}xmsi; my ($PATH) = getcwd() =~ $UNTAINT_FILENAME_PATTERN; $PATH =~ s{\\}{/}xmsg; my @list; find( { untaint_pattern => $UNTAINT_FILENAME_PATTERN, untaint => 1, wanted => sub { -d and return; $File::Find::name =~ m{ / \.svn / | / \.git / | / \.gitignore \z }xms and return; $File::Find::name =~ m{ ( (?: /lib/ | /example/ | /t/ ) | /Build\.PL \z | /Changes \z | /README \z | /MANIFEST\.SKIP \z ) }xms or return; push @list, $File::Find::name; }, }, $PATH, ); plan( tests => 6 * scalar @list ); my @ignore_non_ascii = ( ); for my $file_name (sort @list) { my @lines; { open my $file, '< :raw', $file_name or die "Cannnot open file $file_name"; local $/ = (); my $text = <$file>; # repair last line without \n ok( ! ( $text =~ s{([^\x0D\x0A]) \z}{$1\x0D\x0A}xms ), "$file_name has newline at EOF", ); @lines = split m{\x0A}, $text; } my $find_line_numbers = sub { my ($test_description, $test_reason, $regex, $regex_negation) = @_; my $line_number = 0; my @line_numbers = map { ++$line_number; ($regex_negation xor $_ =~ $regex) ? $line_number : (); } @lines; ok(! @line_numbers, $test_description); if (@line_numbers) { if (@line_numbers > 10) { $#line_numbers = 10; $line_numbers[10] = '...'; } my $line_numbers = join q{, }, @line_numbers; diag("Check line $line_numbers in file $file_name for $test_reason."); } return; }; $find_line_numbers->( "$file_name has network line endings (LFCR)", 'line endings', qr{\x0D \z}xms, 1, ); $find_line_numbers->( "$file_name has no TABs", 'TABs', qr{\x09}xms, ); $find_line_numbers->( "$file_name has no control chars", 'control chars', qr{[\x00-\x08\x0B\x0C\x0E-\x1F\x7F]}xms, ); NON_ASCII: { for my $regex (@ignore_non_ascii) { if ( $file_name =~ $regex ) { ok(1, 'dummy'); next NON_ASCII; } } $find_line_numbers->( "$file_name has no nonASCII chars", 'nonASCII chars', qr{[\x80-\xA6\xA8-\xFF]}xms, # A7 is § ); } $find_line_numbers->( "$file_name has no trailing space", 'trailing space', qr{[ ] (?: \x0D? \x0A | \z )}xms, ); } Object-Lazy-0.16/t/13_wrapped.t000444000000000000 143612030472220 16640 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 2 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy') } my $inner = Object::Lazy->new( sub { TestInner->new } ); my $outer = Object::Lazy->new( sub { TestOuter->new( $inner->inner ) } ); is( $outer->outer, 'inner output', 'other AUTOLOAD during BUILD_OBJECT', ); #----------------------------------------------------------------------------- package TestInner; sub new { return bless {}, shift; } sub inner { return 'inner output'; } #----------------------------------------------------------------------------- package TestOuter; sub new { my ( $class, $text ) = @_; return bless \$text, $class; } sub outer { return ${ +shift }; } Object-Lazy-0.16/t/10_ref.t000444000000000000 110112003013570 15733 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 6 + 1; use Test::NoWarnings; BEGIN { use_ok('Object::Lazy'); use_ok('Object::Lazy::Ref'); } my $object = Object::Lazy->new({ build => \&NotExists, ref => 'MyClass', }); is( ref $object, 'MyClass', 'ref is MyClass', ); is( ref {}, 'HASH', 'ref is HASH' ); is( ref bless( {}, __PACKAGE__ ), __PACKAGE__, 'ref is ' . __PACKAGE__, ); is_deeply( [ ref \1, 1 ], [ 'SCALAR', 1], 'ref prototype check', ); Object-Lazy-0.16/t/09_given_VERSION.t000444000000000000 215512026067612 17531 0ustar00unknownunknown000000000000#!perl -T use 5.006; use strict; use warnings; use Test::More tests => 5 + 1; use Test::NoWarnings; use version; BEGIN { use_ok('Object::Lazy') } { $TestSample::VERSION = '123'; my $object = Object::Lazy->new({ build => \&TestSample::create_object, VERSION => qv('1.2.3'), }); is( $object->VERSION, qv('1.2.3'), 'VERSION', ); is( ref $object, 'Object::Lazy', 'ref object is Obejct::Lazy', ); } { $TestSample::VERSION = '123'; my $object = Object::Lazy->new({ build => \&TestSample::create_object, version_from => 'TestSample', }); is( $object->VERSION, '123', 'version_from', ); is( ref $object, 'Object::Lazy', 'ref object is Obejct::Lazy too', ); } #----------------------------------------------------------------------------- package TestSample; sub new { return bless {}, shift; } # it's a sub, not a method sub create_object { return TestSample->new; } Object-Lazy-0.16/example000755000000000000 013625326501 15550 5ustar00unknownunknown000000000000Object-Lazy-0.16/example/05_VERSION.pl000444000000000000 454112546555616 17713 0ustar00unknownunknown000000000000#!perl ## no critic (TidyCode) use strict; use warnings; our $VERSION = 0; use version; use English qw(-no_match_vars $EVAL_ERROR); use Data::Dumper; use Object::Lazy; my $object_1 = Object::Lazy->new({ # A lazy Data::Dumper object as example. build => sub { return Data::Dumper->new(['data'], ['my_dump_1']); }, # take the version from class Data::Dumper; version_from => 'Data::Dumper', # tell me when logger => sub { my $at_stack = shift; () = print "Real object 1 $at_stack"; }, }); my $object_2 = Object::Lazy->new({ # A lazy Data::Dumper object as example. build => sub { return Data::Dumper->new(['data'], ['my_dump_2']); }, # take the version from scalar; VERSION => qv('11.12.13'), # tell me when logger => sub { my $at_stack = shift; () = print "Real object 2 $at_stack"; }, }); { () = eval { $object_1->VERSION('9999') }; () = print $EVAL_ERROR; my $version = $object_2->VERSION; () = print "$version = \$object_2->VERSION( qv(11.12.13') )\n" } # build the real object and call method output $object_1->Dump; $object_2->Dump; # $Id$ __END__ output: Data::Dumper version 9999 required--this is only version ... at ../lib/Object/Lazy.pm line 124. 11.12.13 = $object_2->VERSION( qv(11.12.13') ) Real object 1 object built at ../lib/Object/Lazy.pm line 35. Object::Lazy::try {...} () called at D:/Perl/site/lib/Try/Tiny.pm line 81 eval {...} called at D:/Perl/site/lib/Try/Tiny.pm line 72 Try::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 Object::Lazy::BUILD_OBJECT(Data::Dumper=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 Object::Lazy::AUTOLOAD(Data::Dumper=HASH(...)) called at 05_VERSION.pl line 50 Real object 2 object built at ../lib/Object/Lazy.pm line 35. Object::Lazy::try {...} () called at D:/Perl/site/lib/Try/Tiny.pm line 81 eval {...} called at D:/Perl/site/lib/Try/Tiny.pm line 72 Try::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 Object::Lazy::BUILD_OBJECT(Data::Dumper=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 Object::Lazy::AUTOLOAD(Data::Dumper=HASH(...)) called at 05_VERSION.pl line 51 Object-Lazy-0.16/example/03_isa.pl000444000000000000 323012546555467 17336 0ustar00unknownunknown000000000000#!perl ## no critic (TidyCode) use strict; use warnings; our $VERSION = 0; use Object::Lazy; my $object = Object::Lazy->new({ # how to create the real object build => sub { return RealClass->new; }, # do not build at method isa # isa => 'RealClass', # or isa => [qw(RealClass BaseClassOfRealClass)], # tell me when logger => sub { my $at_stack = shift; () = print "RealClass $at_stack"; }, }); { my $ok = $object->isa('RealClass'); () = print "$ok = \$object->isa('RealClass');\n"; } # ask about inheritage { my $ok = $object->isa('BaseClassOfRealClass'); () = print "$ok = \$object->isa('BaseClassOfRealClass');\n"; } # build the real object and call method output $object->output; # $Id$ package RealClass; use parent qw(-norequire BaseClassOfRealClass); package BaseClassOfRealClass; ## no critic (MultiplePackages) sub new { return bless {}, shift; } sub output { () = print "# Method output called!\n"; return; } __END__ output: 1 = $object->isa('RealClass'); 1 = $object->isa('BaseClassOfRealClass'); RealClass object built at ../lib/Object/Lazy.pm line 35. Object::Lazy::try {...} () called at D:/Perl/site/lib/Try/Tiny.pm line 81 eval {...} called at D:/Perl/site/lib/Try/Tiny.pm line 72 Try::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 Object::Lazy::BUILD_OBJECT(RealClass=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 Object::Lazy::AUTOLOAD(RealClass=HASH(...)) called at 03_isa.pl line 38 # Method output called! Object-Lazy-0.16/example/01_short_constructor.pl000444000000000000 166212546551456 22365 0ustar00unknownunknown000000000000#!perl ## no critic (TidyCode) use strict; use warnings; our $VERSION = 0; use Object::Lazy; use Data::Dumper; my $object = Object::Lazy->new( sub { # A lazy Data::Dumper object as example. return Data::Dumper->new(['data'], ['my_dump']); }, ); sub do_something_with { my ($object, $condition) = @_; ## no critic (ReusedNames) if ($condition) { # the Data::Dumper object will be created () = print $object->Dump; } else { # the Data::Dumper object is not created } () = print "condition = $condition\n", "object = $object\n"; return; } # do nothing do_something_with($object, 0); # build the real object and call method Dump do_something_with($object, 1); # $Id$ __END__ output: condition = 0 object = Object::Lazy=HASH(...) $my_dump = 'data'; condition = 1 object = Data::Dumper=HASH(...) Object-Lazy-0.16/example/04_DOES.pl000444000000000000 305512546555534 17315 0ustar00unknownunknown000000000000#!perl ## no critic (TidyCode) use strict; use warnings; use 5.010; our $VERSION = 0; use Object::Lazy; my $object = Object::Lazy->new({ # how to create the real object build => sub { return RealClass->new; }, # do not build at method DOES # inheritance isa => 'RealClass', # array reference allowed too # roles DOES => 'Role', # array reference allowed too # tell me when logger => sub { my $at_stack = shift; () = print "RealClass $at_stack"; }, }); { my $ok = $object->DOES('RealClass'); () = print "$ok = \$object->DOES('RealClass');\n"; } { my $ok = $object->DOES('RealClass'); () = print "$ok = \$object->DOES('Role');\n"; } # build the real object and call method output $object->output; # $Id$ package RealClass; sub new { return bless {}, shift; } sub output { () = print "# Method output called!\n"; return; } __END__ output: 1 = $object->DOES('RealClass'); 1 = $object->DOES('Role'); RealClass object built at ../lib/Object/Lazy.pm line 35. Object::Lazy::try {...} () called at D:/Perl/site/lib/Try/Tiny.pm line 81 eval {...} called at D:/Perl/site/lib/Try/Tiny.pm line 72 Try::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 Object::Lazy::BUILD_OBJECT(RealClass=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 Object::Lazy::AUTOLOAD(RealClass=HASH(...)) called at 04_DOES.pl line 39 # Method output called! Object-Lazy-0.16/example/02_extended_constructor.pl000444000000000000 331612546555422 23022 0ustar00unknownunknown000000000000#!perl ## no critic (TidyCode) use strict; use warnings; our $VERSION = 0; use Object::Lazy; my $object = Object::Lazy->new({ # A lazy Data::Dumper object as example # will show you use or require late too. build => sub { require Data::Dumper; return Data::Dumper->new(['data'], ['my_dump']); }, # tell me when logger => sub { my $at_stack = shift; () = print "Data::Dumper $at_stack"; }, }); sub do_something_with { my ($object, $condition) = @_; ## no critic (ReusedNames) if ($condition) { # the Data::Dumper object will be created () = print $object->Dump; } else { # the Data::Dumper object is not created } () = print "condition = $condition\n", "object = $object\n"; return; } # do nothing do_something_with($object, 0); # build the real object and call method Dump do_something_with($object, 1); # $Id$ __END__ output: condition = 0 object = Object::Lazy=HASH(...) Data::Dumper object built at ../lib/Object/Lazy.pm line 35. Object::Lazy::try {...} () called at D:/Perl/site/lib/Try/Tiny.pm line 81 eval {...} called at D:/Perl/site/lib/Try/Tiny.pm line 72 Try::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 Object::Lazy::BUILD_OBJECT(Data::Dumper=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 53 Object::Lazy::AUTOLOAD(Data::Dumper=HASH(...)) called at 02_extended_constructor.pl line 29 main::do_something_with(Data::Dumper=HASH(...), 1) called at 02_extended_constructor.pl line 45 $my_dump = 'data'; condition = 1 object = Data::Dumper=HASH(...) Object-Lazy-0.16/example/06_ref.pl000444000000000000 243512546555706 17343 0ustar00unknownunknown000000000000#!perl ## no critic (TidyCode) use strict; use warnings; our $VERSION = 0; use Object::Lazy; use Object::Lazy::Ref; # overwrite CORE::GLOBAL::ref my $object = Object::Lazy->new({ build => sub { return RealClass->new; }, # set the ref answer ref => 'RealClass', # tell me when logger => sub { my $at_stack = shift; () = print "RealClass $at_stack"; }, }); my $ref = ref $object; () = print "$ref = ref \$object;\n"; my $coderef = $object->can('new'); # There is no simulation available for method can. # The object has to build. () = print "$coderef = \$object->can('new')\n"; # $Id$ package RealClass; sub new { return bless {}, shift; } __END__ output: RealClass = ref $object; RealClass object built at ../lib/Object/Lazy.pm line 35. Object::Lazy::try {...} () called at D:/Perl/site/lib/Try/Tiny.pm line 81 eval {...} called at D:/Perl/site/lib/Try/Tiny.pm line 72 Try::Tiny::try(CODE(...), Try::Tiny::Catch=REF(...)) called at ../lib/Object/Lazy.pm line 39 Object::Lazy::BUILD_OBJECT(RealClass=HASH(...), REF(...)) called at ../lib/Object/Lazy.pm line 110 Object::Lazy::can(RealClass=HASH(...), "new") called at 06_ref.pl line 27 CODE(...) = $object->can('new') Object-Lazy-0.16/lib000755000000000000 013625326500 14662 5ustar00unknownunknown000000000000Object-Lazy-0.16/lib/Object000755000000000000 013625326501 16071 5ustar00unknownunknown000000000000Object-Lazy-0.16/lib/Object/Lazy.pm000444000000000000 2435113625321402 17523 0ustar00unknownunknown000000000000package Object::Lazy; ## no critic (TidyCode) use strict; use warnings; our $VERSION = '0.16'; use Carp qw(confess); use Try::Tiny; use Object::Lazy::Validate; sub new { ## no critic (ArgUnpacking) my ($class, $params) = Object::Lazy::Validate::validate_new(@_); $params = Object::Lazy::Validate::init($params); my $self = bless $params, $class; if ( exists $params->{ref} ) { Object::Lazy::Ref::register($self); } return $self; } my $build_object = sub { my ($self, $self_ref) = @_; local *__ANON__ = 'BUILD_OBJECT'; ## no critic (LocalVars) my $built_object = $self->{build}->(); # don't build a second time $self->{build} = sub { return $built_object }; if ( ! $self->{is_built} ) { $self->{is_built} = 1; if ( exists $self->{logger} ) { try { confess('object built'); } catch { $self->{logger}->($_); }; } } ${$self_ref} = $built_object; return $built_object; }; sub DESTROY {} # is not AUTOLOAD sub AUTOLOAD { ## no critic (Autoloading ArgUnpacking) my $self = $_[0]; my $method = substr our $AUTOLOAD, 2 + length __PACKAGE__; my $built_object = $build_object->($self, \$_[0]); return $built_object->$method( @_[1 .. $#_] ); } sub isa { ## no critic (ArgUnpacking) my ($self, $class2check) = @_; my @isa = ref $self->{isa} eq 'ARRAY' ? @{ $self->{isa} } : ( $self->{isa} ); if ( $self->{is_built} || ! @isa ) { my $built_object = $build_object->($self, \$_[0]); return $built_object->isa($class2check); } CLASS: for my $class (@isa) { $class->isa($class2check) and return 1; } my %isa = map { ($_ => undef) } @isa; return exists $isa{$class2check}; } sub DOES { ## no critic (ArgUnpacking) my ($self, $class2check) = @_; UNIVERSAL->can('DOES') or confess 'UNIVERSAL 1.04 (Perl 5.10) required for method DOES'; my @does = ref $self->{DOES} eq 'ARRAY' ? @{ $self->{DOES} } : ( $self->{DOES} ); my @isa_and_does = ( ( ref $self->{isa} eq 'ARRAY' ? @{ $self->{isa} } : ( $self->{isa} ) ), @does, ); if ( $self->{is_built} || ! @isa_and_does ) { my $built_object = $build_object->($self, \$_[0]); return $built_object->DOES($class2check); } CLASS: for my $class (@does) { $class->DOES($class2check) and return 1; } my %isa_and_does = map { ($_ => undef) } @isa_and_does; return exists $isa_and_does{$class2check}; } sub can { ## no critic (ArgUnpacking) my ($self, $method) = @_; my $built_object = $build_object->($self, \$_[0]); return $built_object->can($method); } sub VERSION { ## no critic (ArgUnpacking) my ($self, @version) = @_; if ( ! $self->{is_built} ) { if ( defined $self->{VERSION} ) { $Object::Lazy::Version::VERSION = $self->{VERSION}; return +( bless {}, 'Object::Lazy::Version' )->VERSION(@version); } if ( $self->{version_from} ) { return +( bless {}, $self->{version_from} )->VERSION(@version); } } my $built_object = $build_object->($self, \$_[0]); return $built_object->VERSION(@version); } # $Id$ 1; __END__ =pod =head1 NAME Object::Lazy - create objects late from non-owned (foreign) classes =head1 VERSION 0.16 =head1 SYNOPSIS use Foo 123; # because the class of the real object is Foo, version could be 123 use Object::Lazy; my $foo = Object::Lazy->new( sub { return Foo->new; }, ); bar($foo); sub bar { my $foo = shift; if ($condition) { # a foo object will be created print $foo->output; } else { # foo object is not created } return; } To combine this and a lazy use, write somthing like that: use Object::Lazy; my $foo = Object::Lazy->new( sub { # 3 lines instead of "use Foo 123" require Foo; Foo->import; Foo->VERSION('123'); return Foo->new; }, ); # and so on After a build object the scalar which hold the object will be updated too. $object->method; ^^^^^^^-------------- will update this scalar after a build Read topic SUBROUTINES/METHODS to find the entended constructor and all the optional parameters. =head1 EXAMPLE Inside of this Distribution is a directory named example. Run this *.pl files. =head1 DESCRIPTION This module implements lazy evaluation and can create lazy objects from every class. Creates a dummy object including a subroutine which knows how to build the real object. Later, if a method of the object is called, the real object will be built. Inherited methods from UNIVERSAL.pm are implemented and so overwritten. This are isa, DOES, can and VERSION. =head1 SUBROUTINES/METHODS =head2 method new =head3 short constructor $object = Object::Lazy->new( sub { return RealClass->new(...); }, ); =head3 extended constructor $object = Object::Lazy->new({ build => sub { return RealClass->new(...); }, }); =over 4 =item * optional parameter isa There are 3 ways to check the class or inheritance. If there is no parameter isa, the object must be built before. If the C is outside of C< sub {...}>> then the class method C<isa(...);>> checks the class or inheritance. Otherwise the isa parameter is a full notation of the class and possible of the inheritance. $object = Object::Lazy->new({ ... isa => 'RealClass', }); or $object = Object::Lazy->new({ ... isa => [qw(RealClass BaseClassOfRealClass)], }); =item * optional parameter DOES It is similar to parameter isa. But do not note the inheritance. Note the Rules here. $object = Object::Lazy->new({ ... DOES => 'Role1', }); or $object = Object::Lazy->new({ ... DOES => [qw(Role1 Role2)], }); =item * optional parameter VERSION For the VERSION method tell Object::Lazy which version shold be checked. $object = Object::Lazy->new({ ... VERSION => '123', }); or use version; $object = Object::Lazy->new({ ... VERSION => qv('1.2.3'), # version object }); =item * optional parameter version_from For the VERSION method tell Object::Lazy which class shold be version checked. $object = Object::Lazy->new({ ... version_from => 'RealClass', }); =item * optional parameter logger Optional notation of the logger code to show the build process. $object = Object::Lazy->new({ ... logger => sub { my $at_stack = shift; print "RealClass $at_stack"; }, }); =item * optional parameter ref Optional notation of the ref answer. It is not a good idea to use the Object::Lazy::Ref module by default. But there are situations, the lazy idea would run down the river if I had not implemented this feature. use Object::Lazy::Ref; # overwrite CORE::GLOBAL::ref $object = Object::Lazy->new({ ... ref => 'RealClass', }); $boolean_true = ref $object eq 'RealClass'; =back =head2 method isa If no isa parameter was given at method new, the object will build. Otherwise the method isa checks by isa class method or only the given parameters. $boolean = $object->isa('RealClass'); or $boolean = $object->isa('BaseClassOfRealClass'); =head2 method DOES If no isa or DOES parameter was given at method new, the object will build. Otherwise the method DOES checks by DOES class method or only the given parameters isa and DOES. $boolean = $object->DOES('Role'); =head2 method can The object will build. After that the can method checks the built object. $coderef_or_undef = $object->can('method'); =head2 method VERSION If no VERSION or version_from parameter was given at method new, the object will build. =head3 VERSION parameter set The given version will be returnd or checked. $version = $object->VERSION; or $object->VERSION($required_version); =head3 version_from parameter set The version of the class in version_from will be returnd or checked. This class should be used or required before. Is that not possible use parameter VERSION instead. $version = $object->VERSION; or $object->VERSION($required_version); =head1 DIAGNOSTICS The constructor can confess at false parameters. UNIVERSAL 1.04 (Perl 5.10) required for method DOES. =head1 CONFIGURATION AND ENVIRONMENT nothing =head1 DEPENDENCIES L L L =head1 INCOMPATIBILITIES not known =head1 BUGS AND LIMITATIONS UNIVERSAL.pm 1.04 implements DOES first time. This version is part of the Perl 5.10 distribution. =head1 SEE ALSO UNIVERSAL L The scalar will be built at C at first sub call. L The scalar will be built at C at first sub call. L No, I don't write my own class/package. L No, I don't write my own class/package. L There are lazy parameters too. L This is nearly the same idea. L Object created at call of method isa. =head1 AUTHOR Steffen Winkler =head1 LICENSE AND COPYRIGHT Copyright (c) 2007 - 2020, Steffen Winkler C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Object-Lazy-0.16/lib/Object/Lazy000755000000000000 013625326502 17011 5ustar00unknownunknown000000000000Object-Lazy-0.16/lib/Object/Lazy/Validate.pm000444000000000000 501612003035560 21225 0ustar00unknownunknown000000000000package Object::Lazy::Validate; ## no critic (TidyCode) use strict; use warnings; our $VERSION = '0.12'; use Params::Validate qw(:all); sub validate_new { ## no critic (ArgUnpacking) return validate_with( params => \@_, spec => [ {type => SCALAR}, {type => CODEREF | HASHREF}, ], stack_skip => 1, ); } # check and modify params sub init { my $params = shift; if (ref $params eq 'CODE') { $params = { build => $params, }; } return validate_with( params => $params, spec => { build => {type => CODEREF}, isa => {type => SCALAR | ARRAYREF, default => []}, DOES => {type => SCALAR | ARRAYREF, default => []}, VERSION => {type => SCALAR | OBJECT, optional => 1}, version_from => {type => SCALAR, optional => 1}, logger => {type => CODEREF, optional => 1}, ref => { type => SCALAR, optional => 1, callbacks => { 'depends use Object::Lazy::Ref' => sub { $Object::Lazy::Ref::VERSION; } } }, }, called => 'the 2nd parameter hashref', ); }; # $Id$ 1; __END__ =pod =head1 NAME Object::Lazy::Validate - validator and initializer for Object::Lazy =head1 VERSION 0.12 =head1 SYNOPSIS use Object::Lazy::Validate; my ($class, $params) = Object::Lazy::Validate::validate_new(@_); $params = Object::Lazy::Validate::init($params); =head1 DESCRIPTION Validator and initializer for Object::Lazy =head1 SUBROUTINES/METHODS =head2 sub validate_new Validator for the constructor of the package Object::Lazy. =head2 sub init Initializer for the constructor of the package ObjectLazy. =head1 DIAGNOSTICS Validator and initializer can confess at false parameters. =head1 CONFIGURATION AND ENVIRONMENT nothing =head1 DEPENDENCIES L =head1 INCOMPATIBILITIES not known =head1 BUGS AND LIMITATIONS not known =head1 AUTHOR Steffen Winkler =head1 LICENSE AND COPYRIGHT Copyright (c) 2007 - 2012, Steffen Winkler C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Object-Lazy-0.16/lib/Object/Lazy/Ref.pm000444000000000000 363312013745152 20221 0ustar00unknownunknown000000000000package Object::Lazy::Ref; ## no critic (TidyCode) use strict; use warnings; our $VERSION = '0.12'; use Carp qw(croak); my %register; BEGIN { my $old_core_global_ref = *CORE::GLOBAL::ref; *CORE::GLOBAL::ref = sub ($) { my $ref = shift; return exists $register{$ref} ? $register{$ref} : do { local *CORE::GLOBAL::ref = $old_core_global_ref; ref $ref; }; } } sub register { my $object = shift; $register{$object} = $object->{ref}; return; } # $Id$ 1; __END__ =pod =head1 NAME Object::Lazy::Ref - Simulation of C for Object::Lazy =head1 VERSION 0.12 =head1 SYNOPSIS use Object::Lazy::Ref; Object::Lazy::Ref::register($object); =head1 DESCRIPTION Simulation of C for Object::Lazy =head1 SUBROUTINES/METHODS =head2 sub register switch on the simulation. Object::Lazy::Ref::register($object); =head1 DIAGNOSTICS nothing =head1 CONFIGURATION AND ENVIRONMENT nothing =head1 DEPENDENCIES L =head1 INCOMPATIBILITIES This module will change *CORE::GLOBAL::ref premanently. If a call of sub ref not matched with an registered Object::Lazy object the *CORE::GLOBAL::ref will be restored during call and will fall back after that. When another programm decided to change *CORE::GLOBAL::ref permanently it has to fallback to the old *CORE::GLOBAL::ref too. This is than the Object::Lazy one. When it bails out to CORE::ref, the pipe is broken. =head1 BUGS AND LIMITATIONS not known =head1 AUTHOR Steffen Winkler =head1 LICENSE AND COPYRIGHT Copyright (c) 2007 - 2012, Steffen Winkler C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.