This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
test for Devel::SelfStubber
[perl5.git] / 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,$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);
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     $self->_load_stubs($module);
51     if ( fileno($fh) ) {
52         $end = 1;
53         while(defined($line = <$fh>)) {
54             push(@AFTER_DATA,$line);
55         }
56     }
57     unless ($JUST_STUBS) {
58         print @BEFORE_DATA;
59     }
60     print @STUBS;
61     unless ($JUST_STUBS) {
62         print "1;\n__DATA__\n",@DATA;
63         if($end) { print "__END__\n",@AFTER_DATA; }
64     }
65 }
66
67 1;
68 __END__
69
70 =head1 NAME
71
72 Devel::SelfStubber - generate stubs for a SelfLoading module
73
74 =head1 SYNOPSIS
75
76 To generate just the stubs:
77
78     use Devel::SelfStubber;
79     Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
80
81 or to generate the whole module with stubs inserted correctly
82
83     use Devel::SelfStubber;
84     $Devel::SelfStubber::JUST_STUBS=0;
85     Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
86
87 MODULENAME is the Perl module name, e.g. Devel::SelfStubber,
88 NOT 'Devel/SelfStubber' or 'Devel/SelfStubber.pm'.
89
90 MY_LIB_DIR defaults to '.' if not present.
91
92 =head1 DESCRIPTION
93
94 Devel::SelfStubber prints the stubs you need to put in the module
95 before the __DATA__ token (or you can get it to print the entire
96 module with stubs correctly placed). The stubs ensure that if
97 a method is called, it will get loaded. They are needed specifically
98 for inherited autoloaded methods.
99
100 This is best explained using the following example:
101
102 Assume four classes, A,B,C & D.
103
104 A is the root class, B is a subclass of A, C is a subclass of B,
105 and D is another subclass of A.
106
107                         A
108                        / \
109                       B   D
110                      /
111                     C
112
113 If D calls an autoloaded method 'foo' which is defined in class A,
114 then the method is loaded into class A, then executed. If C then
115 calls method 'foo', and that method was reimplemented in class
116 B, but set to be autoloaded, then the lookup mechanism never gets to
117 the AUTOLOAD mechanism in B because it first finds the method
118 already loaded in A, and so erroneously uses that. If the method
119 foo had been stubbed in B, then the lookup mechanism would have
120 found the stub, and correctly loaded and used the sub from B.
121
122 So, for classes and subclasses to have inheritance correctly
123 work with autoloading, you need to ensure stubs are loaded.
124
125 The SelfLoader can load stubs automatically at module initialization
126 with the statement 'SelfLoader-E<gt>load_stubs()';, but you may wish to
127 avoid having the stub loading overhead associated with your
128 initialization (though note that the SelfLoader::load_stubs method
129 will be called sooner or later - at latest when the first sub
130 is being autoloaded). In this case, you can put the sub stubs
131 before the __DATA__ token. This can be done manually, but this
132 module allows automatic generation of the stubs.
133
134 By default it just prints the stubs, but you can set the
135 global $Devel::SelfStubber::JUST_STUBS to 0 and it will
136 print out the entire module with the stubs positioned correctly.
137
138 At the very least, this is useful to see what the SelfLoader
139 thinks are stubs - in order to ensure future versions of the
140 SelfStubber remain in step with the SelfLoader, the
141 SelfStubber actually uses the SelfLoader to determine which
142 stubs are needed.
143
144 =cut