lib/Devel/Declare.pm

   1 package Devel::Declare;
   2
   3 use strict;
   4 use warnings;
   5 use 5.008001;
   6
   7 our $VERSION = 0.001000;
   8
   9 use vars qw(%declarators);
  10 use base qw(DynaLoader);
  11
  12 bootstrap Devel::Declare;
  13
  14 sub import {
  15   my ($class, @args) = @_;
  16   my $target = caller;
  17   $class->setup_for($target => \@args);
  18 }
  19
  20 sub unimport {
  21   my ($class) = @_;
  22   my $target = caller;
  23   $class->teardown_for($target);
  24 }
  25
  26 sub setup_for {
  27   my ($class, $target, $args) = @_;
  28   setup();
  29   $declarators{$target}{$_} = 1 for @$args;
  30 }
  31
  32 sub teardown_for {
  33   my ($class, $target) = @_;
  34   delete $declarators{$target};
  35   teardown();
  36 }
  37
  38 my $temp_pack;
  39 my $temp_name;
  40
  41 sub init_declare {
  42   my ($pack, $use, $name) = @_;
  43   no strict 'refs';
  44   *{"${pack}::${name}"} = sub (&) { ($pack, $name, $_[0]); };
  45   ($temp_pack, $temp_name) = ($pack, $name);
  46 }
  47
  48 sub done_declare {
  49   no strict 'refs';
  50   delete ${"${temp_pack}::"}{$temp_name};
  51 }
  52
  53 =head1 NAME
  54
  55 Devel::Declare -
  56
  57 =head1 SYNOPSIS
  58
  59 =head1 DESCRIPTION
  60
  61 =head2 import
  62
  63   use Devel::Declare qw(list of subs);
  64
  65 Calls Devel::Declare->setup_for(__PACKAGE__ => \@list_of_subs);
  66
  67 =head2 unimport
  68
  69   no Devel::Declare;
  70
  71 Calls Devel::Declare->teardown_for(__PACKAGE__);
  72
  73 =head2 setup_for
  74
  75   Devel::Declare->setup_for($package => \@subnames);
  76
  77 Installs declarator magic (unless already installed) and registers
  78 "${package}::$name" for each member of @subnames
  79
  80 =head2 teardown_for
  81
  82   Devel::Declare->teardown_for($package);
  83
  84 Deregisters all subs currently registered for $package and uninstalls
  85 declarator magic if number of teardown_for calls matches number of setup_for
  86 calls.
  87
  88 =head1 AUTHOR
  89
  90 Matt S Trout - <mst@shadowcatsystems.co.uk>
  91
  92 Company: http://www.shadowcatsystems.co.uk/
  93 Blog: http://chainsawblues.vox.com/
  94
  95 =head1 LICENSE
  96
  97 This library is free software under the same terms as perl itself
  98
  99 =cut
 100
 101 1;