: # feed this into perl '/bin/true' && eval 'exec perl -S $0 "$@"' if $running_under_some_shell; 'di'; 'ig00'; # # This perl script is its own manual page [generated by wrapman] # # $Id: perload,v 3.0.1.1 1994/10/29 15:45:36 ram Exp ram $ # # Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi # # You may redistribute only under the terms of the Artistic Licence, # as specified in the README file that comes with the distribution. # You may reuse parts of this distribution only within the terms of # that same Artistic Licence; a copy of which may be found at the root # of the source tree for dist 4.0. # # $Log: perload,v $ # Revision 3.0.1.1 1994/10/29 15:45:36 ram # patch36: added minimal support for perl5 dataloading # # Revision 3.0 1993/08/18 12:04:06 ram # Baseline for dist 3.0 netwide release. # # Replace each function definition in a loading section by two stubs and # reject the definition into the DATA part of the script if in a dataload # section or into a FILE if in an autoload section. $in_load = 0; # In a loading section $autoload = ''; # Name of autoloaded file $has_invocation_stub = 0; # True if we detect a #! stub $current_package = 'main'; # Current package $init_emitted = 0; # True when dataloading stamp was emitted $in_function = 0; require 'getopt.pl'; &Getopt; while (<>) { if ($. == 1 && /^(:|#).*perl/) { # Invocation stub $has_invocation_stub = 1; print; next; } if ($. <= 3 && $has_invocation_stub) { print; next; } if (/^\s*$/) { &flush_comment; print unless $in_function; print if $in_function && !$in_load; if ($in_function && $in_load) { push(@Data, "\n") unless $autoload; $Auto{$autoload} .= "\n" if $autoload; } next; } if (/^\s*;?#/) { if (/#\s*perload on/i) { # Enter a loading section print unless /:$/; $in_load = 1; next; } if (/#\s*perload off/i) { # End a loading section print unless /:$/; $in_load = 0; next; } if (/#\s*autoload (\S+)/i) { # Enter autoloading section print unless /:$/; push(@autoload, $autoload); # Directives may be nested $autoload = $1; $in_load += 2; next; } if (/#\s*offload/i) { # End autoloading section print unless /:$/; $autoload = pop(@autoload); # Revert to previously active file $in_load -= 2; next; } &emit_init unless $init_emitted; push(@Comment, $_) unless $in_function; print if $in_function && !$in_load; next unless $in_function; push(@Data, $_) unless $autoload; $Auto{$autoload} .= $_ if $autoload; next; } &emit_init unless $init_emitted; /^package (\S+)\s*;/ && ($current_package = $1); unless ($in_load) { &flush_comment; print; next; } # We are in a loading section if (/^sub\s+([\w']+)\s*\{(.*)/) { die "line $.: function $1 defined within another function.\n" if $in_function; # Silently ignore one-line functions if (/\}/) { &flush_comment; print; next; } $comment = $2; $in_function = 1; $function = $1; ($fn_package, $fn_basename) = $function =~ /^(\w+)'(\w+)/; unless ($fn_package) { $fn_package = $current_package; $fn_basename = $function; } die "line $.: duplicate routine ${fn_package}::$fn_basename\n" if $Seen{"${fn_package}::$fn_basename"}++; # Keep leading function comment foreach (@Comment) { push(@Data, $_) unless $autoload; $Auto{$autoload} .= $_ if $autoload; } @Comment = (); # Change package context for correct compilation: the name is visible # within the original function package while the body of the function # is compiled within the current package. $declaration = "sub $fn_package" . "'load_$fn_basename {$comment\n"; $package_context = "\tpackage $current_package;\n"; if ($autoload) { $Auto{$autoload} .= $declaration . $package_context; } else { push(@Data, $declaration, $package_context); } # Emit stubs print "sub $fn_package", "'$fn_basename"; print " { &auto_$fn_package", "'$fn_basename; }\n"; print "sub auto_$fn_package", "'$fn_basename { "; print '&main\'dataload' unless $autoload; print '&main\'autoload(' . "'$autoload'" . ', @_)' if $autoload; print "; }\n"; next; } unless ($in_function) { &flush_comment; print; next; } # We are in a loading section and inside a function body push(@Data, $_) unless $autoload; $Auto{$autoload} .= $_ if $autoload; $in_function = 0 if /^\}/; if (/^\}/) { push(@Data, "\n") unless $autoload; $Auto{$autoload} .= "\n" if $autoload; } } @auto = keys %Auto; if (@auto > 0) { print &q(<<'EOC'); :# Load the calling function from file and call it. This function is called :# only once per file to be loaded. :sub main'autoload { : local($__file__) = shift(@_); : local($__packname__) = (caller(1))[3]; : $__packname__ =~ s/::/'/; : local($__rpackname__) = $__packname__; : local($__saved__) = $@; : $__rpackname__ =~ s/^auto_//; : &perload'load_from_file($__file__); : $__rpackname__ =~ s/'/'load_/; : $@ = $__saved__; # Restore value $@ had on entrance : &$__rpackname__(@_); # Call newly loaded function :} : :# Load file and compile it, substituing the second stub function with the :# loaded ones. Location of the file uses the @AUTO array. :sub perload'load_from_file { : package perload; : local($file) = @_; # File to be loaded : local($body) = ' ' x 1024; # Pre-extent : local($load) = ' ' x 256; # Loading operations : # Avoid side effects by protecting special variables which will be : # changed by the autoloading operation. : local($., $_, $@); : $body = ''; : $load = ''; : &init_auto unless defined(@'AUTO); # Make sure we have a suitable @AUTO : &locate_file unless -f "$file"; # Locate file if relative path : open(FILE, $file) || : die "Can't load $'__rpackname__ from $file: $!\n"; : while () { : $load .= '*auto_' . $1 . '\'' . $2 . '= *' . $1 . '\'' . "load_$2;\n" : if (/^sub\s+(\w+)'load_(\w+)\s*\{/); : $body .= $_; : } : close FILE; EOC if ($opt_t) { print &q(<<'EOC'); : # Untaint body when running setuid : $body =~ /^([^\0]*)/; : # No need to untaint $load, as it was built using trusted variables : eval $1 . $load; EOC } else { print &q(<<'EOC'); : eval $body . $load; EOC } print &q(<<'EOC'); : chop($@) && die "$@, while parsing code of $file.\n"; :} : :# Initialize the @AUTO array. Attempt defining it by using the AUTOLIB :# environment variable if set, otherwise look in auto/ first, then in the :# current directory. :sub perload'init_auto { : if (defined $ENV{'AUTOLIB'} && $ENV{'AUTOLIB'}) { : @AUTO = split(':', $ENV{'AUTOLIB'}); : } else { : @AUTO = ('auto', '.'); : } :} : :# Locate to-be-loaded file held in $file by looking through the @AUTO array. :# This variable, defined in 'load_from_file', is modified as a side effect. :sub perload'locate_file { : package perload; : local($fullpath); : foreach $dir (@'AUTO) { : $fullpath = $dir . '/' . $file; : last if -f "$fullpath"; : $fullpath = ''; : } : $file = $fullpath if $fullpath; # Update var from 'load_from_file' :} : EOC } if (@Data > 0) { print &q(<<'EOC'); :# Load the calling function from DATA segment and call it. This function is :# called only once per routine to be loaded. :sub main'dataload { : local($__packname__) = (caller(1))[3]; : $__packname__ =~ s/::/'/; : local($__rpackname__) = $__packname__; : local($__at__) = $@; : $__rpackname__ =~ s/^auto_//; : &perload'load_from_data($__rpackname__); : local($__fun__) = "$__rpackname__"; : $__fun__ =~ s/'/'load_/; : eval "*$__packname__ = *$__fun__;"; # Change symbol table entry : die $@ if $@; # Should not happen : $@ = $__at__; # Restore value $@ had on entrance : &$__fun__; # Call newly loaded function :} : :# Load function name given as argument, fatal error if not existent :sub perload'load_from_data { : package perload; : local($pos) = $Datapos{$_[0]}; # Offset within DATA : # Avoid side effects by protecting special variables which will be changed : # by the dataloading operation. : local($., $_, $@); : $pos = &fetch_function_code unless $pos; : die "Function $_[0] not found in data section.\n" unless $pos; : die "Cannot seek to $pos into data section.\n" : unless seek(main'DATA, $pos, 0); : local($/) = "\n}"; : local($body) = scalar(); : die "End of file found while loading $_[0].\n" unless $body =~ /^\}$/m; EOC if ($opt_t) { print &q(<<'EOC'); : # Untaint body when running setuid : $body =~ /^([^\0]*)/; : # Now we may safely eval it without getting an insecure dependency : eval $1; # Load function into perl space EOC } else { print &q(<<'EOC'); : eval $body; # Load function into perl space EOC } print &q(<<'EOC'); : chop($@) && die "$@, while parsing code of $_[0].\n"; :} : EOC print &q(<<'EOC') unless $opt_o; :# Parse text after the END token and record defined loadable functions (i.e. :# those whose name starts with load_) into the %Datapos array. Such function :# definitions must be left adjusted. Stop as soon as the function we want :# has been found. :sub perload'fetch_function_code { : package perload; : local($pos) = tell main'DATA; : local($in_function) = 0; : local($func_name); : local($., $_); : while () { : if (/^sub\s+(\w+)'load_(\w+)\s*\{/) { : die "DATA line $.: function $1'$2 defined within $func_name.\n" : if $in_function; : $func_name = $1 . '\'' . $2; : $Datapos{$func_name} = $pos; : $in_function = 1; : next; : } : $in_function = 0 if /^\}/; : next if $in_function; : return $pos if $func_name eq $_[0]; : $pos = tell main'DATA; : } : 0; # Function not found :} : EOC print &q(<<'EOC') if $opt_o; :# This function is called only once, and fills in the %Datapos array with :# the offset of each of the dataloaded routines held in the data section. :sub perload'fetch_function_code { : package perload; : local($start) = 0; : local($., $_); : while () { # First move to start of offset table : next if /^#/; : last if /^$/ && ++$start > 2; # Skip two blank line after end token : } : $start = tell(main'DATA); # Offsets in table are relative to here : local($key, $value); : while () { # Load the offset table : last if /^$/; # Ends with a single blank line : ($key, $value) = split(' '); : $Datapos{$key} = $value + $start; : } : $Datapos{$_[0]}; # All that pain to get this offset... :} : EOC print &q(<<'EOC'); :# :# The perl compiler stops here. :# : :__END__ : :# :# Beyond this point lie functions we may never compile. :# : EOC # Option -o directs us to optimize the function location by emitting an # offset table, which lists all the position within DATA for each possible # dataloaded routine. if ($opt_o) { print &q(<<'EOC'); :# :# DO NOT CHANGE A IOTA BEYOND THIS COMMENT! :# The following table lists offsets of functions within the data section. :# Should modifications be needed, change original code and rerun perload :# with the -o option to regenerate a proper offset table. :# : EOC $trailing_message = &q(<<'EOC'); : :# :# End of offset table and beginning of dataloading section. :# : EOC $pos = 0; # Offset relative to this point (start of table) foreach (@Data) { $Datapos{"$1\'$2"} = $pos - $now if /^sub\s+(\w+)'load_(\w+)\s*\{/; # } for vi $pos += length; } @poskeys = keys %Datapos; # Array of routine names (fully qualified) # Write out a formatted table, each entry stored on $entry bytes and # formatted with the $format string. ($entry, $format) = &get_format(*poskeys); # The total size occupied by the table is the size of one item times # the number of items plus the final trailing message at the end of # the table. $table_size = $entry * @poskeys + length($trailing_message); # Output formatted table foreach (sort @poskeys) { printf($format, $_, $table_size + $Datapos{$_}); } print $trailing_message; } # Output code for each dataloaded function foreach (@Data) { print; } print &q(<<'EOC'); :# :# End of dataloading section. :# : EOC } if (@auto > 0) { mkdir('auto',0755) unless -d 'auto'; foreach $file (@auto) { unless (open(AUTO, ">auto/$file")) { warn "Can't create auto/$file: $!\n"; next; } print AUTO &q(<<'EOC'); :# This file was generated by perload : EOC print AUTO $Auto{$file}; close AUTO; } } # Compute optimum format for routine offset table, returning both the size of # each entry and the formating string for printf. sub get_format { local(*names) = @_; local($name_len) = 0; local($max_len) = 0; foreach (@names) { $name_len = length; $max_len = $name_len if $name_len > $max_len; } # The size of each entry (preceded by one tab, followed by 12 chars) $name_len = $max_len + 1 + 12; ($name_len, "\t%${max_len}s %10d\n"); } sub emit_init { print &q(<<'EOC'); :# :# This perl program uses dynamic loading [generated by perload] :# : :$ENV{LC_ALL} = 'C'; : EOC $init_emitted = 1; } sub flush_comment { print @Comment if @Comment > 0; @Comment = (); } sub q { local($_) = @_; s/^://gm; $_; } # # These next few lines are legal in both perl and nroff. # .00; # finish .ig 'di \" finish diversion--previous line must be blank .nr nl 0-1 \" fake up transition to first page again .nr % 0 \" start at page 1 '; __END__ \" the perl compiler stops here ''' ''' From here on it's a standard manual page. ''' .TH PERLOAD 1 "June 20, 1992" .AT 3 .SH NAME perload \- builds up autoloaded and dataloaded perl scripts .SH SYNOPSIS .B perload [ \fB\-ot\fR ] [ \fIfile\fR ] .SH DESCRIPTION .I Perload takes a perl script as argument (or from stdin if no argument is supplied) and prints out on stdout an equivalent script set-up to perform autoloading or dataloading. The translation is directed by special comments within the original script. Using dynamic loading can drastically improve start-up performances, both in time and in memory, as perl does not need to compile the whole script nor store its whole compiled form in memory. .PP .I Autoloading delays compilation of some functions until they are needed. The code for these functions is loaded dynamically at run-time. The atomicity of loading is a file, which means that putting more than one function into a file will cause all these functions to be loaded and compiled as soon as one among them is needed. .PP .I Dataloading is a form of autoloading where no extra file are needed. The script carries all the functions whose compilation is to be delayed in its data segment (in the \fIperl\fR sense, i.e. they are accessible via the DATA filehandle). The scripts parses the data segment and extracts only the code for the needed subroutine, which means granularity is better than with autloading. .PP It is possible for a single script to use both autoloading and dataloading at the same time. However, it should be noted that a script using only dataloading is self contained and can be moved or shared accross different platforms without fear. On the contrary, a script using only autoloading relies on some externally provided files. Sharing this script among different platforms requires sharing of these external files. The script itself cannot be redistributed without also giving the extra files holding the autoloaded functions. .PP The major drawback with dataloading is that the DATA filehandle cannot be used for anything else and may result in code duplication when two scripts could share the same pieces of code. Autoloading appears as the perfect solution in this case since two scripts may freely share the same functions without actually duplicating them on the disk (hence saving some precious disk blocks :-). .SH CRITERIA Functions to be dataloaded or autoloaded must meet the following layout criteria: .TP 5 \- They must not be one-line functions like \fIsub sorter { $a <=> $b }\fR. Those functions are simply output verbatim, as they are already so small that it would not be worth to dynamically load them, .TP \- The first line must be of the form \fIsub routine_name {\fR, with an optional comment allowed after the '{'. .TP \- The function definition must end with a single '}' character left aligned. .TP \- Package directives outside any function must be left aligned. .PP All the above restrictions should not be source of a problem if "standard" writing style is used. There are also some name restrictions: the package name \fIperload\fR is reserved, as is the \fI@AUTO\fR array when autoloading is used. Packages must not start with \fIauto_\fR, as this is prepended to user's package names when building the stubs. Furthermore, the subroutines names \fImain'autoload\fR and \fImain'dataload\fR must not be used by the original script. Again, these should not cause any grief. .SH DIRECTIVES The translation performed by .I Perload is driven by some special comment directives placed directly within the code. Ending those directives with a ':' character will actually prevent them from being output into the produced script. Case is irrelevant for all the directives and the comment need not be left-aligned, although it must be the first non-space item on the line. .PP The following directives are available: .TP 10 # Perload ON Turns on the \fIperload\fR processing. Any function definition which meets the criteria listed in the previous section will be replaced by two stubs and its actual definition will be rejected into the data segment (default) or a file when inside an autoloading section. .TP # Perload OFF Turns off any processing. The script is written as-is on the standard output. .TP # Autoload \fIpath\fR Requests autoloading from file \fIpath\fR, which may be an absolute path or a relative path. The file will be located at run-time using the @AUTO array if a non-absolute path is supplied or if the file does not exist as listed. Autoloading directives may be nested. .TP # Offload \fIpath\fR The argument is not required. The directive ends the previous autoloading directive (the inmost one). This does not turn off the \fIperload\fR processing though. The \fIpath\fR name is optional here (in fact, it has only a comment value). .SH OPTIONS Perload accepts only two options. Using \fB\-o\fR is meaningful only when dataloading is used. It outputs an offset table which lists the relative offset of the dataloaded functions within the data section. This will spare perl the run-time parsing needed to locate the function, and results in an good speed gain. However, it has one major drawback: it prevents people from actually modifying the source beyond the start of the table. But anything before can be freely edited, which is particulary useful when tailoring the script. .PP This option should not be used when editing of functions within the data section is necessary for whatever reason. When \fB\-o\fR is used, any change in the dataloaded function must be committed by re-running perload on the original script. .PP The other option \fB\-t\fR is to be used when producing a script which is going to run setuid. The body of the loaded function is untainted before being fed to eval, which slightly slows down loading (the first time the function is called), but avoids either an insecure dependency report or weird warnings from taintperl stating something is wrong (which is the behaviour with 4.0 PL35). .SH FILES .TP 10 auto the subdirectory where all produced autoloaded files are written. .SH ENVIRONMENT No environment variables are used by \fIperload\fR. However, the autoloaded version of the script pays attention to the \fIAUTOLIB\fR variable as a colon separated set of directories where the to-be-loaded files are to be found when a non-absolute path was specified. If the \fIAUTOLIB\fR variable is not set, the default value 'auto:.' is used (i.e. look first in the auto/ subdirectory, then in the current directory. .SH CAVEAT Special care is required when using an autoloading script, especially when executed by the super-user: it would be very easy for someone to leave a special version of a routine to be loaded, in the hope the super-user (or another suitable target) executes the autoloaded version of the script with some \fIad hoc\fR changes... .PP The directory holding the to-be-loaded files should therefore be protected against unauthorized access, and no file should have write permission on them. The directory itself should not be world-writable either, or someone might substitute his own version. It should also be considered wise to manually set the @AUTO variable to a suitable value within the script itself. .PP The \fB\-o\fR option uses \fIperl\fR's special variable \fI$/\fR with a multi-character value. I suspect this did not work with versions of \fIperl\fR prior to 4.0, so any script using this optimized form of dataloading will not be 100% backward compatible. .SH AUTHOR Raphael Manfredi .SH CREDITS Valuable input came from Wayne H. Scott . He is merely the author of the optimizing offset table (\fB\-o\fR option). .PP .I Perload is based on an article from Tom Christiansen , .I Autoloading in Perl, explaining the concept of dataloading and giving a basic implementation. .SH "SEE ALSO" perl(1).