File Coverage

blib/lib/Scope/With.pm

Criterion	Covered	Total	%
statement	33	34	97.0
branch	2	2	100.0
condition	2	2	100.0
subroutine	8	9	88.8
pod	1	2	50.0
total	46	49	93.8

package Scope::With;

use 5.008001;

use strict;
use warnings;

use Devel::Declare::Context::Simple ();

our $VERSION = '0.01';

=begin comment

Under the hood, C turns a statement like the following:

    with (MyClass $foo) {
        bar();
        baz ...;
        quux (42);
    }

into (formatted for clarity):

    with {
        use Scope::With::Inject qw(MyClass);
        set_invocant($foo);
        no Scope::With::Inject;
        bar();
        baz ...;
        quux = 42;
    }

    sub with(&) {
        my $block = shift;
        $block->();
    }

C installs a lexical sub for each of C's methods (determined at compile-time)
which calls the corresponding method on the specified invocant (set at runtime). C unimports
the C method, which provides it conflicting with any prior or subsequent subroutines
of that name, but it leaves the lexical delegating subs intact.

If no class is specified in the C statement, then only C and C
are installed in the scope, and C is called with no argument.

=end comment

=cut

sub with(&) { $_[0]->() }

sub import {
    my $class   = shift;
    my $keyword = shift || 'with';
    my $caller  = Devel::Declare::get_curstash_name;

    Devel::Declare->setup_for(
        $caller,
        {
            $keyword => {
                const => sub { $class->parser(Devel::Declare::Context::Simple->new->init(@_)) }
            }
        }
    );

    no strict 'refs';
    *{"$caller\::$keyword"} = \&with;
}

sub parser {
    my ($class, $context) = @_;

    $context->skip_declarator;
    $context->skipspace;

    my $proto = $context->strip_proto;
    $context->skipspace;

    my $inject;

    if ($proto =~ /^\s*(\S+)\s+(.+?)\s*$/) {
        $inject = "use Scope::With::Inject qw($1); set_invocant($2); no Scope::With::Inject;";
    } else {
        $inject = "use Scope::With::Inject; set_invocant($proto); no Scope::With::Inject;";
    }

    # prefix our injected code with code that appends a semicolon to the end of the block
    $inject = $context->scope_injector_call(';') . $inject;
    $context->inject_if_block($inject);
}

1;

__END__