10 @EXPORT = qw(&autosplit &autosplit_lib_modules);
11 @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
15 AutoSplit - split a package for autoloading
19 This function will split up your program into files that the AutoLoader
20 module can handle. Normally only used to build autoloading Perl library
21 modules, especially extensions (like POSIX). You should look at how
22 they're built out for details.
26 # for portability warn about names longer than $maxlen
27 $Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3
28 $Verbose = 1; # 0=none, 1=minimal, 2=list .al files
30 $CheckForAutoloader = 1;
33 $IndexFile = "autosplit.ix"; # file also serves as timestamp
35 $maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
36 $vms = ($Config{'osname'} eq 'VMS');
40 my($file, $autodir, $k, $ckal, $ckmt) = @_;
41 # $file - the perl source file to be split (after __END__)
42 # $autodir - the ".../auto" dir below which to write split subs
43 # Handle optional flags:
44 $keep = $Keep unless defined $k;
45 $ckal = $CheckForAutoloader unless defined $ckal;
46 $ckmt = $CheckModTime unless defined $ckmt;
47 autosplit_file($file, $autodir, $keep, $ckal, $ckmt);
51 # This function is used during perl building/installation
52 # ./miniperl -e 'use AutoSplit; autosplit_modules(@ARGV)' ...
54 sub autosplit_lib_modules{
55 my(@modules) = @_; # list of Module names
58 s#::#/#g; # incase specified as ABC::XYZ
59 s#^lib/##; # incase specified as lib/*.pm
60 if ($vms && /[:>\]]/) { # may need to convert VMS-style filespecs
61 my ($dir,$name) = (/(.*])(.*)/);
62 $dir =~ s/.*lib[\.\]]//;
66 autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime);
75 my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_;
78 # where to write output files
79 $autodir = "lib/auto" unless $autodir;
82 foreach(split(/\//,$autodir)){
85 mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
87 # We should never need to create the auto dir here. installperl
88 # (or similar) should have done it. Expecting it to exist is a valuable
89 # sanity check against autosplitting into some random directory by mistake.
90 print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n";
93 # allow just a package name to be used
94 $filename .= ".pm" unless ($filename =~ m/\.pm$/);
96 open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n";
97 my($pm_mod_time) = (stat($filename))[9];
98 my($autoloader_seen) = 0;
103 $in_pod = 0 if /^=cut/;
104 next if ($in_pod || /^=cut/);
106 # record last package name seen
107 $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
108 ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
109 ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
110 ++$autoloader_seen if m/^\s*sub\s+AUTOLOAD\b/;
113 if ($check_for_autoloader && !$autoloader_seen){
114 print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2);
117 $_ or die "Can't find __END__ in $filename\n";
119 $package or die "Can't find 'package Name;' in $filename\n";
121 my($modpname) = $package; $modpname =~ s#::#/#g;
122 my($al_idx_file) = "$autodir/$modpname/$IndexFile";
124 die "Package $package does not match filename $filename"
125 unless ($filename =~ m/$modpname.pm$/ or
126 $vms && $filename =~ m/$modpname.pm/i);
128 if ($check_mod_time){
129 my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
130 if ($al_ts_time >= $pm_mod_time){
131 print "AutoSplit skipped ($al_idx_file newer that $filename)\n"
133 return undef; # one undef, not a list
137 my($from) = ($Verbose>=2) ? "$filename => " : "";
138 print "AutoSplitting $package ($from$autodir/$modpname)\n"
141 unless (-d "$autodir/$modpname"){
143 foreach(split(/\//,"$autodir/$modpname")){
146 mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
150 # We must try to deal with some SVR3 systems with a limit of 14
151 # characters for file names. Sadly we *cannot* simply truncate all
152 # file names to 14 characters on these systems because we *must*
153 # create filenames which exactly match the names used by AutoLoader.pm.
154 # This is a problem because some systems silently truncate the file
155 # names while others treat long file names as an error.
157 # We do not yet deal with multiple packages within one file.
158 # Ideally both of these styles should work.
163 # package NAME::option1;
165 # package NAME::option2;
171 # sub NAME::option1::BBB { ... }
172 # sub NAME::option2::BBB { ... }
174 # For now both of these produce warnings.
176 open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
179 if (/^package ([\w:]+)\s*;/) {
180 warn "package $1; in AutoSplit section ignored. Not currently supported.";
182 if (/^sub ([\w:]+)/) {
185 if ($subname =~ m/::/){
186 warn "subs with package names not currently supported in AutoSplit section";
188 push(@subnames, $subname);
189 my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
190 my($lpath) = "$autodir/$modpname/$lname.al";
191 my($spath) = "$autodir/$modpname/$sname.al";
192 unless(open(OUT, ">$lpath")){
193 open(OUT, ">$spath") or die "Can't create $spath: $!\n";
194 push(@names, $sname);
195 print " writing $spath (with truncated name)\n"
198 push(@names, $lname);
199 print " writing $lpath\n" if ($Verbose>=2);
201 print OUT "# NOTE: Derived from $filename. ",
202 "Changes made here will be lost.\n";
203 print OUT "package $package;\n\n";
211 if (!$keep){ # don't keep any obsolete *.al files in the directory
213 @names{@names} = @names;
214 opendir(OUTDIR,"$autodir/$modpname");
215 foreach(sort readdir(OUTDIR)){
217 my($subname) = m/(.*)\.al$/;
218 next if $names{substr($subname,0,$maxflen-3)};
219 my($file) = "$autodir/$modpname/$_";
220 print " deleting $file\n" if ($Verbose>=2);
221 my($deleted,$thistime); # catch all versions on VMS
222 do { $deleted += ($thistime = unlink $file) } while ($thistime);
223 carp "Unable to delete $file: $!" unless $deleted;
228 open(TS,">$al_idx_file") or
229 carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
230 print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
231 print TS "package $package;\n";
232 print TS map("sub $_ ;\n", @subnames);
236 check_unique($package, $Maxlen, 1, @names);
243 my($module, $maxlen, $warn, @names) = @_;
246 my(@toolong) = grep(length > $maxlen, @names);
249 my($trunc) = substr($_,0,$maxlen);
250 $notuniq{$trunc}=1 if $shorts{$trunc};
251 $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_;
253 if (%notuniq && $warn){
254 print "$module: some names are not unique when truncated to $maxlen characters:\n";
255 foreach(keys %notuniq){
256 print " $shorts{$_} truncate to $_\n";
265 # test functions so AutoSplit.pm can be applied to itself:
266 sub test1{ "test 1\n"; }
267 sub test2{ "test 2\n"; }
268 sub test3{ "test 3\n"; }
269 sub test4{ "test 4\n"; }