home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3619 < prev    next >
Encoding:
Internet Message Format  |  1991-07-11  |  4.0 KB
  1. From: tchrist@convex.com (Tom Christiansen)
  2. Newsgroups: comp.lang.perl,alt.sources
  3. Subject: preambulate: stick NIH header on perl programs
  4. Message-ID: <1991Jul11.010856.12783@convex.com>
  5. Date: 11 Jul 91 01:08:56 GMT
  6.  
  7. The following script can be used to help a perl program execute even if
  8. the path and version of the perl executable are unknown by sticking a
  9. system-independent preamble in front of your script.  
  10.  
  11. A nice thing about this is that it tries to find a good patchlevel of
  12. perl.  Failing that, even if you've used something that's syntactically
  13. too advanced for the current version (such as 'require' at 3.018), you
  14. will get a semi-decent error message instead of a syntax error.
  15.  
  16. The way it works is to first put a header that it still tries very hard to
  17. to call the first perl in your path.  This should work even if #! doesn't
  18. work on your system or the program is called by any Bourne- or csh-compatible 
  19. shell (or of course perl).  Once it's done this, it makes sure that the
  20. version of perl it's running under is at least as high as the one it was
  21. wrapped with.  If not, it looks around to try to find a perl with a high
  22. enough version number and execs one if it can find it.  Finally, it evals
  23. the real script, which allows it to catch any version-dependent syntax errors.
  24.  
  25. Usage:
  26.     
  27.     preambulate < old-script > new-script
  28. or
  29.     preambulate script1 script2 script3 ...
  30.  
  31.  
  32. The second form puts the old scripts in script1.bak etc, and the wrapped
  33. version back into script1.  Make sure you preambulate with a version of 
  34. perl that works on your script, like
  35.  
  36.     perl4.003 script && perl4.003 preambulate script && script
  37.  
  38. --tom
  39.  
  40. #!/usr/local/bin/perl
  41. #
  42. # preambulate -- wrap a perl program with a system-independent preamble.  
  43. #
  44. # Tom Christiansen tchrist@convex.com
  45.  
  46. $mypath = '/usr/local/bin/perl';
  47. ($myversion, $mypatchlevel) = $] =~ /(\d+\.\d+).*\nPatch level: (\d+)/;
  48.  
  49.  
  50. unless (@ARGV) {
  51.     unshift(@ARGV, '-');
  52.     $was_stdin++;
  53. }
  54.  
  55. while ($file = shift) {
  56.     open file || die "can't open $file: $!";
  57.     $mode = (stat(file))[2] & 0777;
  58.     if ($file ne '-') {
  59.     $TMP = "$file.tmp";
  60.     open (TMP, ">$TMP") || die "can't create $TMP: $!"; 
  61.      } else {
  62.     open (TMP, ">&STDOUT");
  63.      } 
  64.      print TMP <<'EOF';
  65. #!/bin/sh -- need to mention perl here to avoid recursion
  66.  
  67. 'true' || eval 'exec perl -S $0 $argv:q';
  68. eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  69. & eval 'exec perl -S $0 $argv:q'
  70.         if 0;
  71.  
  72. VERSION_SANITY: {
  73.     package VERSION_SANITY;
  74.     local($_);
  75. EOF
  76.     print TMP <<"EOF";
  77.     \$PERL_PATH = '$mypath';
  78.     local(\$version, \$patchlevel) = ($myversion, $mypatchlevel);
  79. EOF
  80.  
  81.     print TMP <<'EOF';
  82.  
  83.     local($want_vp) = sprintf("%d.%03d", $version, $patchlevel);
  84.     local($need_perl) = $PERL_PATH . $want_vp;
  85.  
  86.     die "can't get version" 
  87.     unless $] =~ /(\d+\.\d+).*\nPatch level: (\d+)/;
  88.  
  89.     sub try_version {
  90.         warn "current perl version ($got_vp) too low, execing $need_perl\n";
  91.         exec $need_perl, $0, @ARGV;
  92.         warn "exec of $need_perl failed: $!";
  93.     }
  94.  
  95.     if ($1 < $version || $2 < $patchlevel) { 
  96.     local($got_vp) =  sprintf("%d.%03d", $1, $2);
  97.         &try_version if -x $need_perl;
  98.         for $need_perl (reverse sort </usr/local/bin/perl* /usr/bin/perl*>) {
  99.             next unless $need_perl =~ /perl(\d+)\.(\d+)$/;
  100.             &try_version if $1 >= $version && $2 >= $patchlevel;
  101.         }
  102.         warn "WARNING: perl version too low: $got_vp < $want_vp; good luck...\n";
  103.     } 
  104. } 
  105.  
  106. eval <<'___VERSION_SANITY___';
  107.  
  108. # BEGIN REAL PROGRAM
  109.  
  110. EOF
  111.  
  112.     while (<file>) {
  113.     print TMP;
  114.     } 
  115.  
  116.     print TMP <<'EOF';
  117.  
  118.  
  119. # END REAL PROGRAM
  120.  
  121. ___VERSION_SANITY___
  122.  
  123. die "$0: OOPS, YOU LOSE: $@" if $@;
  124.  
  125. exit 0;
  126.  
  127. EOF
  128.  
  129.     unless ($file eq '-') {
  130.     close TMP;
  131.     chmod $mode, $TMP;
  132.     rename ($file, "$file.bak") || die "can't rename $file to $file.bak: $!";
  133.     rename ($TMP, $file) || die "can't rename $TMP to $file: $!";
  134.     }
  135. }
  136.  
  137. --
  138. "GUIs normally make it simple to accomplish simple actions and impossible
  139. to accomplish complex actions."   --Doug Gwyn  (22/Jun/91 in comp.unix.wizards)
  140.  
  141.      Tom Christiansen           tchrist@convex.com      convex!tchrist
  142.