File Coverage

blib/lib/Data/Thunk.pm

Criterion	Covered	Total	%
statement	45	46	97.8
branch	3	6	50.0
condition	2	4	50.0
subroutine	18	18	100.0
pod	4	4	100.0
total	72	78	92.3

#!/usr/bin/perl

package Data::Thunk;
BEGIN {
  $Data::Thunk::AUTHORITY = 'cpan:NUFFIN';
}
BEGIN {
  $Data::Thunk::VERSION = '0.07';
}
# ABSTRACT: A sneakier Scalar::Defer ;-)

use strict;
use warnings;

use Data::Thunk::Code;
use Data::Thunk::ScalarValue;
use Data::Thunk::Object;

use Scalar::Util qw(blessed);

use namespace::clean;

use Sub::Exporter -setup => {
	exports => [qw(lazy lazy_new lazy_object force)],
	groups => {
		default => [':all'],
	},
};

sub lazy (&) {
	my $thunk = shift;
	bless \$thunk, "Data::Thunk::Code";
}

sub lazy_new ($;@) {
	my ( $class, %args ) = @_;
	my $constructor = delete $args{constructor} || 'new';
	my $args        = delete $args{args} || [];
	&lazy_object(sub { $class->$constructor(@$args) }, %args, class => $class);
}

sub lazy_object (&;@) {
	my ( $thunk, @args ) = @_;
	bless { @args, code => $thunk }, "Data::Thunk::Object";
}

my ( $vivify_code, $vivify_scalar ) = ( $Data::Thunk::Code::vivify_code, $Data::Thunk::ScalarValue::vivify_scalar );

sub force ($) {
	my $val = shift;

	if ( blessed($val) ) {
		no warnings; # UNIVERSAL::isa
		if ( $val->UNIVERSAL::isa('Data::Thunk::Code') ) { # we wanna know what it's *real* class is
			return $val->$vivify_code;
		} elsif ( $val->UNIVERSAL::isa('Data::Thunk::ScalarValue') ) {
			return $val->$vivify_scalar;
		}
	}

	return $val;
}

{
	package Data::Thunk::NoOverload;
BEGIN {
  $Data::Thunk::NoOverload::AUTHORITY = 'cpan:NUFFIN';
}
BEGIN {
  $Data::Thunk::NoOverload::VERSION = '0.07';
}
	# we temporarily bless into this to avoid overloading
}

1;



__END__