File Coverage

blib/lib/here/install.pm

Criterion	Covered	Total	%
statement	52	54	96.3
branch	6	12	50.0
condition			n/a
subroutine	11	12	91.6
pod	0	1	0.0
total	69	79	87.3

package here::install;
    use warnings;
    use strict;
    use lib '..';
    use here;

    sub croak {here::croak "here::install: @_"}

    my %installed;
    sub import {
        shift;
        @_ % 2 and croak 'even length list expected';
        my @pseudo;
        while (@_) {
            my ($name, $transform) = splice @_, 0, 2;

            $name =~ /^(?:\w+|(?
            eval {\&$transform}                 or croak "in $name => not a subroutine '$transform'";

            (my $pkg = "$name.pm") =~ s!::!/!g;
            $INC{$pkg}++;
            $installed{$name} = $pkg;
            push @pseudo, $name;

            no strict 'refs';
            defined &{$name.'::import'} and croak "package '$name' not empty";
            *{$name.'::import'} = sub {
                use strict;
                shift;
                @_ = ('here', &$transform);
                goto &here::import;
            }
        }
        eval {
            require B::Hooks::EndOfScope;
            B::Hooks::EndOfScope::on_scope_end(sub {
                here::install->unimport(@pseudo)
            });
        1} or warnings::warnif all =>
            "B::Hooks::EndOfScope not available, here::install will not have lexical scope\n"
    }

    sub unimport {
        shift;
        while (@_) {
            my $name = shift;
            if (my $pkg = $installed{$name}) {
                delete $INC{$pkg};
                no strict 'refs';
                delete ${$name.'::'}{'import'};
            }
            else {croak "did not install '$name'"}
        }
    }


=head1 NAME

here::install - easily install compile time transforms

=head1 SYNOPSIS

    use here::install 'my::lvalue' => sub {
        map "my \$$_; sub $_ ():lvalue {\$$_}" => @_
    };

    use my::lvalue qw(foo bar); # my $foo; sub foo ():lvalue {$foo} my $bar; ...

    foo = 3;
    say foo;  # 3
    say $foo; # 3

    bar = 4;
    say bar++; # 4
    say $bar;  # 5

=head2 cleanup

=over 4

you can remove the pseudo-modules manually:

    no here::install 'my::lvalue';

or let the declaration fall out of scope if L is installed:

    {
        use here::install ...;
        use ...; # works
    }
    use ...; # error

=back

=head1 SEE ALSO

C< here::install > is a wrapper around L.

see L for additional examples.

=head1 AUTHOR

Eric Strom, C<<  >>

=head1 BUGS

please report any bugs or feature requests to C, or
through the web interface at L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 LICENSE AND COPYRIGHT

copyright 2011 Eric Strom.

this program is free software; you can redistribute it and/or modify it under
the terms of either: the GNU General Public License as published by the Free
Software Foundation; or the Artistic License.

see http://dev.perl.org/licenses/ for more information.

=cut

1