lib/Devel/BeginLift.pm

   1 package Devel::BeginLift;
   2
   3 use strict;
   4 use warnings;
   5 use 5.008001;
   6
   7 our $VERSION = 0.001003;
   8
   9 use vars qw(%lift);
  10 use base qw(DynaLoader);
  11 use B::Hooks::OP::Check::EntersubForCV;
  12
  13 bootstrap Devel::BeginLift;
  14
  15 sub import {
  16   my ($class, @args) = @_;
  17   my $target = caller;
  18   $class->setup_for($target => \@args);
  19 }
  20
  21 sub unimport {
  22   my ($class) = @_;
  23   my $target = caller;
  24   $class->teardown_for($target);
  25 }
  26
  27 sub setup_for {
  28   my ($class, $target, $args) = @_;
  29   $lift{$target} ||= [];
  30   push @{ $lift{$target} }, map {
  31     $class->setup_for_cv($_);
  32   } map {
  33     ref $_ eq 'CODE'
  34       ? $_
  35       : \&{ "${target}::${_}" }
  36   } @{ $args };
  37 }
  38
  39 sub teardown_for {
  40   my ($class, $target) = @_;
  41   $class->teardown_for_cv($_) for @{ $lift{$target} };
  42   delete $lift{$target};
  43 }
  44
  45 =head1 NAME
  46
  47 Devel::BeginLift - make selected sub calls evaluate at compile time
  48
  49 =head1 SYNOPSIS
  50
  51   use Devel::BeginLift qw(foo baz);
  52
  53   use vars qw($i);
  54
  55   BEGIN { $i = 0 }
  56
  57   sub foo { "foo: $_[0]\n"; }
  58
  59   sub bar { "bar: $_[0]\n"; }
  60
  61   for (1 .. 3) {
  62     print foo($i++);
  63     print bar($i++);
  64   }
  65
  66   no Devel::BeginLift;
  67
  68   print foo($i++);
  69
  70 outputs -
  71
  72 foo: 0
  73 bar: 1
  74 foo: 0
  75 bar: 2
  76 foo: 0
  77 bar: 3
  78 foo: 4
  79
  80 =head1 DESCRIPTION
  81
  82 Devel::BeginLift 'lifts' arbitrary sub calls to running at compile time
  83 - sort of a souped up version of "use constant". It does this via some
  84 slightly insane perlguts magic.
  85
  86 =head2 import
  87
  88   use Devel::BeginLift qw(list of subs);
  89
  90 Calls Devel::BeginLift->setup_for(__PACKAGE__ => \@list_of_subs);
  91
  92 =head2 unimport
  93
  94   no Devel::BeginLift;
  95
  96 Calls Devel::BeginLift->teardown_for(__PACKAGE__);
  97
  98 =head2 setup_for
  99
 100   Devel::BeginLift->setup_for($package => \@subnames);
 101
 102 Installs begin lifting magic (unless already installed) and registers
 103 "${package}::$name" for each member of @subnames to be executed when parsed
 104 and replaced with its output rather than left for runtime.
 105
 106 =head2 teardown_for
 107
 108   Devel::BeginLift->teardown_for($package);
 109
 110 Deregisters all subs currently registered for $package and uninstalls begin
 111 lifting magic is number of teardown_for calls matches number of setup_for
 112 calls.
 113
 114 =head2 setup_for_cv
 115
 116   $id = Devel::BeginLift->setup_for_cv(\&code);
 117
 118 Same as C<setup_for>, but only registers begin lifting magic for one code
 119 reference. Returns an id to be used in C<teardown_for_cv>.
 120
 121 =head2 teardown_for_cv
 122
 123   Devel::BeginLift->teardown_for_cv($id);
 124
 125 Deregisters begin lifting magic referred to by C<$id>.
 126
 127 =head1 AUTHOR
 128
 129 Matt S Trout - <mst@shadowcatsystems.co.uk>
 130
 131 Company: http://www.shadowcatsystems.co.uk/
 132 Blog: http://chainsawblues.vox.com/
 133
 134 =head1 LICENSE
 135
 136 This library is free software under the same terms as perl itself
 137
 138 =cut
 139
 140 1;