lib/Devel/SelfStubber.pm

   1 package Devel::SelfStubber;
   2 require SelfLoader;
   3 @ISA = qw(SelfLoader);
   4 @EXPORT = 'AUTOLOAD';
   5 $JUST_STUBS = 1;
   6 $VERSION = 1.03;
   7 sub Version {$VERSION}
   8
   9 # Use as
  10 # perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub(MODULE_NAME,LIB)'
  11 # (LIB defaults to '.') e.g.
  12 # perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub('Math::BigInt')'
  13 # would print out stubs needed if you added a __DATA__ before the subs.
  14 # Setting $Devel::SelfStubber::JUST_STUBS to 0 will print out the whole
  15 # module with the stubs entered just before the __DATA__
  16
  17 sub _add_to_cache {
  18     my($self,$fullname,$pack,$lines, $prototype) = @_;
  19     push(@DATA,@{$lines});
  20     if($fullname){push(@STUBS,"sub $fullname $prototype;\n")}; # stubs
  21     '1;';
  22 }
  23
  24 sub _package_defined {
  25     my($self,$line) = @_;
  26     push(@DATA,$line);
  27 }
  28
  29 sub stub {
  30     my($self,$module,$lib) = @_;
  31     my($line,$end_data,$fh,$mod_file,$found_selfloader);
  32     $lib ||= '.';
  33     ($mod_file = $module) =~ s,::,/,g;
  34
  35     $mod_file = "$lib/$mod_file.pm";
  36     $fh = "${module}::DATA";
  37     my (@BEFORE_DATA, @AFTER_DATA, @AFTER_END);
  38     @DATA = @STUBS = ();
  39
  40     open($fh,$mod_file) || die "Unable to open $mod_file";
  41     local $/ = "\n";
  42     while(defined ($line = <$fh>) and $line !~ m/^__DATA__/) {
  43         push(@BEFORE_DATA,$line);
  44         $line =~ /use\s+SelfLoader/ && $found_selfloader++;
  45     }
  46     (defined ($line) && $line =~ m/^__DATA__/)
  47       || die "$mod_file doesn't contain a __DATA__ token";
  48     $found_selfloader ||
  49         print 'die "\'use SelfLoader;\' statement NOT FOUND!!\n"',"\n";
  50     if ($JUST_STUBS) {
  51         $self->_load_stubs($module);
  52     } else {
  53         $self->_load_stubs($module, \@AFTER_END);
  54     }
  55     if ( fileno($fh) ) {
  56         $end_data = 1;
  57         while(defined($line = <$fh>)) {
  58             push(@AFTER_DATA,$line);
  59         }
  60     }
  61     close($fh);
  62     unless ($JUST_STUBS) {
  63         print @BEFORE_DATA;
  64     }
  65     print @STUBS;
  66     unless ($JUST_STUBS) {
  67         print "1;\n__DATA__\n",@DATA;
  68         if($end_data) { print "__END__ DATA\n",@AFTER_DATA; }
  69         if(@AFTER_END) { print "__END__\n",@AFTER_END; }
  70     }
  71 }
  72
  73 1;
  74 __END__
  75
  76 =head1 NAME
  77
  78 Devel::SelfStubber - generate stubs for a SelfLoading module
  79
  80 =head1 SYNOPSIS
  81
  82 To generate just the stubs:
  83
  84     use Devel::SelfStubber;
  85     Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
  86
  87 or to generate the whole module with stubs inserted correctly
  88
  89     use Devel::SelfStubber;
  90     $Devel::SelfStubber::JUST_STUBS=0;
  91     Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
  92
  93 MODULENAME is the Perl module name, e.g. Devel::SelfStubber,
  94 NOT 'Devel/SelfStubber' or 'Devel/SelfStubber.pm'.
  95
  96 MY_LIB_DIR defaults to '.' if not present.
  97
  98 =head1 DESCRIPTION
  99
 100 Devel::SelfStubber prints the stubs you need to put in the module
 101 before the __DATA__ token (or you can get it to print the entire
 102 module with stubs correctly placed). The stubs ensure that if
 103 a method is called, it will get loaded. They are needed specifically
 104 for inherited autoloaded methods.
 105
 106 This is best explained using the following example:
 107
 108 Assume four classes, A,B,C & D.
 109
 110 A is the root class, B is a subclass of A, C is a subclass of B,
 111 and D is another subclass of A.
 112
 113                         A
 114                        / \
 115                       B   D
 116                      /
 117                     C
 118
 119 If D calls an autoloaded method 'foo' which is defined in class A,
 120 then the method is loaded into class A, then executed. If C then
 121 calls method 'foo', and that method was reimplemented in class
 122 B, but set to be autoloaded, then the lookup mechanism never gets to
 123 the AUTOLOAD mechanism in B because it first finds the method
 124 already loaded in A, and so erroneously uses that. If the method
 125 foo had been stubbed in B, then the lookup mechanism would have
 126 found the stub, and correctly loaded and used the sub from B.
 127
 128 So, for classes and subclasses to have inheritance correctly
 129 work with autoloading, you need to ensure stubs are loaded.
 130
 131 The SelfLoader can load stubs automatically at module initialization
 132 with the statement 'SelfLoader-E<gt>load_stubs()';, but you may wish to
 133 avoid having the stub loading overhead associated with your
 134 initialization (though note that the SelfLoader::load_stubs method
 135 will be called sooner or later - at latest when the first sub
 136 is being autoloaded). In this case, you can put the sub stubs
 137 before the __DATA__ token. This can be done manually, but this
 138 module allows automatic generation of the stubs.
 139
 140 By default it just prints the stubs, but you can set the
 141 global $Devel::SelfStubber::JUST_STUBS to 0 and it will
 142 print out the entire module with the stubs positioned correctly.
 143
 144 At the very least, this is useful to see what the SelfLoader
 145 thinks are stubs - in order to ensure future versions of the
 146 SelfStubber remain in step with the SelfLoader, the
 147 SelfStubber actually uses the SelfLoader to determine which
 148 stubs are needed.
 149
 150 =cut