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