returning.pm

package returning;

use 5.008001;
use strict;

BEGIN {
	$returning::AUTHORITY = 'cpan:TOBYINK';
	$returning::VERSION   = '0.001';
}

use Carp                             0           ;
use Devel::Declare                   0.006007  ();
use Devel::Declare::Context::Simple  0         ();
 
sub import
{
	my $class = shift;
	my $default_target = caller;
	
	foreach my $arg (@_)
	{
		if (ref $arg eq 'HASH')
		{
			my $target = $arg->{-into} || $default_target;
			foreach my $f (keys %$arg)
			{
				next unless $f =~ /^[^\W\d]\w*$/;
				
				my $v    = $arg->{$f};
				my $code = ('CODE' eq ref $v) ? $v : sub(){$v if $]};
				
				do {
					no strict 'refs';
					*{ "$target\::$f" } = $code;
				};
				
				$class->setup_for($target, $f);
			}
		}
		
		elsif ($arg =~ /^[^\W\d]\w*$/)
		{
			$class->setup_for($default_target, $arg);
		}
		
		else
		{
			croak "unrecognised import argument to returning: $arg";
		}
	}
}

sub setup_for
{
	my ($class, $target, $func) = @_;
	
	Devel::Declare->setup_for(
		$target => {
			$func => {
				const => sub {
					my $ctx = Devel::Declare::Context::Simple->new;
					$ctx->init(@_);
					return $class->_transform($func, $ctx);
				},
			},
		},
	);
}

sub _transform
{
	my ($class, $name, $ctx) = @_;
	
	$ctx->skipspace;
	my $linestr = $ctx->get_linestr;
	
	if ($name eq substr $linestr, $ctx->offset, length $name)
	{
		substr($linestr, $ctx->offset, length $name) = qq(return(&$name));
		warn "<<$linestr>>";
		$ctx->set_linestr($linestr);
	}
	
	return 0;
}

1;

test-returning.t

use 5.010;
use Test::More tests => 1;

use constant {
	Affirmative  => !0,
	Negitive     => !1,
};

use returning qw(Affirmative Negitive);

sub test
{
	Affirmative;  # this should be rewritten as: return(&Affimative);
	Negitive;     # this should be rewritten as: return(&Negitive);
}

ok test();

Yet the following test passes...

use 5.010;
use Test::More;

use constant {
    Affirmative  => !0,
    Negitive     => !1,
};

#use returning qw(Affirmative Negitive);

sub test
{
    return(&Affirmative);  # this should be rewritten as: return(&Affimative);
    return(&Negitive);     # this should be rewritten as: return(&Negitive);
}

plan tests => 1;
ok test();