home *** CD-ROM | disk | FTP | other *** search
/ ftp.cse.unsw.edu.au / 2014.06.ftp.cse.unsw.edu.au.tar / ftp.cse.unsw.edu.au / pub / doc / languages / perl / nutshell / ch6 / wrapman < prev    next >
Encoding:
Text File  |  1992-10-18  |  2.2 KB  |  108 lines
  1. #!/usr/bin/perl
  2.  
  3. # Usage: wrapman [files]
  4.  
  5. ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
  6.     = localtime(time);
  7. $month = (January,February,March,April,May,June,
  8.     July,August,September,October,November,December)[$mon];
  9.  
  10. $user = $ENV{'USER'} || $ENV{'LOGNAME'} || (getpwuid($<))[0];
  11. $fullname = (getpwnam($user))[6];
  12. $fullname =~ s/.*-\s*(.*)\(.*//;
  13. $fullname =~ s/,.*//;
  14.  
  15. substr($user,0,1) =~ tr/a-z/A-Z/;
  16. $fullname =~ s/&/$user/;        # Propagate the & abomination.
  17.  
  18. $log = '$' . 'Log' . '$';
  19. $header = '$' . 'Header' . '$';
  20.  
  21. foreach $file (@ARGV) {
  22.  
  23.     # Generate various strings for the manual page.
  24.  
  25.     ($prog = $file) =~ s/\.\w+$//;
  26.     ($PROG = $prog) =~ y/a-z/A-Z/;
  27.     $Prog = $prog; substr($Prog,0,1) =~ y/a-z/A-Z/;
  28.  
  29.     # See if we really want to wrap this file.
  30.  
  31.     open(IN,$file) || next;
  32.     $/ = "\n";
  33.     $line1 = <IN>;
  34.     next unless $line1 =~ /perl/;
  35.     $line1 .= <IN> if $line1 =~ /eval/;
  36.     $line1 .= <IN> if $line1 =~ /argv/;
  37.     $line2 = <IN>;
  38.     next if $line2 eq "'di';\n";
  39.  
  40.     # Pull the old switcheroo.
  41.  
  42.     ($dev,$ino,$mode) = stat IN;
  43.     print STDERR "Wrapping $file\n";
  44.     rename($file,"$file.bak");
  45.     open(OUT,">$file");
  46.     chmod $mode, $file;
  47.  
  48.     # Spit out the new script.
  49.  
  50.     print OUT $line1;
  51.     print OUT <<EOF;
  52. 'di';
  53. 'ig00';
  54. #
  55. # $header
  56. #
  57. # $log
  58. EOF
  59.  
  60.     # Copy entire script.
  61.  
  62.     undef $/;
  63.     $_ = <IN>;
  64.     print OUT $line2, $_;
  65.  
  66.     # Now put the transition from Perl to nroff.
  67.     #   (We prefix the .00 below with $null in case the wrapman
  68.     #   program is itself wrapped.)
  69.  
  70.     print OUT <<EOF;
  71. ###############################################################
  72.  
  73.     # These next few lines are legal in both Perl and nroff.
  74.  
  75. $null.00;                       # finish .ig
  76.  
  77. 'di           \\" finish diversion--previous line must be blank
  78. .nr nl 0-1    \\" fake up transition to first page again
  79. .nr % 0         \\" start at page 1
  80. '; __END__ ##### From here on it's a standard manual page #####
  81.  
  82. .TH $PROG 1 "$month $mday, 19$year"
  83. .AT 3
  84. .SH NAME
  85. $prog \\- whatever
  86. .SH SYNOPSIS
  87. .B $prog [options] [files]
  88. .SH DESCRIPTION
  89. .I $Prog
  90. does whatever.
  91. .SH ENVIRONMENT
  92. No environment variables are used.
  93. .SH FILES
  94. None.
  95. .SH AUTHOR
  96. $fullname
  97. .SH "SEE ALSO"
  98.  
  99. .SH DIAGNOSTICS
  100.  
  101. .SH BUGS
  102.  
  103. EOF
  104.  
  105.     close IN;
  106.     close OUT;
  107. }
  108.