1#!/usr/bin/perl
2
3
4package Data::Thunk::Code;
5BEGIN {
6  $Data::Thunk::Code::AUTHORITY = 'cpan:NUFFIN';
7}
8BEGIN {
9  $Data::Thunk::Code::VERSION = '0.07';
10}
11
12use strict;
13use warnings;
14
15use Try::Tiny;
16use Data::Swap;
17use Scalar::Util qw(reftype blessed);
18use Check::ISA;
19use Devel::Refcount qw(refcount);
20use Carp;
21
22use namespace::clean;
23
24use UNIVERSAL::ref;
25
26BEGIN {
27	our $vivify_code = sub {
28		bless $_[0], "Data::Thunk::NoOverload";
29
30		my $scalar = reftype($_[0]) eq "REF";
31		my $code = $scalar ? ${ $_[0] } : $_[0]->{code};
32		my $tmp = $_[0]->$code();
33
34		if ( CORE::ref($tmp) and refcount($tmp) == 1 ) {
35			my $ref = \$_[0]; # try doesn't get $_[0]
36
37			try {
38				swap $$ref, $tmp;
39			} catch {
40				# try to figure out where the thunk was defined
41				my $lazy_ctx = try {
42					require B;
43					my $cv = B::svref_2object($_[0]->{code});
44					my $file = $cv->FILE;
45					my $line = $cv->START->line;
46					"in thunk defined at $file line $line";
47				} || "at <<unknown>>";
48
49				my $file = __FILE__;
50				s/ at \Q$file\E line \d+.\n$/ $lazy_ctx, vivified/; # becomes "vivified at foo line blah"..
51
52				croak($_);
53			};
54
55			return $_[0];
56		} else {
57			unless ( $scalar ) {
58				Data::Swap::swap $_[0], do { my $o; \$o };
59			}
60
61			# set up the Scalar Value overload thingy
62			${ $_[0] } = $tmp;
63			bless $_[0], "Data::Thunk::ScalarValue";
64
65			return $tmp;
66		}
67	};
68}
69
70our $vivify_code;
71
72use overload ( fallback => 1, map { $_ => $vivify_code } qw( bool "" 0+ ${} @{} %{} &{} *{} ) );
73
74our $call_method = sub {
75	my $method = shift;
76
77	if ( inv($_[0]) ) {
78		if ( my $code = $_[0]->can($method) ) {
79			goto &$code;
80		} else {
81			return $_[0]->$method(@_[1 .. $#_]);
82		}
83	} elsif ( defined $_[0] ) {
84		croak qq{Can't call method "$method" without a package or object reference};
85	} else {
86		croak qq{Can't call method "$method" on an undefined value};
87	}
88};
89
90our $vivify_and_call = sub {
91	$_[1]->$vivify_code();
92	goto $call_method;
93};
94
95sub ref {
96	CORE::ref($_[0]->$vivify_code);
97}
98
99foreach my $sym (keys %UNIVERSAL::) {
100	no strict 'refs';
101
102	next if $sym eq 'ref::';
103	next if defined &$sym;
104
105	local $@;
106
107	eval "sub $sym {
108		if ( Scalar::Util::blessed(\$_[0]) ) {
109			unshift \@_, '$sym';
110			goto \$vivify_and_call;
111		} else {
112			shift->SUPER::$sym(\@_);
113		}
114	}; 1" || warn $@;
115}
116
117sub AUTOLOAD {
118	my ( $method ) = ( our $AUTOLOAD =~ /([^:]+)$/ );
119	unshift @_, $method;
120	goto $vivify_and_call;
121}
122
123sub DESTROY {
124	# don't create the value just to destroy it
125}
126
1271;
128
129__END__
130=pod
131
132=encoding utf-8
133
134=head1 NAME
135
136Data::Thunk::Code
137
138=head1 AUTHOR
139
140Yuval Kogman
141
142=head1 COPYRIGHT AND LICENSE
143
144This software is Copyright (c) 2010 by Yuval Kogman.
145
146This is free software, licensed under:
147
148  The MIT (X11) License
149
150=cut
151
152