10 @EXPORT = qw(&autosplit &autosplit_lib_modules);
11 @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
15 AutoSplit - split a package for autoloading
19 perl -e 'use AutoSplit; autosplit_modules(@ARGV)' ...
23 This function will split up your program into files that the AutoLoader
24 module can handle. Normally only used to build autoloading Perl library
25 modules, especially extensions (like POSIX). You should look at how
26 they're built out for details.
30 # for portability warn about names longer than $maxlen
31 $Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3
32 $Verbose = 1; # 0=none, 1=minimal, 2=list .al files
34 $CheckForAutoloader = 1;
37 $IndexFile = "autosplit.ix"; # file also serves as timestamp
39 $maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
40 $vms = ($Config{'osname'} eq 'VMS');
44 my($file, $autodir, $k, $ckal, $ckmt) = @_;
45 # $file - the perl source file to be split (after __END__)
46 # $autodir - the ".../auto" dir below which to write split subs
47 # Handle optional flags:
48 $keep = $Keep unless defined $k;
49 $ckal = $CheckForAutoloader unless defined $ckal;
50 $ckmt = $CheckModTime unless defined $ckmt;
51 autosplit_file($file, $autodir, $keep, $ckal, $ckmt);
55 # This function is used during perl building/installation
56 # ./miniperl -e 'use AutoSplit; autosplit_modules(@ARGV)' ...
58 sub autosplit_lib_modules{
59 my(@modules) = @_; # list of Module names
62 s#::#/#g; # incase specified as ABC::XYZ
63 s|\\|/|g; # bug in ksh OS/2
64 s#^lib/##; # incase specified as lib/*.pm
65 if ($vms && /[:>\]]/) { # may need to convert VMS-style filespecs
66 my ($dir,$name) = (/(.*])(.*)/);
67 $dir =~ s/.*lib[\.\]]//;
71 autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime);
80 my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_;
83 # where to write output files
84 $autodir = "lib/auto" unless $autodir;
85 if ($Config{'osname'} eq 'VMS') {
86 ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$##;
90 foreach(split(/\//,$autodir)){
93 mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
95 # We should never need to create the auto dir here. installperl
96 # (or similar) should have done it. Expecting it to exist is a valuable
97 # sanity check against autosplitting into some random directory by mistake.
98 print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n";
101 # allow just a package name to be used
102 $filename .= ".pm" unless ($filename =~ m/\.pm$/);
104 open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n";
105 my($pm_mod_time) = (stat($filename))[9];
106 my($autoloader_seen) = 0;
111 $in_pod = 0 if /^=cut/;
112 next if ($in_pod || /^=cut/);
114 # record last package name seen
115 $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
116 ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
117 ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
120 if ($check_for_autoloader && !$autoloader_seen){
121 print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2);
124 $_ or die "Can't find __END__ in $filename\n";
126 $package or die "Can't find 'package Name;' in $filename\n";
128 my($modpname) = $package; $modpname =~ s#::#/#g;
129 my($al_idx_file) = "$autodir/$modpname/$IndexFile";
131 die "Package $package does not match filename $filename"
132 unless ($filename =~ m/$modpname.pm$/ or
133 $vms && $filename =~ m/$modpname.pm/i);
135 if ($check_mod_time){
136 my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
137 if ($al_ts_time >= $pm_mod_time){
138 print "AutoSplit skipped ($al_idx_file newer that $filename)\n"
140 return undef; # one undef, not a list
144 my($from) = ($Verbose>=2) ? "$filename => " : "";
145 print "AutoSplitting $package ($from$autodir/$modpname)\n"
148 unless (-d "$autodir/$modpname"){
150 foreach(split(/\//,"$autodir/$modpname")){
153 mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
157 # We must try to deal with some SVR3 systems with a limit of 14
158 # characters for file names. Sadly we *cannot* simply truncate all
159 # file names to 14 characters on these systems because we *must*
160 # create filenames which exactly match the names used by AutoLoader.pm.
161 # This is a problem because some systems silently truncate the file
162 # names while others treat long file names as an error.
164 # We do not yet deal with multiple packages within one file.
165 # Ideally both of these styles should work.
170 # package NAME::option1;
172 # package NAME::option2;
178 # sub NAME::option1::BBB { ... }
179 # sub NAME::option2::BBB { ... }
181 # For now both of these produce warnings.
183 open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
184 my(@subnames, %proto);
186 if (/^package ([\w:]+)\s*;/) {
187 warn "package $1; in AutoSplit section ignored. Not currently supported.";
189 if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
192 $proto{$1} = $2 or '';
193 if ($subname =~ m/::/){
194 warn "subs with package names not currently supported in AutoSplit section";
196 push(@subnames, $subname);
197 my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
198 my($lpath) = "$autodir/$modpname/$lname.al";
199 my($spath) = "$autodir/$modpname/$sname.al";
200 unless(open(OUT, ">$lpath")){
201 open(OUT, ">$spath") or die "Can't create $spath: $!\n";
202 push(@names, $sname);
203 print " writing $spath (with truncated name)\n"
206 push(@names, $lname);
207 print " writing $lpath\n" if ($Verbose>=2);
209 print OUT "# NOTE: Derived from $filename. ",
210 "Changes made here will be lost.\n";
211 print OUT "package $package;\n\n";
219 if (!$keep){ # don't keep any obsolete *.al files in the directory
221 @names{@names} = @names;
222 opendir(OUTDIR,"$autodir/$modpname");
223 foreach(sort readdir(OUTDIR)){
225 my($subname) = m/(.*)\.al$/;
226 next if $names{substr($subname,0,$maxflen-3)};
227 my($file) = "$autodir/$modpname/$_";
228 print " deleting $file\n" if ($Verbose>=2);
229 my($deleted,$thistime); # catch all versions on VMS
230 do { $deleted += ($thistime = unlink $file) } while ($thistime);
231 carp "Unable to delete $file: $!" unless $deleted;
236 open(TS,">$al_idx_file") or
237 carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
238 print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
239 print TS "package $package;\n";
240 print TS map("sub $_$proto{$_} ;\n", @subnames);
244 check_unique($package, $Maxlen, 1, @names);
251 my($module, $maxlen, $warn, @names) = @_;
254 my(@toolong) = grep(length > $maxlen, @names);
257 my($trunc) = substr($_,0,$maxlen);
258 $notuniq{$trunc}=1 if $shorts{$trunc};
259 $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_;
261 if (%notuniq && $warn){
262 print "$module: some names are not unique when truncated to $maxlen characters:\n";
263 foreach(keys %notuniq){
264 print " $shorts{$_} truncate to $_\n";
273 # test functions so AutoSplit.pm can be applied to itself:
274 sub test1{ "test 1\n"; }
275 sub test2{ "test 2\n"; }
276 sub test3{ "test 3\n"; }
277 sub test4{ "test 4\n"; }