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