File Coverage

blib/lib/Devel/BeginLift.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	1	2	50.0
condition	1	2	50.0
subroutine	10	10	100.0
pod	2	2	100.0
total	50	52	96.1

package Devel::BeginLift;

use strict;
use warnings;
use 5.008001;

our $VERSION = 0.001003;

use vars qw(%lift);
use base qw(DynaLoader);
use B::Hooks::OP::Check::EntersubForCV;

bootstrap Devel::BeginLift;

sub import {
  my ($class, @args) = @_;
  my $target = caller;
  $class->setup_for($target => \@args);
}

sub unimport {
  my ($class) = @_;
  my $target = caller;
  $class->teardown_for($target);
}

sub setup_for {
  my ($class, $target, $args) = @_;
  $lift{$target} ||= [];
  push @{ $lift{$target} }, map {
    $class->setup_for_cv($_);
  } map {
    ref $_ eq 'CODE'
      ? $_
      : \&{ "${target}::${_}" }
  } @{ $args };
}

sub teardown_for {
  my ($class, $target) = @_;
  $class->teardown_for_cv($_) for @{ $lift{$target} };
  delete $lift{$target};
}

=head1 NAME

Devel::BeginLift - make selected sub calls evaluate at compile time

=head1 SYNOPSIS

  use Devel::BeginLift qw(foo baz);

  use vars qw($i);

  BEGIN { $i = 0 }

  sub foo { "foo: $_[0]\n"; }

  sub bar { "bar: $_[0]\n"; }

  for (1 .. 3) {
    print foo($i++);
    print bar($i++);
  }

  no Devel::BeginLift;

  print foo($i++);

outputs -

foo: 0
bar: 1
foo: 0
bar: 2
foo: 0
bar: 3
foo: 4

=head1 DESCRIPTION

Devel::BeginLift 'lifts' arbitrary sub calls to running at compile time
- sort of a souped up version of "use constant". It does this via some
slightly insane perlguts magic.

=head2 import

  use Devel::BeginLift qw(list of subs);

Calls Devel::BeginLift->setup_for(__PACKAGE__ => \@list_of_subs);

=head2 unimport

  no Devel::BeginLift;

Calls Devel::BeginLift->teardown_for(__PACKAGE__);

=head2 setup_for

  Devel::BeginLift->setup_for($package => \@subnames);

Installs begin lifting magic (unless already installed) and registers
"${package}::$name" for each member of @subnames to be executed when parsed
and replaced with its output rather than left for runtime.

=head2 teardown_for

  Devel::BeginLift->teardown_for($package);

Deregisters all subs currently registered for $package and uninstalls begin
lifting magic is number of teardown_for calls matches number of setup_for
calls.

=head2 setup_for_cv

  $id = Devel::BeginLift->setup_for_cv(\&code);

Same as C, but only registers begin lifting magic for one code
reference. Returns an id to be used in C.

=head2 teardown_for_cv

  Devel::BeginLift->teardown_for_cv($id);

Deregisters begin lifting magic referred to by C<$id>.

=head1 AUTHOR

Matt S Trout -

Company: http://www.shadowcatsystems.co.uk/
Blog: http://chainsawblues.vox.com/

=head1 LICENSE

This library is free software under the same terms as perl itself

=cut

1;