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 $Is_VMS = ($^O 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 ($Is_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 ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$## if $Is_VMS;
88 foreach(split(/\//,$autodir)){
91 mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
93 # We should never need to create the auto dir here. installperl
94 # (or similar) should have done it. Expecting it to exist is a valuable
95 # sanity check against autosplitting into some random directory by mistake.
96 print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n";
99 # allow just a package name to be used
100 $filename .= ".pm" unless ($filename =~ m/\.pm$/);
102 open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n";
103 my($pm_mod_time) = (stat($filename))[9];
104 my($autoloader_seen) = 0;
109 $in_pod = 0 if /^=cut/;
110 next if ($in_pod || /^=cut/);
112 # record last package name seen
113 $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
114 ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
115 ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
118 if ($check_for_autoloader && !$autoloader_seen){
119 print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2);
122 $_ or die "Can't find __END__ in $filename\n";
124 $package or die "Can't find 'package Name;' in $filename\n";
126 my($modpname) = $package; $modpname =~ s#::#/#g;
127 my($al_idx_file) = "$autodir/$modpname/$IndexFile";
129 die "Package $package does not match filename $filename"
130 unless ($filename =~ m/$modpname.pm$/ or
131 $Is_VMS && $filename =~ m/$modpname.pm/i);
133 if ($check_mod_time){
134 my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
135 if ($al_ts_time >= $pm_mod_time){
136 print "AutoSplit skipped ($al_idx_file newer that $filename)\n"
138 return undef; # one undef, not a list
142 my($from) = ($Verbose>=2) ? "$filename => " : "";
143 print "AutoSplitting $package ($from$autodir/$modpname)\n"
146 unless (-d "$autodir/$modpname"){
148 foreach(split(/\//,"$autodir/$modpname")){
151 mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
155 # We must try to deal with some SVR3 systems with a limit of 14
156 # characters for file names. Sadly we *cannot* simply truncate all
157 # file names to 14 characters on these systems because we *must*
158 # create filenames which exactly match the names used by AutoLoader.pm.
159 # This is a problem because some systems silently truncate the file
160 # names while others treat long file names as an error.
162 # We do not yet deal with multiple packages within one file.
163 # Ideally both of these styles should work.
168 # package NAME::option1;
170 # package NAME::option2;
176 # sub NAME::option1::BBB { ... }
177 # sub NAME::option2::BBB { ... }
179 # For now both of these produce warnings.
181 open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
182 my(@subnames, %proto);
184 if (/^package ([\w:]+)\s*;/) {
185 warn "package $1; in AutoSplit section ignored. Not currently supported.";
187 if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
190 $proto{$1} = $2 or '';
191 if ($subname =~ m/::/){
192 warn "subs with package names not currently supported in AutoSplit section";
194 push(@subnames, $subname);
195 my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
196 my($lpath) = "$autodir/$modpname/$lname.al";
197 my($spath) = "$autodir/$modpname/$sname.al";
198 unless(open(OUT, ">$lpath")){
199 open(OUT, ">$spath") or die "Can't create $spath: $!\n";
200 push(@names, $sname);
201 print " writing $spath (with truncated name)\n"
204 push(@names, $lname);
205 print " writing $lpath\n" if ($Verbose>=2);
207 print OUT "# NOTE: Derived from $filename. ",
208 "Changes made here will be lost.\n";
209 print OUT "package $package;\n\n";
217 if (!$keep){ # don't keep any obsolete *.al files in the directory
219 @names{@names} = @names;
220 opendir(OUTDIR,"$autodir/$modpname");
221 foreach(sort readdir(OUTDIR)){
223 my($subname) = m/(.*)\.al$/;
224 next if $names{substr($subname,0,$maxflen-3)};
225 my($file) = "$autodir/$modpname/$_";
226 print " deleting $file\n" if ($Verbose>=2);
227 my($deleted,$thistime); # catch all versions on VMS
228 do { $deleted += ($thistime = unlink $file) } while ($thistime);
229 carp "Unable to delete $file: $!" unless $deleted;
234 open(TS,">$al_idx_file") or
235 carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
236 print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
237 print TS "package $package;\n";
238 print TS map("sub $_$proto{$_} ;\n", @subnames);
242 check_unique($package, $Maxlen, 1, @names);
249 my($module, $maxlen, $warn, @names) = @_;
252 my(@toolong) = grep(length > $maxlen, @names);
255 my($trunc) = substr($_,0,$maxlen);
256 $notuniq{$trunc}=1 if $shorts{$trunc};
257 $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_;
259 if (%notuniq && $warn){
260 print "$module: some names are not unique when truncated to $maxlen characters:\n";
261 foreach(keys %notuniq){
262 print " $shorts{$_} truncate to $_\n";
271 # test functions so AutoSplit.pm can be applied to itself:
272 sub test1{ "test 1\n"; }
273 sub test2{ "test 2\n"; }
274 sub test3{ "test 3\n"; }
275 sub test4{ "test 4\n"; }