Commit | Line | Data |
a0d0e21e |
1 | package AutoSplit; |
2 | |
3 | require 5.000; |
4 | require Exporter; |
5 | |
6 | use Config; |
7 | use Carp; |
8 | |
9 | @ISA = qw(Exporter); |
10 | @EXPORT = qw(&autosplit &autosplit_lib_modules); |
3edbfbe5 |
11 | @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); |
a0d0e21e |
12 | |
f06db76b |
13 | =head1 NAME |
14 | |
15 | AutoSplit - split a package for autoloading |
16 | |
cb1a09d0 |
17 | =head1 SYNOPSIS |
18 | |
21c92a1d |
19 | perl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... |
20 | |
21 | use AutoSplit; autosplit($file, $dir, $keep, $check, $modtime); |
22 | |
23 | for perl versions 5.002 and later: |
84dc3c4d |
24 | |
21c92a1d |
25 | perl -MAutoSplit -e 'autosplit($ARGV[0], $ARGV[1], $k, $chk, $modtime)' ... |
cb1a09d0 |
26 | |
f06db76b |
27 | =head1 DESCRIPTION |
28 | |
29 | This function will split up your program into files that the AutoLoader |
21c92a1d |
30 | module can handle. It is used by both the standard perl libraries and by |
31 | the MakeMaker utility, to automatically configure libraries for autoloading. |
32 | |
33 | The C<autosplit> interface splits the specified file into a hierarchy |
34 | rooted at the directory C<$dir>. It creates directories as needed to reflect |
35 | class hierarchy, and creates the file F<autosplit.ix>. This file acts as |
36 | both forward declaration of all package routines, and as timestamp for the |
37 | last update of the hierarchy. |
38 | |
39 | The remaining three arguments to C<autosplit> govern other options to the |
40 | autosplitter. If the third argument, I<$keep>, is false, then any pre-existing |
41 | C<.al> files in the autoload directory are removed if they are no longer |
42 | part of the module (obsoleted functions). The fourth argument, I<$check>, |
43 | instructs C<autosplit> to check the module currently being split to ensure |
44 | that it does include a C<use> specification for the AutoLoader module, and |
45 | skips the module if AutoLoader is not detected. Lastly, the I<$modtime> |
46 | argument specifies that C<autosplit> is to check the modification time of the |
47 | module against that of the C<autosplit.ix> file, and only split the module |
48 | if it is newer. |
49 | |
50 | Typical use of AutoSplit in the perl MakeMaker utility is via the command-line |
51 | with: |
52 | |
53 | perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)' |
54 | |
55 | Defined as a Make macro, it is invoked with file and directory arguments; |
56 | C<autosplit> will split the specified file into the specified directory and |
57 | delete obsolete C<.al> files, after checking first that the module does use |
58 | the AutoLoader, and ensuring that the module is not already currently split |
59 | in its current form (the modtime test). |
60 | |
61 | The C<autosplit_lib_modules> form is used in the building of perl. It takes |
62 | as input a list of files (modules) that are assumed to reside in a directory |
63 | B<lib> relative to the current directory. Each file is sent to the |
64 | autosplitter one at a time, to be split into the directory B<lib/auto>. |
65 | |
66 | In both usages of the autosplitter, only subroutines defined following the |
67 | perl special marker I<__END__> are split out into separate files. Some |
68 | routines may be placed prior to this marker to force their immediate loading |
69 | and parsing. |
70 | |
71 | =head1 CAVEATS |
72 | |
73 | Currently, C<AutoSplit> cannot handle multiple package specifications |
74 | within one file. |
75 | |
76 | =head1 DIAGNOSTICS |
77 | |
78 | C<AutoSplit> will inform the user if it is necessary to create the top-level |
79 | directory specified in the invocation. It is preferred that the script or |
80 | installation process that invokes C<AutoSplit> have created the full directory |
81 | path ahead of time. This warning may indicate that the module is being split |
82 | into an incorrect path. |
83 | |
84 | C<AutoSplit> will warn the user of all subroutines whose name causes potential |
85 | file naming conflicts on machines with drastically limited (8 characters or |
86 | less) file name length. Since the subroutine name is used as the file name, |
87 | these warnings can aid in portability to such systems. |
88 | |
89 | Warnings are issued and the file skipped if C<AutoSplit> cannot locate either |
90 | the I<__END__> marker or a "package Name;"-style specification. |
91 | |
92 | C<AutoSplit> will also emit general diagnostics for inability to create |
93 | directories or files. |
f06db76b |
94 | |
95 | =cut |
96 | |
a0d0e21e |
97 | # for portability warn about names longer than $maxlen |
98 | $Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 |
99 | $Verbose = 1; # 0=none, 1=minimal, 2=list .al files |
100 | $Keep = 0; |
3edbfbe5 |
101 | $CheckForAutoloader = 1; |
102 | $CheckModTime = 1; |
a0d0e21e |
103 | |
3edbfbe5 |
104 | $IndexFile = "autosplit.ix"; # file also serves as timestamp |
a0d0e21e |
105 | $maxflen = 255; |
106 | $maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; |
c6538b72 |
107 | $Is_VMS = ($^O eq 'VMS'); |
a0d0e21e |
108 | |
3edbfbe5 |
109 | |
a0d0e21e |
110 | sub autosplit{ |
75f92628 |
111 | my($file, $autodir, $k, $ckal, $ckmt) = @_; |
112 | # $file - the perl source file to be split (after __END__) |
113 | # $autodir - the ".../auto" dir below which to write split subs |
114 | # Handle optional flags: |
115 | $keep = $Keep unless defined $k; |
116 | $ckal = $CheckForAutoloader unless defined $ckal; |
117 | $ckmt = $CheckModTime unless defined $ckmt; |
118 | autosplit_file($file, $autodir, $keep, $ckal, $ckmt); |
a0d0e21e |
119 | } |
120 | |
121 | |
a0d0e21e |
122 | # This function is used during perl building/installation |
21c92a1d |
123 | # ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... |
a0d0e21e |
124 | |
125 | sub autosplit_lib_modules{ |
126 | my(@modules) = @_; # list of Module names |
127 | |
128 | foreach(@modules){ |
129 | s#::#/#g; # incase specified as ABC::XYZ |
4633a7c4 |
130 | s|\\|/|g; # bug in ksh OS/2 |
a0d0e21e |
131 | s#^lib/##; # incase specified as lib/*.pm |
c6538b72 |
132 | if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs |
a0d0e21e |
133 | my ($dir,$name) = (/(.*])(.*)/); |
134 | $dir =~ s/.*lib[\.\]]//; |
135 | $dir =~ s#[\.\]]#/#g; |
136 | $_ = $dir . $name; |
137 | } |
3edbfbe5 |
138 | autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime); |
a0d0e21e |
139 | } |
140 | 0; |
141 | } |
142 | |
143 | |
144 | # private functions |
145 | |
146 | sub autosplit_file{ |
147 | my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_; |
148 | my(@names); |
149 | |
150 | # where to write output files |
151 | $autodir = "lib/auto" unless $autodir; |
c6538b72 |
152 | ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$## if $Is_VMS; |
3edbfbe5 |
153 | unless (-d $autodir){ |
154 | local($", @p)="/"; |
155 | foreach(split(/\//,$autodir)){ |
156 | push(@p, $_); |
157 | next if -d "@p/"; |
158 | mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!"; |
159 | } |
160 | # We should never need to create the auto dir here. installperl |
161 | # (or similar) should have done it. Expecting it to exist is a valuable |
162 | # sanity check against autosplitting into some random directory by mistake. |
163 | print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n"; |
164 | } |
a0d0e21e |
165 | |
166 | # allow just a package name to be used |
167 | $filename .= ".pm" unless ($filename =~ m/\.pm$/); |
168 | |
169 | open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n"; |
170 | my($pm_mod_time) = (stat($filename))[9]; |
171 | my($autoloader_seen) = 0; |
f06db76b |
172 | my($in_pod) = 0; |
a0d0e21e |
173 | while (<IN>) { |
f06db76b |
174 | # Skip pod text. |
175 | $in_pod = 1 if /^=/; |
176 | $in_pod = 0 if /^=cut/; |
177 | next if ($in_pod || /^=cut/); |
178 | |
a0d0e21e |
179 | # record last package name seen |
180 | $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); |
3edbfbe5 |
181 | ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; |
a0d0e21e |
182 | ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; |
183 | last if /^__END__/; |
184 | } |
3edbfbe5 |
185 | if ($check_for_autoloader && !$autoloader_seen){ |
186 | print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2); |
187 | return 0 |
188 | } |
a0d0e21e |
189 | $_ or die "Can't find __END__ in $filename\n"; |
190 | |
191 | $package or die "Can't find 'package Name;' in $filename\n"; |
192 | |
193 | my($modpname) = $package; $modpname =~ s#::#/#g; |
194 | my($al_idx_file) = "$autodir/$modpname/$IndexFile"; |
195 | |
196 | die "Package $package does not match filename $filename" |
197 | unless ($filename =~ m/$modpname.pm$/ or |
c6538b72 |
198 | $Is_VMS && $filename =~ m/$modpname.pm/i); |
a0d0e21e |
199 | |
200 | if ($check_mod_time){ |
201 | my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; |
202 | if ($al_ts_time >= $pm_mod_time){ |
203 | print "AutoSplit skipped ($al_idx_file newer that $filename)\n" |
204 | if ($Verbose >= 2); |
205 | return undef; # one undef, not a list |
206 | } |
207 | } |
208 | |
209 | my($from) = ($Verbose>=2) ? "$filename => " : ""; |
210 | print "AutoSplitting $package ($from$autodir/$modpname)\n" |
211 | if $Verbose; |
212 | |
213 | unless (-d "$autodir/$modpname"){ |
214 | local($", @p)="/"; |
215 | foreach(split(/\//,"$autodir/$modpname")){ |
216 | push(@p, $_); |
42793c05 |
217 | next if -d "@p/"; |
a0d0e21e |
218 | mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!"; |
219 | } |
220 | } |
221 | |
222 | # We must try to deal with some SVR3 systems with a limit of 14 |
223 | # characters for file names. Sadly we *cannot* simply truncate all |
224 | # file names to 14 characters on these systems because we *must* |
225 | # create filenames which exactly match the names used by AutoLoader.pm. |
226 | # This is a problem because some systems silently truncate the file |
227 | # names while others treat long file names as an error. |
228 | |
229 | # We do not yet deal with multiple packages within one file. |
230 | # Ideally both of these styles should work. |
231 | # |
232 | # package NAME; |
233 | # __END__ |
234 | # sub AAA { ... } |
235 | # package NAME::option1; |
236 | # sub BBB { ... } |
237 | # package NAME::option2; |
238 | # sub BBB { ... } |
239 | # |
240 | # package NAME; |
241 | # __END__ |
242 | # sub AAA { ... } |
243 | # sub NAME::option1::BBB { ... } |
244 | # sub NAME::option2::BBB { ... } |
245 | # |
246 | # For now both of these produce warnings. |
247 | |
248 | open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning |
4633a7c4 |
249 | my(@subnames, %proto); |
a0d0e21e |
250 | while (<IN>) { |
251 | if (/^package ([\w:]+)\s*;/) { |
252 | warn "package $1; in AutoSplit section ignored. Not currently supported."; |
253 | } |
4633a7c4 |
254 | if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) { |
a0d0e21e |
255 | print OUT "1;\n"; |
4633a7c4 |
256 | my $subname = $1; |
257 | $proto{$1} = $2 or ''; |
a0d0e21e |
258 | if ($subname =~ m/::/){ |
259 | warn "subs with package names not currently supported in AutoSplit section"; |
260 | } |
261 | push(@subnames, $subname); |
262 | my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); |
263 | my($lpath) = "$autodir/$modpname/$lname.al"; |
264 | my($spath) = "$autodir/$modpname/$sname.al"; |
265 | unless(open(OUT, ">$lpath")){ |
266 | open(OUT, ">$spath") or die "Can't create $spath: $!\n"; |
267 | push(@names, $sname); |
268 | print " writing $spath (with truncated name)\n" |
269 | if ($Verbose>=1); |
270 | }else{ |
271 | push(@names, $lname); |
272 | print " writing $lpath\n" if ($Verbose>=2); |
273 | } |
274 | print OUT "# NOTE: Derived from $filename. ", |
275 | "Changes made here will be lost.\n"; |
276 | print OUT "package $package;\n\n"; |
277 | } |
278 | print OUT $_; |
279 | } |
280 | print OUT "1;\n"; |
281 | close(OUT); |
282 | close(IN); |
283 | |
284 | if (!$keep){ # don't keep any obsolete *.al files in the directory |
285 | my(%names); |
286 | @names{@names} = @names; |
287 | opendir(OUTDIR,"$autodir/$modpname"); |
288 | foreach(sort readdir(OUTDIR)){ |
289 | next unless /\.al$/; |
290 | my($subname) = m/(.*)\.al$/; |
291 | next if $names{substr($subname,0,$maxflen-3)}; |
292 | my($file) = "$autodir/$modpname/$_"; |
293 | print " deleting $file\n" if ($Verbose>=2); |
f06db76b |
294 | my($deleted,$thistime); # catch all versions on VMS |
295 | do { $deleted += ($thistime = unlink $file) } while ($thistime); |
296 | carp "Unable to delete $file: $!" unless $deleted; |
a0d0e21e |
297 | } |
298 | closedir(OUTDIR); |
299 | } |
300 | |
301 | open(TS,">$al_idx_file") or |
302 | carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!"; |
303 | print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n"; |
f06db76b |
304 | print TS "package $package;\n"; |
4633a7c4 |
305 | print TS map("sub $_$proto{$_} ;\n", @subnames); |
f06db76b |
306 | print TS "1;\n"; |
a0d0e21e |
307 | close(TS); |
308 | |
309 | check_unique($package, $Maxlen, 1, @names); |
310 | |
311 | @names; |
312 | } |
313 | |
314 | |
315 | sub check_unique{ |
316 | my($module, $maxlen, $warn, @names) = @_; |
317 | my(%notuniq) = (); |
318 | my(%shorts) = (); |
319 | my(@toolong) = grep(length > $maxlen, @names); |
320 | |
321 | foreach(@toolong){ |
322 | my($trunc) = substr($_,0,$maxlen); |
323 | $notuniq{$trunc}=1 if $shorts{$trunc}; |
324 | $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_; |
325 | } |
326 | if (%notuniq && $warn){ |
327 | print "$module: some names are not unique when truncated to $maxlen characters:\n"; |
328 | foreach(keys %notuniq){ |
329 | print " $shorts{$_} truncate to $_\n"; |
330 | } |
331 | } |
332 | %notuniq; |
333 | } |
334 | |
335 | 1; |
336 | __END__ |
337 | |
338 | # test functions so AutoSplit.pm can be applied to itself: |
339 | sub test1{ "test 1\n"; } |
340 | sub test2{ "test 2\n"; } |
341 | sub test3{ "test 3\n"; } |
342 | sub test4{ "test 4\n"; } |
343 | |
344 | |