X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FAutoSplit.pm;h=f7b8eee76d7a1a6aca65774e0b7237b5977ebe94;hb=1b33cabaaf2fbe2e84c6a13a9b0a7fce45959c4f;hp=71115c6c8c6749d8135b2ca1f0140ec08ee91df5;hpb=3edbfbe5ecbb7e6fb99acc874379580a458f3cff;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm index 71115c6..f7b8eee 100644 --- a/lib/AutoSplit.pm +++ b/lib/AutoSplit.pm @@ -10,6 +10,90 @@ use Carp; @EXPORT = qw(&autosplit &autosplit_lib_modules); @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); +=head1 NAME + +AutoSplit - split a package for autoloading + +=head1 SYNOPSIS + + perl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... + + use AutoSplit; autosplit($file, $dir, $keep, $check, $modtime); + +for perl versions 5.002 and later: + + perl -MAutoSplit -e 'autosplit($ARGV[0], $ARGV[1], $k, $chk, $modtime)' ... + +=head1 DESCRIPTION + +This function will split up your program into files that the AutoLoader +module can handle. It is used by both the standard perl libraries and by +the MakeMaker utility, to automatically configure libraries for autoloading. + +The C interface splits the specified file into a hierarchy +rooted at the directory C<$dir>. It creates directories as needed to reflect +class hierarchy, and creates the file F. This file acts as +both forward declaration of all package routines, and as timestamp for the +last update of the hierarchy. + +The remaining three arguments to C govern other options to the +autosplitter. If the third argument, I<$keep>, is false, then any pre-existing +C<.al> files in the autoload directory are removed if they are no longer +part of the module (obsoleted functions). The fourth argument, I<$check>, +instructs C to check the module currently being split to ensure +that it does include a C specification for the AutoLoader module, and +skips the module if AutoLoader is not detected. Lastly, the I<$modtime> +argument specifies that C is to check the modification time of the +module against that of the C file, and only split the module +if it is newer. + +Typical use of AutoSplit in the perl MakeMaker utility is via the command-line +with: + + perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)' + +Defined as a Make macro, it is invoked with file and directory arguments; +C will split the specified file into the specified directory and +delete obsolete C<.al> files, after checking first that the module does use +the AutoLoader, and ensuring that the module is not already currently split +in its current form (the modtime test). + +The C form is used in the building of perl. It takes +as input a list of files (modules) that are assumed to reside in a directory +B relative to the current directory. Each file is sent to the +autosplitter one at a time, to be split into the directory B. + +In both usages of the autosplitter, only subroutines defined following the +perl special marker I<__END__> are split out into separate files. Some +routines may be placed prior to this marker to force their immediate loading +and parsing. + +=head1 CAVEATS + +Currently, C cannot handle multiple package specifications +within one file. + +=head1 DIAGNOSTICS + +C will inform the user if it is necessary to create the top-level +directory specified in the invocation. It is preferred that the script or +installation process that invokes C have created the full directory +path ahead of time. This warning may indicate that the module is being split +into an incorrect path. + +C will warn the user of all subroutines whose name causes potential +file naming conflicts on machines with drastically limited (8 characters or +less) file name length. Since the subroutine name is used as the file name, +these warnings can aid in portability to such systems. + +Warnings are issued and the file skipped if C cannot locate either +the I<__END__> marker or a "package Name;"-style specification. + +C will also emit general diagnostics for inability to create +directories or files. + +=cut + # for portability warn about names longer than $maxlen $Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 $Verbose = 1; # 0=none, 1=minimal, 2=list .al files @@ -20,25 +104,32 @@ $CheckModTime = 1; $IndexFile = "autosplit.ix"; # file also serves as timestamp $maxflen = 255; $maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; -$vms = ($Config{'osname'} eq 'VMS'); +$Is_VMS = ($^O eq 'VMS'); sub autosplit{ - my($file, $autodir) = @_; - autosplit_file($file, $autodir, $Keep, $CheckForAutoloader, $CheckModTime); + my($file, $autodir, $k, $ckal, $ckmt) = @_; + # $file - the perl source file to be split (after __END__) + # $autodir - the ".../auto" dir below which to write split subs + # Handle optional flags: + $keep = $Keep unless defined $k; + $ckal = $CheckForAutoloader unless defined $ckal; + $ckmt = $CheckModTime unless defined $ckmt; + autosplit_file($file, $autodir, $keep, $ckal, $ckmt); } # This function is used during perl building/installation -# ./miniperl -e 'use AutoSplit; autosplit_modules(@ARGV)' ... +# ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... sub autosplit_lib_modules{ my(@modules) = @_; # list of Module names foreach(@modules){ s#::#/#g; # incase specified as ABC::XYZ + s|\\|/|g; # bug in ksh OS/2 s#^lib/##; # incase specified as lib/*.pm - if ($vms && /[:>\]]/) { # may need to convert VMS-style filespecs + if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs my ($dir,$name) = (/(.*])(.*)/); $dir =~ s/.*lib[\.\]]//; $dir =~ s#[\.\]]#/#g; @@ -58,6 +149,10 @@ sub autosplit_file{ # where to write output files $autodir = "lib/auto" unless $autodir; + if ($Is_VMS) { + ($autodir = VMS::Filespec::unixpath($autodir)) =~ s{/$}{}; + $filename = VMS::Filespec::unixify($filename); # may have dirs + } unless (-d $autodir){ local($", @p)="/"; foreach(split(/\//,$autodir)){ @@ -77,12 +172,17 @@ sub autosplit_file{ open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n"; my($pm_mod_time) = (stat($filename))[9]; my($autoloader_seen) = 0; + my($in_pod) = 0; while () { + # Skip pod text. + $in_pod = 1 if /^=/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); + # record last package name seen $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; - ++$autoloader_seen if m/^\s*sub\s+AUTOLOAD\b/; last if /^__END__/; } if ($check_for_autoloader && !$autoloader_seen){ @@ -98,7 +198,8 @@ sub autosplit_file{ die "Package $package does not match filename $filename" unless ($filename =~ m/$modpname.pm$/ or - $vms && $filename =~ m/$modpname.pm/i); + ($^O eq "msdos") or + $Is_VMS && $filename =~ m/$modpname.pm/i); if ($check_mod_time){ my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; @@ -149,14 +250,18 @@ sub autosplit_file{ # For now both of these produce warnings. open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning - my(@subnames); + my(@subnames, %proto); + my @cache = (); + my $caching = 1; while () { + next if /^=\w/ .. /^=cut/; if (/^package ([\w:]+)\s*;/) { warn "package $1; in AutoSplit section ignored. Not currently supported."; } - if (/^sub ([\w:]+)/) { + if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) { print OUT "1;\n"; - my($subname) = $1; + my $subname = $1; + $proto{$1} = $2 || ''; if ($subname =~ m/::/){ warn "subs with package names not currently supported in AutoSplit section"; } @@ -176,10 +281,26 @@ sub autosplit_file{ print OUT "# NOTE: Derived from $filename. ", "Changes made here will be lost.\n"; print OUT "package $package;\n\n"; + print OUT @cache; + @cache = (); + $caching = 0; + } + if($caching) { + push(@cache, $_) if @cache || /\S/; + } + else { + print OUT $_; + } + if(/^}/) { + if($caching) { + print OUT @cache; + @cache = (); + } + print OUT "\n"; + $caching = 1; } - print OUT $_; } - print OUT "1;\n"; + print OUT @cache,"1;\n"; close(OUT); close(IN); @@ -193,7 +314,9 @@ sub autosplit_file{ next if $names{substr($subname,0,$maxflen-3)}; my($file) = "$autodir/$modpname/$_"; print " deleting $file\n" if ($Verbose>=2); - unlink $file or carp "Unable to delete $file: $!"; + my($deleted,$thistime); # catch all versions on VMS + do { $deleted += ($thistime = unlink $file) } while ($thistime); + carp "Unable to delete $file: $!" unless $deleted; } closedir(OUTDIR); } @@ -201,7 +324,9 @@ sub autosplit_file{ open(TS,">$al_idx_file") or carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!"; print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n"; - print TS map("sub $_ ;\n", @subnames); + print TS "package $package;\n"; + print TS map("sub $_$proto{$_} ;\n", @subnames); + print TS "1;\n"; close(TS); check_unique($package, $Maxlen, 1, @names);