psutils/maketext

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2    & eval 'exec perl -S $0 $argv:q'
   3    if 0;
   4
   5 # maketext: perl filter to substitute names in scripts and man pages.
   6
   7 %change = ();                   # names -> substitutions
   8
   9 # get release and patchlevel for all scripts
  10 open(H, "patchlev.h") || die "can't open patchlev.h";
  11 while(<H>) {
  12    $change{$1} = $2 if /^\#define\s*(\S*)\s*(\S*)/;
  13 }
  14 close(H);
  15
  16 $os = "" ;
  17
  18 %perlstart = ("UNIX", "\#!PERL\neval 'exec perl -S \$0 \"\$\@\"'\n\tif \$running_under_some_shell;\n",
  19               "DOS", "\@rem = '-*- Perl -*-\n\@echo off\nPERL -S %0.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9\ngoto endofperl\n';\n",
  20               "WINNT", "\@rem = '-*- Perl -*-\n\@echo off\nPERL -S %0.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9\ngoto endofperl\n';\n",
  21               "OS2", "extproc PERL -x\n\#! PERL\n",
  22               "", "PSUTILS MAKEFILE CONFIGURATION ERROR") ;
  23 %perlend = ("UNIX", "",
  24             "DOS", "__END__\n:endofperl\n",
  25             "WINNT", "__END__\n:endofperl\n",
  26             "OS2", "\# End of Script",
  27             "", "PSUTILS MAKEFILE CONFIGURATION ERROR");
  28
  29 foreach (@ARGV) {
  30    if (/MAN=(.*)/) {            # name.ext name.ext -> name(ext), name(ext)
  31       local(@man) = split(' ', $1);
  32       $change{"MAN"} = join(", ", grep(s/\.(.)/($1)/, @man));
  33    } elsif (/OS=(.*)/) {        # set operating system name
  34       $os = $1 ;
  35    } elsif (/PERL=(.*)/) {      # substitute name for value
  36       local($perl) = $1 ;
  37       $change{"PERL"} = $perlstart{$os} ;
  38       $change{"END"} = $perlend{$os} ;
  39       $change{"PERL"} =~ s/PERL/$perl/g ;
  40       $change{"END"} =~ s/PERL/$perl/g ;
  41    } elsif (/(.*)=(.*)/) {      # substitute name for value
  42       $change{$1} = $2;
  43    } else {                     # open file and substitute
  44       local(@change) = keys %change;
  45       open(FILE, $_) || die "can't open $_";
  46       while ($line = <FILE>) {
  47          grep($line =~ s/\@$_\@/$change{$_}/g, @change);
  48          print $line;
  49       }
  50       close(FILE);
  51    }
  52 }