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|\\|/|g; # bug in ksh OS/2
60 s#^lib/##; # incase specified as lib/*.pm
61 if ($vms && /[:>\]]/) { # may need to convert VMS-style filespecs
62 my ($dir,$name) = (/(.*])(.*)/);
63 $dir =~ s/.*lib[\.\]]//;
67 autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime);
76 my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_;
79 # where to write output files
80 $autodir = "lib/auto" unless $autodir;
81 if ($Config{'osname'} eq 'VMS') {
82 ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$##;
86 foreach(split(/\//,$autodir)){
89 mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
91 # We should never need to create the auto dir here. installperl
92 # (or similar) should have done it. Expecting it to exist is a valuable
93 # sanity check against autosplitting into some random directory by mistake.
94 print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n";
97 # allow just a package name to be used
98 $filename .= ".pm" unless ($filename =~ m/\.pm$/);
100 open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n";
101 my($pm_mod_time) = (stat($filename))[9];
102 my($autoloader_seen) = 0;
107 $in_pod = 0 if /^=cut/;
108 next if ($in_pod || /^=cut/);
110 # record last package name seen
111 $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
112 ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
113 ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
116 if ($check_for_autoloader && !$autoloader_seen){
117 print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2);
120 $_ or die "Can't find __END__ in $filename\n";
122 $package or die "Can't find 'package Name;' in $filename\n";
124 my($modpname) = $package; $modpname =~ s#::#/#g;
125 my($al_idx_file) = "$autodir/$modpname/$IndexFile";
127 die "Package $package does not match filename $filename"
128 unless ($filename =~ m/$modpname.pm$/ or
129 $vms && $filename =~ m/$modpname.pm/i);
131 if ($check_mod_time){
132 my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
133 if ($al_ts_time >= $pm_mod_time){
134 print "AutoSplit skipped ($al_idx_file newer that $filename)\n"
136 return undef; # one undef, not a list
140 my($from) = ($Verbose>=2) ? "$filename => " : "";
141 print "AutoSplitting $package ($from$autodir/$modpname)\n"
144 unless (-d "$autodir/$modpname"){
146 foreach(split(/\//,"$autodir/$modpname")){
149 mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
153 # We must try to deal with some SVR3 systems with a limit of 14
154 # characters for file names. Sadly we *cannot* simply truncate all
155 # file names to 14 characters on these systems because we *must*
156 # create filenames which exactly match the names used by AutoLoader.pm.
157 # This is a problem because some systems silently truncate the file
158 # names while others treat long file names as an error.
160 # We do not yet deal with multiple packages within one file.
161 # Ideally both of these styles should work.
166 # package NAME::option1;
168 # package NAME::option2;
174 # sub NAME::option1::BBB { ... }
175 # sub NAME::option2::BBB { ... }
177 # For now both of these produce warnings.
179 open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
180 my(@subnames, %proto);
182 if (/^package ([\w:]+)\s*;/) {
183 warn "package $1; in AutoSplit section ignored. Not currently supported.";
185 if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
188 $proto{$1} = $2 or '';
189 if ($subname =~ m/::/){
190 warn "subs with package names not currently supported in AutoSplit section";
192 push(@subnames, $subname);
193 my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
194 my($lpath) = "$autodir/$modpname/$lname.al";
195 my($spath) = "$autodir/$modpname/$sname.al";
196 unless(open(OUT, ">$lpath")){
197 open(OUT, ">$spath") or die "Can't create $spath: $!\n";
198 push(@names, $sname);
199 print " writing $spath (with truncated name)\n"
202 push(@names, $lname);
203 print " writing $lpath\n" if ($Verbose>=2);
205 print OUT "# NOTE: Derived from $filename. ",
206 "Changes made here will be lost.\n";
207 print OUT "package $package;\n\n";
215 if (!$keep){ # don't keep any obsolete *.al files in the directory
217 @names{@names} = @names;
218 opendir(OUTDIR,"$autodir/$modpname");
219 foreach(sort readdir(OUTDIR)){
221 my($subname) = m/(.*)\.al$/;
222 next if $names{substr($subname,0,$maxflen-3)};
223 my($file) = "$autodir/$modpname/$_";
224 print " deleting $file\n" if ($Verbose>=2);
225 my($deleted,$thistime); # catch all versions on VMS
226 do { $deleted += ($thistime = unlink $file) } while ($thistime);
227 carp "Unable to delete $file: $!" unless $deleted;
232 open(TS,">$al_idx_file") or
233 carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
234 print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
235 print TS "package $package;\n";
236 print TS map("sub $_$proto{$_} ;\n", @subnames);
240 check_unique($package, $Maxlen, 1, @names);
247 my($module, $maxlen, $warn, @names) = @_;
250 my(@toolong) = grep(length > $maxlen, @names);
253 my($trunc) = substr($_,0,$maxlen);
254 $notuniq{$trunc}=1 if $shorts{$trunc};
255 $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_;
257 if (%notuniq && $warn){
258 print "$module: some names are not unique when truncated to $maxlen characters:\n";
259 foreach(keys %notuniq){
260 print " $shorts{$_} truncate to $_\n";
269 # test functions so AutoSplit.pm can be applied to itself:
270 sub test1{ "test 1\n"; }
271 sub test2{ "test 2\n"; }
272 sub test3{ "test 3\n"; }
273 sub test4{ "test 4\n"; }