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