| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package AutoSplit; 2 3 use Exporter (); 4 use Config qw(%Config); 5 use File::Basename (); 6 use File::Path qw(mkpath); 7 use File::Spec::Functions qw(curdir catfile catdir); 8 use strict; 9 our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen, 10 $CheckForAutoloader, $CheckModTime); 11 12 $VERSION = "1.05"; 13 @ISA = qw(Exporter); 14 @EXPORT = qw(&autosplit &autosplit_lib_modules); 15 @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); 16 17 =head1 NAME 18 19 AutoSplit - split a package for autoloading 20 21 =head1 SYNOPSIS 22 23 autosplit($file, $dir, $keep, $check, $modtime); 24 25 autosplit_lib_modules(@modules); 26 27 =head1 DESCRIPTION 28 29 This function will split up your program into files that the AutoLoader 30 module can handle. It is used by both the standard perl libraries and by 31 the MakeMaker utility, to automatically configure libraries for autoloading. 32 33 The C<autosplit> interface splits the specified file into a hierarchy 34 rooted at the directory C<$dir>. It creates directories as needed to reflect 35 class hierarchy, and creates the file F<autosplit.ix>. This file acts as 36 both forward declaration of all package routines, and as timestamp for the 37 last update of the hierarchy. 38 39 The remaining three arguments to C<autosplit> govern other options to 40 the autosplitter. 41 42 =over 2 43 44 =item $keep 45 46 If the third argument, I<$keep>, is false, then any 47 pre-existing C<*.al> files in the autoload directory are removed if 48 they are no longer part of the module (obsoleted functions). 49 $keep defaults to 0. 50 51 =item $check 52 53 The 54 fourth argument, I<$check>, instructs C<autosplit> to check the module 55 currently being split to ensure that it includes a C<use> 56 specification for the AutoLoader module, and skips the module if 57 AutoLoader is not detected. 58 $check defaults to 1. 59 60 =item $modtime 61 62 Lastly, the I<$modtime> argument specifies 63 that C<autosplit> is to check the modification time of the module 64 against that of the C<autosplit.ix> file, and only split the module if 65 it is newer. 66 $modtime defaults to 1. 67 68 =back 69 70 Typical use of AutoSplit in the perl MakeMaker utility is via the command-line 71 with: 72 73 perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)' 74 75 Defined as a Make macro, it is invoked with file and directory arguments; 76 C<autosplit> will split the specified file into the specified directory and 77 delete obsolete C<.al> files, after checking first that the module does use 78 the AutoLoader, and ensuring that the module is not already currently split 79 in its current form (the modtime test). 80 81 The C<autosplit_lib_modules> form is used in the building of perl. It takes 82 as input a list of files (modules) that are assumed to reside in a directory 83 B<lib> relative to the current directory. Each file is sent to the 84 autosplitter one at a time, to be split into the directory B<lib/auto>. 85 86 In both usages of the autosplitter, only subroutines defined following the 87 perl I<__END__> token are split out into separate files. Some 88 routines may be placed prior to this marker to force their immediate loading 89 and parsing. 90 91 =head2 Multiple packages 92 93 As of version 1.01 of the AutoSplit module it is possible to have 94 multiple packages within a single file. Both of the following cases 95 are supported: 96 97 package NAME; 98 __END__ 99 sub AAA { ... } 100 package NAME::option1; 101 sub BBB { ... } 102 package NAME::option2; 103 sub BBB { ... } 104 105 package NAME; 106 __END__ 107 sub AAA { ... } 108 sub NAME::option1::BBB { ... } 109 sub NAME::option2::BBB { ... } 110 111 =head1 DIAGNOSTICS 112 113 C<AutoSplit> will inform the user if it is necessary to create the 114 top-level directory specified in the invocation. It is preferred that 115 the script or installation process that invokes C<AutoSplit> have 116 created the full directory path ahead of time. This warning may 117 indicate that the module is being split into an incorrect path. 118 119 C<AutoSplit> will warn the user of all subroutines whose name causes 120 potential file naming conflicts on machines with drastically limited 121 (8 characters or less) file name length. Since the subroutine name is 122 used as the file name, these warnings can aid in portability to such 123 systems. 124 125 Warnings are issued and the file skipped if C<AutoSplit> cannot locate 126 either the I<__END__> marker or a "package Name;"-style specification. 127 128 C<AutoSplit> will also emit general diagnostics for inability to 129 create directories or files. 130 131 =cut 132 133 # for portability warn about names longer than $maxlen 134 $Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 135 $Verbose = 1; # 0=none, 1=minimal, 2=list .al files 136 $Keep = 0; 137 $CheckForAutoloader = 1; 138 $CheckModTime = 1; 139 140 my $IndexFile = "autosplit.ix"; # file also serves as timestamp 141 my $maxflen = 255; 142 $maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; 143 if (defined (&Dos::UseLFN)) { 144 $maxflen = Dos::UseLFN() ? 255 : 11; 145 } 146 my $Is_VMS = ($^O eq 'VMS'); 147 148 # allow checking for valid ': attrlist' attachments. 149 # extra jugglery required to support both 5.8 and 5.9/5.10 features 150 # (support for 5.8 required for cross-compiling environments) 151 152 my $attr_list = 153 $] >= 5.009005 ? 154 eval <<'__QR__' 155 qr{ 156 \s* : \s* 157 (?: 158 # one attribute 159 (?> # no backtrack 160 (?! \d) \w+ 161 (?<nested> \( (?: [^()]++ | (?&nested)++ )*+ \) ) ? 162 ) 163 (?: \s* : \s* | \s+ (?! :) ) 164 )* 165 }x 166 __QR__ 167 : 168 do { 169 # In pre-5.9.5 world we have to do dirty tricks. 170 # (we use 'our' rather than 'my' here, due to the rather complex and buggy 171 # behaviour of lexicals with qr// and (??{$lex}) ) 172 our $trick1; # yes, cannot our and assign at the same time. 173 $trick1 = qr{ \( (?: (?> [^()]+ ) | (??{ $trick1 }) )* \) }x; 174 our $trick2 = qr{ (?> (?! \d) \w+ (?:$trick1)? ) (?:\s*\:\s*|\s+(?!\:)) }x; 175 qr{ \s* : \s* (?: $trick2 )* }x; 176 }; 177 178 sub autosplit{ 179 my($file, $autodir, $keep, $ckal, $ckmt) = @_; 180 # $file - the perl source file to be split (after __END__) 181 # $autodir - the ".../auto" dir below which to write split subs 182 # Handle optional flags: 183 $keep = $Keep unless defined $keep; 184 $ckal = $CheckForAutoloader unless defined $ckal; 185 $ckmt = $CheckModTime unless defined $ckmt; 186 autosplit_file($file, $autodir, $keep, $ckal, $ckmt); 187 } 188 189 sub carp{ 190 require Carp; 191 goto &Carp::carp; 192 } 193 194 # This function is used during perl building/installation 195 # ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... 196 197 sub autosplit_lib_modules { 198 my(@modules) = @_; # list of Module names 199 local $_; # Avoid clobber. 200 while (defined($_ = shift @modules)) { 201 while (m#([^:]+)::([^:].*)#) { # in case specified as ABC::XYZ 202 $_ = catfile($1, $2); 203 } 204 s|\\|/|g; # bug in ksh OS/2 205 s#^lib/##s; # incase specified as lib/*.pm 206 my($lib) = catfile(curdir(), "lib"); 207 if ($Is_VMS) { # may need to convert VMS-style filespecs 208 $lib =~ s#^\[\]#.\/#; 209 } 210 s#^$lib\W+##s; # incase specified as ./lib/*.pm 211 if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs 212 my ($dir,$name) = (/(.*])(.*)/s); 213 $dir =~ s/.*lib[\.\]]//s; 214 $dir =~ s#[\.\]]#/#g; 215 $_ = $dir . $name; 216 } 217 autosplit_file(catfile($lib, $_), catfile($lib, "auto"), 218 $Keep, $CheckForAutoloader, $CheckModTime); 219 } 220 0; 221 } 222 223 224 # private functions 225 226 my $self_mod_time = (stat __FILE__)[9]; 227 228 sub autosplit_file { 229 my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) 230 = @_; 231 my(@outfiles); 232 local($_); 233 local($/) = "\n"; 234 235 # where to write output files 236 $autodir ||= catfile(curdir(), "lib", "auto"); 237 if ($Is_VMS) { 238 ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||; 239 $filename = VMS::Filespec::unixify($filename); # may have dirs 240 } 241 unless (-d $autodir){ 242 mkpath($autodir,0,0755); 243 # We should never need to create the auto dir 244 # here. installperl (or similar) should have done 245 # it. Expecting it to exist is a valuable sanity check against 246 # autosplitting into some random directory by mistake. 247 print "Warning: AutoSplit had to create top-level " . 248 "$autodir unexpectedly.\n"; 249 } 250 251 # allow just a package name to be used 252 $filename .= ".pm" unless ($filename =~ m/\.pm\z/); 253 254 open(my $in, "<$filename") or die "AutoSplit: Can't open $filename: $!\n"; 255 my($pm_mod_time) = (stat($filename))[9]; 256 my($autoloader_seen) = 0; 257 my($in_pod) = 0; 258 my($def_package,$last_package,$this_package,$fnr); 259 while (<$in>) { 260 # Skip pod text. 261 $fnr++; 262 $in_pod = 1 if /^=\w/; 263 $in_pod = 0 if /^=cut/; 264 next if ($in_pod || /^=cut/); 265 next if /^\s*#/; 266 267 # record last package name seen 268 $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); 269 ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; 270 ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; 271 last if /^__END__/; 272 } 273 if ($check_for_autoloader && !$autoloader_seen){ 274 print "AutoSplit skipped $filename: no AutoLoader used\n" 275 if ($Verbose>=2); 276 return 0; 277 } 278 $_ or die "Can't find __END__ in $filename\n"; 279 280 $def_package or die "Can't find 'package Name;' in $filename\n"; 281 282 my($modpname) = _modpname($def_package); 283 284 # this _has_ to match so we have a reasonable timestamp file 285 die "Package $def_package ($modpname.pm) does not ". 286 "match filename $filename" 287 unless ($filename =~ m/\Q$modpname.pm\E$/ or 288 ($^O eq 'dos') or ($^O eq 'MSWin32') or ($^O eq 'NetWare') or 289 $Is_VMS && $filename =~ m/$modpname.pm/i); 290 291 my($al_idx_file) = catfile($autodir, $modpname, $IndexFile); 292 293 if ($check_mod_time){ 294 my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; 295 if ($al_ts_time >= $pm_mod_time and 296 $al_ts_time >= $self_mod_time){ 297 print "AutoSplit skipped ($al_idx_file newer than $filename)\n" 298 if ($Verbose >= 2); 299 return undef; # one undef, not a list 300 } 301 } 302 303 my($modnamedir) = catdir($autodir, $modpname); 304 print "AutoSplitting $filename ($modnamedir)\n" 305 if $Verbose; 306 307 unless (-d $modnamedir){ 308 mkpath($modnamedir,0,0777); 309 } 310 311 # We must try to deal with some SVR3 systems with a limit of 14 312 # characters for file names. Sadly we *cannot* simply truncate all 313 # file names to 14 characters on these systems because we *must* 314 # create filenames which exactly match the names used by AutoLoader.pm. 315 # This is a problem because some systems silently truncate the file 316 # names while others treat long file names as an error. 317 318 my $Is83 = $maxflen==11; # plain, case INSENSITIVE dos filenames 319 320 my(@subnames, $subname, %proto, %package); 321 my @cache = (); 322 my $caching = 1; 323 $last_package = ''; 324 my $out; 325 while (<$in>) { 326 $fnr++; 327 $in_pod = 1 if /^=\w/; 328 $in_pod = 0 if /^=cut/; 329 next if ($in_pod || /^=cut/); 330 # the following (tempting) old coding gives big troubles if a 331 # cut is forgotten at EOF: 332 # next if /^=\w/ .. /^=cut/; 333 if (/^package\s+([\w:]+)\s*;/) { 334 $this_package = $def_package = $1; 335 } 336 337 if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) { 338 print $out "# end of $last_package\::$subname\n1;\n" 339 if $last_package; 340 $subname = $1; 341 my $proto = $2 || ''; 342 if ($subname =~ s/(.*):://){ 343 $this_package = $1; 344 } else { 345 $this_package = $def_package; 346 } 347 my $fq_subname = "$this_package\::$subname"; 348 $package{$fq_subname} = $this_package; 349 $proto{$fq_subname} = $proto; 350 push(@subnames, $fq_subname); 351 my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); 352 $modpname = _modpname($this_package); 353 my($modnamedir) = catdir($autodir, $modpname); 354 mkpath($modnamedir,0,0777); 355 my($lpath) = catfile($modnamedir, "$lname.al"); 356 my($spath) = catfile($modnamedir, "$sname.al"); 357 my $path; 358 359 if (!$Is83 and open($out, ">$lpath")){ 360 $path=$lpath; 361 print " writing $lpath\n" if ($Verbose>=2); 362 } else { 363 open($out, ">$spath") or die "Can't create $spath: $!\n"; 364 $path=$spath; 365 print " writing $spath (with truncated name)\n" 366 if ($Verbose>=1); 367 } 368 push(@outfiles, $path); 369 my $lineno = $fnr - @cache; 370 print $out <<EOT; 371 # NOTE: Derived from $filename. 372 # Changes made here will be lost when autosplit is run again. 373 # See AutoSplit.pm. 374 package $this_package; 375 376 #line $lineno "$filename (autosplit into $path)" 377 EOT 378 print $out @cache; 379 @cache = (); 380 $caching = 0; 381 } 382 if($caching) { 383 push(@cache, $_) if @cache || /\S/; 384 } else { 385 print $out $_; 386 } 387 if(/^\}/) { 388 if($caching) { 389 print $out @cache; 390 @cache = (); 391 } 392 print $out "\n"; 393 $caching = 1; 394 } 395 $last_package = $this_package if defined $this_package; 396 } 397 if ($subname) { 398 print $out @cache,"1;\n# end of $last_package\::$subname\n"; 399 close($out); 400 } 401 close($in); 402 403 if (!$keep){ # don't keep any obsolete *.al files in the directory 404 my(%outfiles); 405 # @outfiles{@outfiles} = @outfiles; 406 # perl downcases all filenames on VMS (which upcases all filenames) so 407 # we'd better downcase the sub name list too, or subs with upper case 408 # letters in them will get their .al files deleted right after they're 409 # created. (The mixed case sub name won't match the all-lowercase 410 # filename, and so be cleaned up as a scrap file) 411 if ($Is_VMS or $Is83) { 412 %outfiles = map {lc($_) => lc($_) } @outfiles; 413 } else { 414 @outfiles{@outfiles} = @outfiles; 415 } 416 my(%outdirs,@outdirs); 417 for (@outfiles) { 418 $outdirs{File::Basename::dirname($_)}||=1; 419 } 420 for my $dir (keys %outdirs) { 421 opendir(my $outdir,$dir); 422 foreach (sort readdir($outdir)){ 423 next unless /\.al\z/; 424 my($file) = catfile($dir, $_); 425 $file = lc $file if $Is83 or $Is_VMS; 426 next if $outfiles{$file}; 427 print " deleting $file\n" if ($Verbose>=2); 428 my($deleted,$thistime); # catch all versions on VMS 429 do { $deleted += ($thistime = unlink $file) } while ($thistime); 430 carp ("Unable to delete $file: $!") unless $deleted; 431 } 432 closedir($outdir); 433 } 434 } 435 436 open(my $ts,">$al_idx_file") or 437 carp ("AutoSplit: unable to create timestamp file ($al_idx_file): $!"); 438 print $ts "# Index created by AutoSplit for $filename\n"; 439 print $ts "# (file acts as timestamp)\n"; 440 $last_package = ''; 441 for my $fqs (@subnames) { 442 my($subname) = $fqs; 443 $subname =~ s/.*:://; 444 print $ts "package $package{$fqs};\n" 445 unless $last_package eq $package{$fqs}; 446 print $ts "sub $subname $proto{$fqs};\n"; 447 $last_package = $package{$fqs}; 448 } 449 print $ts "1;\n"; 450 close($ts); 451 452 _check_unique($filename, $Maxlen, 1, @outfiles); 453 454 @outfiles; 455 } 456 457 sub _modpname ($) { 458 my($package) = @_; 459 my $modpname = $package; 460 if ($^O eq 'MSWin32') { 461 $modpname =~ s#::#\\#g; 462 } else { 463 my @modpnames = (); 464 while ($modpname =~ m#(.*?[^:])::([^:].*)#) { 465 push @modpnames, $1; 466 $modpname = $2; 467 } 468 $modpname = catfile(@modpnames, $modpname); 469 } 470 if ($Is_VMS) { 471 $modpname = VMS::Filespec::unixify($modpname); # may have dirs 472 } 473 $modpname; 474 } 475 476 sub _check_unique { 477 my($filename, $maxlen, $warn, @outfiles) = @_; 478 my(%notuniq) = (); 479 my(%shorts) = (); 480 my(@toolong) = grep( 481 length(File::Basename::basename($_)) 482 > $maxlen, 483 @outfiles 484 ); 485 486 foreach (@toolong){ 487 my($dir) = File::Basename::dirname($_); 488 my($file) = File::Basename::basename($_); 489 my($trunc) = substr($file,0,$maxlen); 490 $notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc}; 491 $shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ? 492 "$shorts{$dir}{$trunc}, $file" : $file; 493 } 494 if (%notuniq && $warn){ 495 print "$filename: some names are not unique when " . 496 "truncated to $maxlen characters:\n"; 497 foreach my $dir (sort keys %notuniq){ 498 print " directory $dir:\n"; 499 foreach my $trunc (sort keys %{$notuniq{$dir}}) { 500 print " $shorts{$dir}{$trunc} truncate to $trunc\n"; 501 } 502 } 503 } 504 } 505 506 1; 507 __END__ 508 509 # test functions so AutoSplit.pm can be applied to itself: 510 sub test1 ($) { "test 1\n"; } 511 sub test2 ($$) { "test 2\n"; } 512 sub test3 ($$$) { "test 3\n"; } 513 sub testtesttesttest4_1 { "test 4\n"; } 514 sub testtesttesttest4_2 { "duplicate test 4\n"; } 515 sub Just::Another::test5 { "another test 5\n"; } 516 sub test6 { return join ":", __FILE__,__LINE__; } 517 package Yet::Another::AutoSplit; 518 sub testtesttesttest4_1 ($) { "another test 4\n"; } 519 sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; } 520 package Yet::More::Attributes; 521 sub test_a1 ($) : locked :locked { 1; } 522 sub test_a2 : locked { 1; }
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |