1#!/usr/bin/perl 2 3package Data::Thunk; 4BEGIN { 5 $Data::Thunk::AUTHORITY = 'cpan:NUFFIN'; 6} 7BEGIN { 8 $Data::Thunk::VERSION = '0.07'; 9} 10# ABSTRACT: A sneakier Scalar::Defer ;-) 11 12use strict; 13use warnings; 14 15use Data::Thunk::Code; 16use Data::Thunk::ScalarValue; 17use Data::Thunk::Object; 18 19use Scalar::Util qw(blessed); 20 21use namespace::clean; 22 23use Sub::Exporter -setup => { 24 exports => [qw(lazy lazy_new lazy_object force)], 25 groups => { 26 default => [':all'], 27 }, 28}; 29 30sub lazy (&) { 31 my $thunk = shift; 32 bless \$thunk, "Data::Thunk::Code"; 33} 34 35sub lazy_new ($;@) { 36 my ( $class, %args ) = @_; 37 my $constructor = delete $args{constructor} || 'new'; 38 my $args = delete $args{args} || []; 39 &lazy_object(sub { $class->$constructor(@$args) }, %args, class => $class); 40} 41 42sub lazy_object (&;@) { 43 my ( $thunk, @args ) = @_; 44 bless { @args, code => $thunk }, "Data::Thunk::Object"; 45} 46 47my ( $vivify_code, $vivify_scalar ) = ( $Data::Thunk::Code::vivify_code, $Data::Thunk::ScalarValue::vivify_scalar ); 48 49sub force ($) { 50 my $val = shift; 51 52 if ( blessed($val) ) { 53 no warnings; # UNIVERSAL::isa 54 if ( $val->UNIVERSAL::isa('Data::Thunk::Code') ) { # we wanna know what it's *real* class is 55 return $val->$vivify_code; 56 } elsif ( $val->UNIVERSAL::isa('Data::Thunk::ScalarValue') ) { 57 return $val->$vivify_scalar; 58 } 59 } 60 61 return $val; 62} 63 64{ 65 package Data::Thunk::NoOverload; 66BEGIN { 67 $Data::Thunk::NoOverload::AUTHORITY = 'cpan:NUFFIN'; 68} 69BEGIN { 70 $Data::Thunk::NoOverload::VERSION = '0.07'; 71} 72 # we temporarily bless into this to avoid overloading 73} 74 751; 76 77 78 79__END__ 80=pod 81 82=encoding utf-8 83 84=head1 NAME 85 86Data::Thunk - A sneakier Scalar::Defer ;-) 87 88=head1 SYNOPSIS 89 90 use Data::Thunk qw(lazy); 91 92 my %hash = ( 93 foo => lazy { $expensive }, 94 ); 95 96 $hash{bar}{gorch} = $hash{foo}; 97 98 $hash{bar}{gorch}->foo; # vivifies the object 99 100 warn overload::StrVal($hash{foo}); # replaced with the value 101 102=head1 DESCRIPTION 103 104This is an implementation of thunks a la L<Scalar::Defer>, but uses 105L<Data::Swap> and assignment to C<$_[0]> in order to leave a minimal trace of the thunk. 106 107In the case that a reference is returned from C<lazy { }> L<Data::Swap> can 108replace the thunk ref with the result ref, so all the references that pointed 109to the thunk are now pointing to the result (at the same address). 110 111If a simple value is returned then the thunk is swapped with a simple scalar 112container, which will assign the value to C<$_[0]> on each overloaded use. 113 114In this particular example: 115 116 my $x = { 117 foo => lazy { "blah" }, 118 bar => lazy { [ "boink" ] }, 119 }; 120 121 $x->{quxx} = $x->{foo}; 122 $x->{gorch} = $x->{bar}; 123 124 warn $x->{bar}; 125 warn $x->{foo}; 126 warn $x->{quxx}; 127 128 use Data::Dumper; 129 warn Dumper($x); 130 131The resulting structure is: 132 133 $VAR1 = { 134 'bar' => [ 'boink' ], 135 'foo' => 'blah', 136 'gorch' => $VAR1->{'bar'}, 137 'quxx' => 'blah' 138 }; 139 140Whereas with L<Scalar::Defer> the trampoline objects remain: 141 142 $VAR1 = { 143 'bar' => bless( do{\(my $o = 25206320)}, '0' ), 144 'foo' => bless( do{\(my $o = 25387232)}, '0' ), 145 'gorch' => $VAR1->{'bar'}, 146 'quxx' => $VAR1->{'foo'} 147 }; 148 149This is potentially problematic because L<Scalar::Util/reftype> and 150L<Scalar::Util/blessed> can't be fooled. With L<Data::Thunk> the problem still 151exists before values are vivified, but not after. 152 153Furthermore this module uses L<UNIVERSAL::ref> instead of blessing to C<0>. 154Blessing to C<0> pretends that everything is a non ref (C<ref($thunk)> returns 155the name of the package, which evaluates as false), so deferred values that 156become objects don't appear to be as such. 157 158=head1 EXPORTS 159 160=over 4 161 162=item lazy { ... } 163 164Create a new thunk. 165 166=item lazy_object { }, %attrs; 167 168Creates a thunk that is expected to be an object. 169 170If the C<class> attribute is provided then C<isa> and C<can> will work as class 171methods without vivifying the object. 172 173Any other attributes in %attrs will be used to shadow method calls. If the keys 174are code references they will be invoked, otherwise they will be simply 175returned as values. This can be useful if some of your object's properties are 176known in advance. 177 178=item lazy_new $class, %args; 179 180A specialization on C<lazy_object> that can call a constructor method based on 181a class for you. The C<constructor> and C<args> arguments (method name or code 182ref, and array reference) will be removed from %args to create the thunk. They 183default to C<new> and an empty array ref by default. Then this function 184delegates to C<lazy_object>. 185 186=item force 187 188Vivify the value and return the result. 189 190=back 191 192=head1 SEE ALSO 193 194L<Scalar::Defer>, L<Data::Lazy>, L<Data::Swap>, L<UNIVERSAL::ref>. 195 196=head1 AUTHOR 197 198Yuval Kogman 199 200=head1 COPYRIGHT AND LICENSE 201 202This software is Copyright (c) 2010 by Yuval Kogman. 203 204This is free software, licensed under: 205 206 The MIT (X11) License 207 208=cut 209 210