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