source: for-distributions/trunk/bin/windows/perl/lib/Devel/SelfStubber.pm@ 14489

Last change on this file since 14489 was 14489, checked in by oranfry, 17 years ago

upgrading to perl 5.8

File size: 4.8 KB
Line 
1package Devel::SelfStubber;
2use File::Spec;
3require SelfLoader;
4@ISA = qw(SelfLoader);
5@EXPORT = 'AUTOLOAD';
6$JUST_STUBS = 1;
7$VERSION = 1.03;
8sub 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
18sub _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
25sub _package_defined {
26 my($self,$line) = @_;
27 push(@DATA,$line);
28}
29
30sub 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
751;
76__END__
77
78=head1 NAME
79
80Devel::SelfStubber - generate stubs for a SelfLoading module
81
82=head1 SYNOPSIS
83
84To generate just the stubs:
85
86 use Devel::SelfStubber;
87 Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
88
89or 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
95MODULENAME is the Perl module name, e.g. Devel::SelfStubber,
96NOT 'Devel/SelfStubber' or 'Devel/SelfStubber.pm'.
97
98MY_LIB_DIR defaults to '.' if not present.
99
100=head1 DESCRIPTION
101
102Devel::SelfStubber prints the stubs you need to put in the module
103before the __DATA__ token (or you can get it to print the entire
104module with stubs correctly placed). The stubs ensure that if
105a method is called, it will get loaded. They are needed specifically
106for inherited autoloaded methods.
107
108This is best explained using the following example:
109
110Assume four classes, A,B,C & D.
111
112A is the root class, B is a subclass of A, C is a subclass of B,
113and D is another subclass of A.
114
115 A
116 / \
117 B D
118 /
119 C
120
121If D calls an autoloaded method 'foo' which is defined in class A,
122then the method is loaded into class A, then executed. If C then
123calls method 'foo', and that method was reimplemented in class
124B, but set to be autoloaded, then the lookup mechanism never gets to
125the AUTOLOAD mechanism in B because it first finds the method
126already loaded in A, and so erroneously uses that. If the method
127foo had been stubbed in B, then the lookup mechanism would have
128found the stub, and correctly loaded and used the sub from B.
129
130So, for classes and subclasses to have inheritance correctly
131work with autoloading, you need to ensure stubs are loaded.
132
133The SelfLoader can load stubs automatically at module initialization
134with the statement 'SelfLoader-E<gt>load_stubs()';, but you may wish to
135avoid having the stub loading overhead associated with your
136initialization (though note that the SelfLoader::load_stubs method
137will be called sooner or later - at latest when the first sub
138is being autoloaded). In this case, you can put the sub stubs
139before the __DATA__ token. This can be done manually, but this
140module allows automatic generation of the stubs.
141
142By default it just prints the stubs, but you can set the
143global $Devel::SelfStubber::JUST_STUBS to 0 and it will
144print out the entire module with the stubs positioned correctly.
145
146At the very least, this is useful to see what the SelfLoader
147thinks are stubs - in order to ensure future versions of the
148SelfStubber remain in step with the SelfLoader, the
149SelfStubber actually uses the SelfLoader to determine which
150stubs are needed.
151
152=cut
Note: See TracBrowser for help on using the repository browser.