v13i013: Forwarded posting of perl code

Rich Salz rsalz at bbn.com
Thu Feb 4 04:58:30 AEST 1988


Submitted-by: Larry Wall <lwall at jpl-devvax.jpl.nasa.gov>
Posting-number: Volume 13, Issue 13
Archive-name: perl/sample

MODERATOR's NOTES:
    This posting contains an article that originally appeared on
    comp.sources.d which and explains a bit more about perl, as well as
    giving pretty good piece of a sample perl program.

    Also included in this posting are patches 11 through 14, as I
    received them from Larry.

    I hope someone will translate Erik Fair's UUCP/Usenet scripts
    (uucp+nuz.tulz in Volume 7) into Perl, and send them along to be
    posted.
	/rich $alz

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  ARTICLE patch11 patch12 patch13 patch14
# Wrapped by rsalz at fig.bbn.com on Wed Feb  3 13:54:30 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'ARTICLE' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ARTICLE'\"
else
echo shar: Extracting \"'ARTICLE'\" \(9976 characters\)
sed "s/^X//" >'ARTICLE' <<'END_OF_FILE'
XAs to what it [perl] is, here's the hype paragraph from the manual page:
X
X     Perl is a interpreted language optimized for scanning arbi-
X     trary text files, extracting information from those text
X     files, and printing reports based on that information.  It's
X     also a good language for many system management tasks.  The
X     language is intended to be practical (easy to use, effi-
X     cient, complete) rather than beautiful (tiny, elegant,
X     minimal).	It combines (in the author's opinion, anyway)
X     some of the best features of C, sed, awk, and sh, so people
X     familiar with those languages should have little difficulty
X     with it.  (Language historians will also note some vestiges
X     of csh, Pascal, and even BASIC-PLUS.) Expression syntax
X     corresponds quite closely to C expression syntax.	If you
X     have a problem that would ordinarily use sed or awk or sh,
X     but it exceeds their capabilities or must run a little fas-
X     ter, and you don't want to write the silly thing in C, then
X     perl may be for you.  There are also translators to turn
X     your sed and awk scripts into perl scripts.
X
XThat's all I wanted to put in the manual page, but I could tell you a little
Xmore.  First of all, why I wrote it: I wanted to set up a distributed
Xconfiguration control system based on the news system, and I had to be
Xable to print reports based on scanning a bunch of articles.  Awk and sed
Xdidn't permit me to navigate around the news system like I wanted to do
X(following embedded references to other articles).  The shells can navigate,
Xbut you can't do anything efficiently when you have to start up a new
Xprocess every time you turn around.  I could have done it in C, of course,
Xbut text processing in C is an ungainly proposition at best.  On top of which,
XC didn't have the picture-style report formats I wanted.  And I didn't want
Xto do a make every time I tweaked the program.
X
XSomewhat later I realized that many systems programming problems deal with
Xtext--the situation arises frequently that you want to take the output of
Xvarious status programs (either directly via a pipe or indirectly from a log
Xfile) and massage the data to show you just what you want to know, or pick
Xout various bits of information to drive some other operation.  In the first
Xcategory is a set of LAN-wide status reporting scripts that deliver a report
Xto me each morning concerning anomalous conditions on any of the machines I'm
Xresponsible for.  In the second category are programs like gsh and gcp, which
Xare just like rsh and rcp except that they work globally on some set of machines
Xdefined in a system file.  In fact, I'll show you some of those programs to
Xgive you a taste of perl:
X
XHere's gsh:
X--------------------------------------------------------------------------------
X#!/bin/perl
X
X$SIG{'QUIT'} = 'quit';			# install signal handler for SIGQUIT
X
Xwhile ($ARGV[0] =~ /^-/) {		# parse switches
X    $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift,next);
X    $ARGV[0] =~ /^-s/ && ($silent++,shift,next);
X    $ARGV[0] =~ /^-d/ && ($dodist++,shift,next);
X    $ARGV[0] =~ /^-n/ && ($n=' -n',shift,next);
X    $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift,shift,next);
X    last;
X}
X
X$systype = shift;			# get name representing set of hosts
X
Xwhile ($ARGV[0] =~ /^-/) {		# we allow switches afterwards too
X    $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift,next);
X    $ARGV[0] =~ /^-s/ && ($silent++,shift,next);
X    $ARGV[0] =~ /^-d/ && ($dodist++,shift,next);
X    $ARGV[0] =~ /^-n/ && ($n=' -n',shift,next);
X    $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift,shift,next);
X    last;
X}
X
Xif ($dodist) {				# distribute input over all rshes?
X    `cat >/tmp/gsh$$`;			#  get input into a handy place
X    $dist = " </tmp/gsh$$";		#  each rsh takes input from there
X}
X
X$cmd = join(' ', at ARGV);			# remaining args constitute the command
X$cmd =~ s/'/'"'"'/g;			# quote any embedded single quotes
X
Xopen(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
X					# /etc/ghosts drives the rest
X
X$one_of_these = ":$systype:";		# prepare to expand "macros"
Xif ($systype =~ s/\+/[+]/g) {		# we hope to end up with list of
X    $one_of_these =~ s/\+/:/g;		#  colon separated attributes
X}
X
Xline: while (<ghosts>) {		# for each line of ghosts
X
X    s/[ \t]*\n//;			# trim leading whitespace
X    if (!$_ || /^#/) {			# skip blank line or comment
X	next line;
X    }
X
X    if (/^([a-zA-Z_0-9]+)=(.+)/) {	# a macro line?
X	$name = $1; $repl = $2;
X	$repl =~ s/\+/:/g;
X	$one_of_these =~ s/:$name:/:$repl:/;	# do expansion in "wanted" list
X	next line;
X    }
X
X    # we have a normal line
X
X    @attr = split;			# a list of attributes to match against
X					#   which we put into an array
X    $host = $attr[0];			# the first attribute is the host name
X    if ($showhost) {
X	$showhost = "$host:\t";
X    }
X
X    attr: while ($attr = pop(attr)) {			# iterate over gh array
X	if (index($one_of_these,":$attr:") >=0) {	# is host wanted?
X	    unless ($silent) { print "rsh $host$l$n '$cmd'\n"; }
X	    $SIG{'INT'} = 'DEFAULT';
X	    if (open(pipe,"rsh $host$l$n '$cmd'$dist |")) {	# start rsh
X		$SIG{'INT'} = 'cont';
X		while (<pipe>) { print $showhost,$_; }		# show results
X		close(pipe);
X	    } else {
X		$SIG{'INT'} = 'cont';
X		print "(Can't execute rsh.)\n";
X	    }
X	    last attr;				# don't select host twice
X	}
X    }
X}
X
Xunlink "/tmp/gsh$$" if $dodist;
X
X# here are a couple of subroutines that serve as signal handlers
X
Xsub cont {
X    print "\rContinuing...\n";
X}
X
Xsub quit {
X    $| = 1;
X    print "\r";
X    $SIG{'INT'} = '';
X    kill 2, $$;
X}
X--------------------------------------------------------------------------------
X
XGsh (and gcp) runs off the /etc/ghosts file, which looks like this:
X--------------------------------------------------------------------------------
X# This first section gives alternate sets defined in terms of the sets given
X# by the second section.
X
Xall=sun+mc+vax
Xbaseline=sun+mc
Xsun=sun2+sun3
Xvax=750+8600
Xpasswd=devvax+chief+mc
X
X# This second section defines the basic sets.  Each host should have a line
X# that specifies which sets it is a member of.  Extra sets should be separated
X# by white space.  (The first section isn't strictly necessary, since all sets
X# could be defined in the second section, but then it wouldn't be so readable.)
X
Xdevvax	8600	src
Xcdb0	sun3		sysdts
Xcdb1	sun3		sysdts
Xcdb2	sun3		sysdts
Xchief	sun3	src
Xtis0	sun3
Xmanny	sun3		sysdts
Xmoe	sun3		sysdts
Xjack	sun3		sysdts
Xdisney	sun3
Xhuey	sun3		nd
Xdewey	sun3		nd
Xlouie	sun3		nd
Xbizet	sun2	src	sysdts
Xgif0	mc	src
Xmc0	mc
Xdtv0	mc
X--------------------------------------------------------------------------------
X
XEnough of gsh.  How about you want to remove files with find, but don't want
Xto exec rm on every file?  I just did this today in some of my news directories.
X
X	find . -mtime +14 -print | perl -n -e 'chop;unlink;'
X
XI could have done the equivalent by running the find from within a perl script.
XNote that the open statement opens up a pipe.
X
X	#!/bin/perl
X	open(goners,"find . -mtime +14 -print|");
X	while (<goners>) {
X	    chop;
X	    unlink;
X	}
X
XHow about transforming that into a tool that will remove anything older than
Xa specified number of days in a specified directory?
X
X	#!/bin/perl
X
X	die "Usage: euthanasia directory days" unless $#ARGV == 1;
X
X	($dir, $days) = @ARGV;		# assign array to list of variables
X
X	die "Can't find directory $dir" unless chdir $dir;
X
X	open(goners,"find . -mtime +$days -print|") || die "Can't run find";
X	while (<goners>) {
X	    chop;
X	    unlink;
X	}
X
XI mentioned my anomaly reporting system earlier.  Here is the script that scans
Xa particular system for filesystems that are almost full.  Note the use of
Xthe C preprocessor to isolate Masscomp specific code.
X--------------------------------------------------------------------------------
X#!/bin/perl -P
X
X(chdir '/usr/adm/private/memories') || die "Can't cd.";
X`df >newdf`;
Xopen(Df, 'olddf');
X
Xwhile (<Df>) {
X    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
X    next if $fs =~ /:/;
X    $oldused{$fs} = $used;
X}
X
Xopen(Df, 'newdf') || die "scan_df: can't open newdf";
X
Xwhile (<Df>) {
X    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
X    next if $fs =~ /:/;
X    $oldused = $oldused{$fs};
X    next if ($oldused == $used && $capacity < 99);	# inactive filesystem
X    if ($capacity >= 90) {
X#if defined(mc300) || defined(mc500) || defined(mc700)
X	$_ = substr($_,0,13) . '        ' . substr($_,13,1000);
X	$kbytes /= 2;		# translate blocks to K
X	$used /= 2;
X	$oldused /= 2;
X	$avail /= 2;
X#endif
X	$diff = int($used - $oldused);
X	if ($avail < $diff * 2) {
X	    $mounted_on .= ' *';
X	}
X	next if $diff < 50 && $mounted_on eq '/';
X	$fs =~ s|/dev/||;
X	if ($diff >= 0) {
X	    $diff = '(+' . $diff . ')';
X	}
X	else {
X	    $diff = '(' . $diff . ')';
X	}
X	printf "%-8s%8d%8d %-8s%8d%7s    %s\n",
X	    $fs,$kbytes,$used,$diff,$avail,$capacity,$mounted_on;
X    }
X}
X
Xrename('newdf','olddf');
X-------------------------------------------------------------------------------
X
XWell, that's enough examples for now.  In terms of speed, perl almost always
Xbeats awk and usually beats sed.  It's a superset of both awk and sed in
Xterms of capabilities.  (That certainly makes the awk-to-perl and sed-to-perl
Xtranslators work more easily--in fact, some of the features of perl are there
Xsimply to ease the translation process.  I wasn't going to add a "goto" except
Xthat the sed-to-perl translator needed one.  There's a way to make arrays
Xhave either origin 0 like C, or origin 1 like awk.  Etc.)
X
XAs for reliability, perl has been in heavy use for over a year and a half.
XSome of the design of perl facilitates adding new keywords without blowing
Xexisting scripts out of the water.  Furthermore, perl has a regression test
Xsuite so that I know immediately if I've destroyed a previously available
Xcapability.  So you needn't worry too much about the next version of perl
Xblowing your old scripts out of the water.
X
XWell, enough for now.
X
XLarry Wall
Xlwall at jpl-devvax.jpl.nasa.gov
X
END_OF_FILE
if test 9976 -ne `wc -c <'ARTICLE'`; then
    echo shar: \"'ARTICLE'\" unpacked with wrong size!
fi
# end of 'ARTICLE'
fi
if test -f 'patch11' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'patch11'\"
else
echo shar: Extracting \"'patch11'\" \(14179 characters\)
sed "s/^X//" >'patch11' <<'END_OF_FILE'
X
XSystem: perl version 1.0
XPatch #: 11
XPriority: LOW
XSubject: documentation upgrade
XFrom: lwall at jpl-devvax.jpl.nasa.gov (Larry Wall)
XFrom: markb at rdcf.sm.unisys.com (Mark Biggar)
X
XDescription:
X	I documented the new eval operator for patch 8 but my automatic
X	patch generator overlooked it for some reason.
X
X	Here's the documentation for the eval operator, along with some
X	other documentation changes suggested by Mark.
X
XFix:	From rn, say "| patch -d DIR", where DIR is your perl source
X	directory.  Outside of rn, say "cd DIR; patch <thisarticle".
X	If you don't have the patch program, apply the following by hand,
X	or get patch.
X
X	If patch indicates that patchlevel is the wrong version, you may need
X	to apply one or more previous patches, or the patch may already
X	have been applied.  See the patchlevel.h file to find out what has or
X	has not been applied.  In any event, don't continue with the patch.
X
X	If you are missing previous patches they can be obtained from me:
X
X	Larry Wall
X	lwall at jpl-devvax.jpl.nasa.gov
X
X	If you send a mail message of the following form it will greatly speed
X	processing:
X
X	Subject: Command
X	@SH mailpatch PATH perl 1.0 LIST
X		   ^ note the c
X
X	where PATH is a return path FROM ME TO YOU in Internet notation, and
X	LIST is the number of one or more patches you need, separated by spaces,
X	commas, and/or hyphens.  Saying 35- says everything from 35 to the end.
X
X	You can also get the patches via anonymous FTP from
X	jpl-devvax.jpl.nasa.gov (128.149.8.43).
X
XIndex: patchlevel.h
XPrereq: 10
X1c1
X< #define PATCHLEVEL 10
X---
X> #define PATCHLEVEL 11
X 
XIndex: perl.man.1
XPrereq: 1.0
X*** perl.man.1.old	Sat Jan 30 17:05:13 1988
X--- perl.man.1	Sat Jan 30 17:05:15 1988
X***************
X*** 1,7 ****
X  .rn '' }`
X! ''' $Header: perl.man.1,v 1.0 87/12/18 16:18:16 root Exp $
X  ''' 
X  ''' $Log:	perl.man.1,v $
X  ''' Revision 1.0  87/12/18  16:18:16  root
X  ''' Initial revision
X  ''' 
X--- 1,13 ----
X  .rn '' }`
X! ''' $Header: perl.man.1,v 1.0.1.2 88/01/30 17:04:07 root Exp $
X  ''' 
X  ''' $Log:	perl.man.1,v $
X+ ''' Revision 1.0.1.2  88/01/30  17:04:07  root
X+ ''' patch 11: random cleanup
X+ ''' 
X+ ''' Revision 1.0.1.1  88/01/28  10:24:44  root
X+ ''' patch8: added eval operator.
X+ ''' 
X  ''' Revision 1.0  87/12/18  16:18:16  root
X  ''' Initial revision
X  ''' 
X***************
X*** 92,98 ****
X  compiles it to an internal form.
X  If the script is syntactically correct, it is executed.
X  .Sh "Options"
X! Note: on first reading this section won't make much sense to you.  It's here
X  at the front for easy reference.
X  .PP
X  A single-character option may be combined with the following option, if any.
X--- 98,104 ----
X  compiles it to an internal form.
X  If the script is syntactically correct, it is executed.
X  .Sh "Options"
X! Note: on first reading this section may not make much sense to you.  It's here
X  at the front for easy reference.
X  .PP
X  A single-character option may be combined with the following option, if any.
X***************
X*** 208,213 ****
X--- 214,224 ----
X  To suppress printing use the
X  .B \-n
X  switch.
X+ A
X+ .B \-p
X+ overrides a
X+ .B \-n
X+ switch.
X  .TP 5
X  .B \-P
X  causes your script to be run through the C preprocessor before
X***************
X*** 219,235 ****
X  .TP 5
X  .B \-s
X  enables some rudimentary switch parsing for switches on the command line
X! after the script name but before any filename arguments.
X! Any switch found there will set the corresponding variable in the
X  .I perl
X  script.
X  The following script prints \*(L"true\*(R" if and only if the script is
X! invoked with a -x switch.
X  .nf
X  
X  .ne 2
X  	#!/bin/perl -s
X! 	if ($x) { print "true\en"; }
X  
X  .fi
X  .Sh "Data Types and Objects"
X--- 230,246 ----
X  .TP 5
X  .B \-s
X  enables some rudimentary switch parsing for switches on the command line
X! after the script name but before any filename arguments (or before a --).
X! Any switch found there is removed from @ARGV and sets the corresponding variable in the
X  .I perl
X  script.
X  The following script prints \*(L"true\*(R" if and only if the script is
X! invoked with a -xyz switch.
X  .nf
X  
X  .ne 2
X  	#!/bin/perl -s
X! 	if ($xyz) { print "true\en"; }
X  
X  .fi
X  .Sh "Data Types and Objects"
X***************
X*** 307,312 ****
X--- 318,325 ----
X      print "The price is $Price.\e\|n";\h'|3.5i'# interpreted
X  
X  .fi
X+ Note that you can put curly brackets around the identifier to delimit it
X+ from following alphanumerics.
X  .PP
X  Array literals are denoted by separating individual values by commas, and
X  enclosing the list in parentheses.
X***************
X*** 315,320 ****
X--- 328,334 ----
X  For example,
X  .nf
X  
X+ .ne 4
X      @foo = ('cc', '\-E', $bar);
X  
X  assigns the entire array value to array foo, but
X***************
X*** 343,348 ****
X--- 357,363 ----
X  The command is executed each time the pseudo-literal is evaluated.
X  Unlike in \f2csh\f1, no interpretation is done on the
X  data\*(--newlines remain newlines.
X+ The status value of the command is returned in $?.
X  .PP
X  Evaluating a filehandle in angle brackets yields the next line
X  from that file (newline included, so it's never false until EOF).
X***************
X*** 409,415 ****
X--- 424,432 ----
X  It also uses filehandle ARGV internally.
X  You can modify @ARGV before the first <> as long as you leave the first
X  filename at the beginning of the array.
X+ Line numbers ($.) continue as if the input was one big happy file.
X  .PP
X+ .ne 5
X  If you want to set @ARGV to you own list of files, go right ahead.
X  If you want to pass switches into your script, you can
X  put a loop on the front like this:
X***************
X*** 486,492 ****
X  	LABEL BLOCK continue BLOCK
X  
X  .fi
X! (Note that, unlike C and Pascal, these are defined in terms of BLOCKs, not
X  statements.
X  This means that the curly brackets are \fIrequired\fR\*(--no dangling statements allowed.
X  If you want to write conditionals without curly brackets there are several
X--- 503,509 ----
X  	LABEL BLOCK continue BLOCK
X  
X  .fi
X! Note that, unlike C and Pascal, these are defined in terms of BLOCKs, not
X  statements.
X  This means that the curly brackets are \fIrequired\fR\*(--no dangling statements allowed.
X  If you want to write conditionals without curly brackets there are several
X***************
X*** 499,507 ****
X      die "Can't open $foo" unless open(foo);
X      open(foo) || die "Can't open $foo";	# foo or bust!
X      open(foo) ? die "Can't open $foo" : 'hi mom';
X  
X  .fi
X- though the last one is a bit exotic.)
X  .PP
X  The
X  .I if
X--- 516,524 ----
X      die "Can't open $foo" unless open(foo);
X      open(foo) || die "Can't open $foo";	# foo or bust!
X      open(foo) ? die "Can't open $foo" : 'hi mom';
X+ 			    # a bit exotic, that last one
X  
X  .fi
X  .PP
X  The
X  .I if
X***************
X*** 641,647 ****
X  (See the
X  .I do
X  operator below.  Note also that the loop control commands described later will
X! NOT work in this construct, since loop modifiers don't take loop labels.
X  Sorry.)
X  .Sh "Expressions"
X  Since
X--- 658,664 ----
X  (See the
X  .I do
X  operator below.  Note also that the loop control commands described later will
X! NOT work in this construct, since modifiers don't take loop labels.
X  Sorry.)
X  .Sh "Expressions"
X  Since
X***************
X*** 839,848 ****
X  	$cnt = (chown $uid,$gid,'foo');
X  
X  .fi
X  Here's an example of looking up non-numeric uids:
X  .nf
X  
X- .ne 16
X  	print "User: ";
X  	$user = <stdin>;
X  	open(pass,'/etc/passwd') || die "Can't open passwd";
X--- 856,865 ----
X  	$cnt = (chown $uid,$gid,'foo');
X  
X  .fi
X+ .ne 18
X  Here's an example of looking up non-numeric uids:
X  .nf
X  
X  	print "User: ";
X  	$user = <stdin>;
X  	open(pass,'/etc/passwd') || die "Can't open passwd";
X***************
X*** 922,927 ****
X--- 939,945 ----
X  assigned produces a FALSE (0) value).
X  The next call to each() after that will start iterating again.
X  The iterator can be reset only by reading all the elements from the array.
X+ You should not modify the array while iterating over it.
X  The following prints out your environment like the printenv program, only
X  in a different order:
X  .nf
X***************
X*** 954,959 ****
X--- 972,986 ----
X  	}
X  
X  .fi
X+ .Ip "eval EXPR" 8 6
X+ EXPR is parsed and executed as if it were a little perl program.
X+ It is executed in the context of the current perl program, so that
X+ any variable settings, subroutine or format definitions remain afterwards.
X+ The value returned is the value of the last expression evaluated, just
X+ as with subroutines.
X+ If there is a syntax error or runtime error, a null string is returned by
X+ eval, and $@ is set to the error message.
X+ If there was no error, $@ is null.
X  .Ip "exec LIST" 8 6
X  If there is more than one argument in LIST,
X  calls execvp() with the arguments in LIST.
X 
XIndex: perl.man.2
XPrereq: 1.0
X*** perl.man.2.old	Sat Jan 30 17:05:24 1988
X--- perl.man.2	Sat Jan 30 17:05:26 1988
X***************
X*** 1,7 ****
X  ''' Beginning of part 2
X! ''' $Header: perl.man.2,v 1.0 87/12/18 16:18:41 root Exp $
X  '''
X  ''' $Log:	perl.man.2,v $
X  ''' Revision 1.0  87/12/18  16:18:41  root
X  ''' Initial revision
X  ''' 
X--- 1,13 ----
X  ''' Beginning of part 2
X! ''' $Header: perl.man.2,v 1.0.1.2 88/01/30 17:04:28 root Exp $
X  '''
X  ''' $Log:	perl.man.2,v $
X+ ''' Revision 1.0.1.2  88/01/30  17:04:28  root
X+ ''' patch 11: random cleanup
X+ ''' 
X+ ''' Revision 1.0.1.1  88/01/28  10:25:11  root
X+ ''' patch8: added $@ variable.
X+ ''' 
X  ''' Revision 1.0  87/12/18  16:18:41  root
X  ''' Initial revision
X  ''' 
X***************
X*** 145,152 ****
X  with a \*(L"|\*(R", the filename is interpreted as command which pipes
X  input to us.
X  (You may not have a command that pipes both in and out.)
X! On non-pipe opens, the filename '\-' represents either stdin or stdout, as
X! appropriate.
X  Open returns 1 upon success, '' otherwise.
X  Examples:
X  .nf
X--- 151,157 ----
X  with a \*(L"|\*(R", the filename is interpreted as command which pipes
X  input to us.
X  (You may not have a command that pipes both in and out.)
X! Opening '\-' opens stdin and opening '>\-' opens stdout.
X  Open returns 1 upon success, '' otherwise.
X  Examples:
X  .nf
X***************
X*** 310,316 ****
X  Shifts the first value of the array off, shortening the array by 1 and
X  moving everything down.
X  If ARRAY is omitted, shifts the ARGV array.
X! See also unshift().
X  .Ip "sleep EXPR" 8 6
X  .Ip "sleep" 8
X  Causes the script to sleep for EXPR seconds, or forever if no EXPR.
X--- 315,323 ----
X  Shifts the first value of the array off, shortening the array by 1 and
X  moving everything down.
X  If ARRAY is omitted, shifts the ARGV array.
X! See also unshift(), push() and pop().
X! Shift() and unshift() do the same thing to the left end of an array that push()
X! and pop() do to the right end.
X  .Ip "sleep EXPR" 8 6
X  .Ip "sleep" 8
X  Causes the script to sleep for EXPR seconds, or forever if no EXPR.
X***************
X*** 326,332 ****
X  (Note that the delimiter may be longer than one character.)
X  Trailing null fields are stripped, which potential users of pop() would
X  do well to remember.
X! A pattern matching the null string will split into separate characters.
X  .sp
X  Example:
X  .nf
X--- 333,340 ----
X  (Note that the delimiter may be longer than one character.)
X  Trailing null fields are stripped, which potential users of pop() would
X  do well to remember.
X! A pattern matching the null string will split the value of EXPR into separate
X! characters.
X  .sp
X  Example:
X  .nf
X***************
X*** 373,378 ****
X--- 381,387 ----
X  Does exactly the same thing as \*(L"exec LIST\*(R" except that a fork
X  is done first, and the parent process waits for the child process to complete.
X  Note that argument processing varies depending on the number of arguments.
X+ The return value is the exit status of the program.
X  See exec.
X  .Ip "tell(FILEHANDLE)" 8 6
X  .Ip "tell" 8
X***************
X*** 422,427 ****
X--- 431,437 ----
X  	$cnt = (unlink 'a','b','c');
X  
X  .fi
X+ .ne 7
X  .Ip "unshift(ARRAY,LIST)" 8 4
X  Does the opposite of a shift.
X  Prepends list to the front of the array, and returns the number of elements
X***************
X*** 817,822 ****
X--- 827,837 ----
X  The value should be copied elsewhere before any pattern matching happens, which
X  clobbers $0.
X  (Mnemonic: same as sh and ksh.)
X+ .Ip $<digit> 8
X+ Contains the subpattern from the corresponding set of parentheses in the last
X+ pattern matched, not counting patterns matched in nested blocks that have
X+ been exited already.
X+ (Mnemonic: like \edigit.)
X  .Ip $[ 8 2
X  The index of the first element in an array, and of the first character in
X  a substring.
X***************
X*** 830,835 ****
X--- 845,854 ----
X  .Ip $! 8 2
X  The current value of errno, with all the usual caveats.
X  (Mnemonic: What just went bang?)
X+ .Ip $@ 8 2
X+ The error message from the last eval command.
X+ If null, the last eval parsed and executed correctly.
X+ (Mnemonic: Where was the syntax error "at"?)
X  .Ip @ARGV 8 3
X  The array ARGV contains the command line arguments intended for the script.
X  Note that $#ARGV is the generally number of arguments minus one, since
X***************
X*** 882,887 ****
X--- 901,908 ----
X  a2p	awk to perl translator
X  .br
X  s2p	sed to perl translator
X+ .br
X+ perldb	interactive perl debugger
X  .SH DIAGNOSTICS
X  Compilation errors will tell you the line number of the error, with an
X  indication of the next token or token type that was to be examined.
X
XIndex: perldb.man
XPrereq: 1.0.1.1
X*** perldb.man.old	Mon Feb  1 09:00:34 1988
X--- perldb.man	Sat Jan 30 17:05:04 1988
X***************
X*** 1,7 ****
X  .rn '' }`
X! ''' $Header: perldb.man,v 1.0.1.1 88/01/28 10:28:19 root Exp $
X  ''' 
X  ''' $Log:	perldb.man,v $
X  ''' Revision 1.0.1.1  88/01/28  10:28:19  root
X  ''' patch8: created this file.
X  ''' 
X--- 1,10 ----
X  .rn '' }`
X! ''' $Header: perldb.man,v 1.0.1.2 88/01/30 17:04:48 root Exp $
X  ''' 
X  ''' $Log:	perldb.man,v $
X+ ''' Revision 1.0.1.2  88/01/30  17:04:48  root
X+ ''' patch 11: random cleanup
X+ ''' 
X  ''' Revision 1.0.1.1  88/01/28  10:28:19  root
X  ''' patch8: created this file.
X  ''' 
X***************
X*** 91,96 ****
X--- 94,100 ----
X  List breakpoints.
X  .Ip t 8
X  Toggle trace mode.
X+ Trace mode causes lines to be printed out as they are executed.
X  .Ip "b line" 8
X  Set breakpoint at indicated line.
X  .Ip "d line" 8
X
END_OF_FILE
if test 14179 -ne `wc -c <'patch11'`; then
    echo shar: \"'patch11'\" unpacked with wrong size!
fi
# end of 'patch11'
fi
if test -f 'patch12' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'patch12'\"
else
echo shar: Extracting \"'patch12'\" \(8273 characters\)
sed "s/^X//" >'patch12' <<'END_OF_FILE'
X
XSystem: perl version 1.0
XPatch #: 12
XPriority: MEDIUM
XSubject: scripts made by a2p doen't handle leading white space right on input
XFrom: kyrimis at Princeton.EDU (Kriton Kyrimis)
X
XDescription:
X	Awk ignores leading whitespace on split.  Perl by default does not.
X	The a2p translator couldn't handle this.  The fix is partly to a2p
X	and partly to perl.  Perl now has a way to specify to split to
X	ignore leading white space as awk does.  A2p now takes advantage of
X	that.
X
X	I also threw in an optimization that let's runtime patterns
X	compile just once if they are known to be constant, so that
X	split(' ') doesn't compile the pattern every time.
X
XFix:	From rn, say "| patch -p0 -d DIR", where DIR is your perl source
X			      ^^^
X	directory.  Outside of rn, say "cd DIR; patch -p0 <thisarticle".
X	If you don't have the patch program, apply the following by hand,
X	or get patch.
X
X>>>	THE -p0 ABOVE IS REQUIRED     <<<
X
X	If patch indicates that patchlevel is the wrong version, you may need
X	to apply one or more previous patches, or the patch may already
X	have been applied.  See the patchlevel.h file to find out what has or
X	has not been applied.  In any event, don't continue with the patch.
X
X	If you are missing previous patches they can be obtained from me:
X
X	Larry Wall
X	lwall at jpl-devvax.jpl.nasa.gov
X
X	If you send a mail message of the following form it will greatly speed
X	processing:
X
X	Subject: Command
X	@SH mailpatch PATH perl 1.0 LIST
X		   ^ note the c
X
X	where PATH is a return path FROM ME TO YOU in Internet notation, and
X	LIST is the number of one or more patches you need, separated by spaces,
X	commas, and/or hyphens.  Saying 35- says everything from 35 to the end.
X
X	You can also get the patches via anonymous FTP from
X	jpl-devvax.jpl.nasa.gov (128.149.8.43).
X
XIndex: patchlevel.h
XPrereq: 11
X1c1
X< #define PATCHLEVEL 11
X---
X> #define PATCHLEVEL 12
X 
XIndex: x2p/a2p.h
XPrereq: 1.0.1.1
X*** x2p/a2p.h.old	Mon Feb  1 17:35:14 1988
X--- x2p/a2p.h	Mon Feb  1 17:35:15 1988
X***************
X*** 1,6 ****
X! /* $Header: a2p.h,v 1.0.1.1 88/01/26 09:52:30 root Exp $
X   *
X   * $Log:	a2p.h,v $
X   * Revision 1.0.1.1  88/01/26  09:52:30  root
X   * patch 5: a2p didn't use config.h.
X   * 
X--- 1,9 ----
X! /* $Header: a2p.h,v 1.0.1.2 88/02/01 17:33:40 root Exp $
X   *
X   * $Log:	a2p.h,v $
X+  * Revision 1.0.1.2  88/02/01  17:33:40  root
X+  * patch12: forgot to fix #define YYDEBUG; bug in a2p.
X+  * 
X   * Revision 1.0.1.1  88/01/26  09:52:30  root
X   * patch 5: a2p didn't use config.h.
X   * 
X***************
X*** 226,232 ****
X  #ifdef DEBUGGING
X  EXT int debug INIT(0);
X  EXT int dlevel INIT(0);
X! #define YYDEBUG;
X  extern int yydebug;
X  #endif
X  
X--- 229,235 ----
X  #ifdef DEBUGGING
X  EXT int debug INIT(0);
X  EXT int dlevel INIT(0);
X! #define YYDEBUG 1
X  extern int yydebug;
X  #endif
X  
X 
XIndex: arg.c
XPrereq: 1.0.1.5
X*** arg.c.old	Mon Feb  1 17:34:48 1988
X--- arg.c	Mon Feb  1 17:34:51 1988
X***************
X*** 1,6 ****
X! /* $Header: arg.c,v 1.0.1.5 88/01/30 08:53:16 root Exp $
X   *
X   * $Log:	arg.c,v $
X   * Revision 1.0.1.5  88/01/30  08:53:16  root
X   * patch9: fixed some missing right parens introduced (?) by patch 2
X   * 
X--- 1,9 ----
X! /* $Header: arg.c,v 1.0.1.6 88/02/01 17:32:26 root Exp $
X   *
X   * $Log:	arg.c,v $
X+  * Revision 1.0.1.6  88/02/01  17:32:26  root
X+  * patch12: made split(' ') behave like awk in ignoring leading white space.
X+  * 
X   * Revision 1.0.1.5  88/01/30  08:53:16  root
X   * patch9: fixed some missing right parens introduced (?) by patch 2
X   * 
X***************
X*** 220,225 ****
X--- 223,237 ----
X  	char *d;
X  
X  	m = str_get(eval(spat->spat_runtime,Null(STR***)));
X+ 	if (!*m || (*m == ' ' && !m[1])) {
X+ 	    m = "[ \\t\\n]+";
X+ 	    while (isspace(*s)) s++;
X+ 	}
X+ 	if (spat->spat_runtime->arg_type == O_ITEM &&
X+ 	  spat->spat_runtime[1].arg_type == A_SINGLE) {
X+ 	    arg_free(spat->spat_runtime);	/* it won't change, so */
X+ 	    spat->spat_runtime = Nullarg;	/* no point compiling again */
X+ 	}
X  	if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
X  #ifdef DEBUGGING
X  	    deb("/%s/: %s\n", m, d);
X 
XIndex: perl.man.2
XPrereq: 1.0.1.2
X*** perl.man.2.old	Mon Feb  1 17:35:03 1988
X--- perl.man.2	Mon Feb  1 17:35:06 1988
X***************
X*** 1,7 ****
X  ''' Beginning of part 2
X! ''' $Header: perl.man.2,v 1.0.1.2 88/01/30 17:04:28 root Exp $
X  '''
X  ''' $Log:	perl.man.2,v $
X  ''' Revision 1.0.1.2  88/01/30  17:04:28  root
X  ''' patch 11: random cleanup
X  ''' 
X--- 1,10 ----
X  ''' Beginning of part 2
X! ''' $Header: perl.man.2,v 1.0.1.3 88/02/01 17:33:03 root Exp $
X  '''
X  ''' $Log:	perl.man.2,v $
X+ ''' Revision 1.0.1.3  88/02/01  17:33:03  root
X+ ''' patch12: documented split more adequately.
X+ ''' 
X  ''' Revision 1.0.1.2  88/01/30  17:04:28  root
X  ''' patch 11: random cleanup
X  ''' 
X***************
X*** 333,340 ****
X  (Note that the delimiter may be longer than one character.)
X  Trailing null fields are stripped, which potential users of pop() would
X  do well to remember.
X! A pattern matching the null string will split the value of EXPR into separate
X! characters.
X  .sp
X  Example:
X  .nf
X--- 336,360 ----
X  (Note that the delimiter may be longer than one character.)
X  Trailing null fields are stripped, which potential users of pop() would
X  do well to remember.
X! A pattern matching the null string (not to be confused with a null pattern)
X! will split the value of EXPR into separate characters at each point it
X! matches that way.
X! For example:
X! .nf
X! 
X! 	print join(':',split(/ */,'hi there'));
X! 
X! .fi
X! produces the output 'h:i:t:h:e:r:e'.
X! 
X! The pattern /PATTERN/ may be replaced with an expression to specify patterns
X! that vary at runtime.
X! As a special case, specifying a space ('\ ') will split on white space
X! just as split with no arguments does, but leading white space does NOT
X! produce a null first field.
X! Thus, split('\ ') can be used to emulate awk's default behavior, whereas
X! split(/\ /) will give you as many null initial fields as there are
X! leading spaces.
X  .sp
X  Example:
X  .nf
X 
XIndex: x2p/walk.c
XPrereq: 1.0.1.1
X*** x2p/walk.c.old	Mon Feb  1 17:35:21 1988
X--- x2p/walk.c	Mon Feb  1 17:35:23 1988
X***************
X*** 1,6 ****
X! /* $Header: walk.c,v 1.0.1.1 88/01/28 11:07:56 root Exp $
X   *
X   * $Log:	walk.c,v $
X   * Revision 1.0.1.1  88/01/28  11:07:56  root
X   * patch8: changed some misleading comments.
X   * 
X--- 1,9 ----
X! /* $Header: walk.c,v 1.0.1.2 88/02/01 17:34:05 root Exp $
X   *
X   * $Log:	walk.c,v $
X+  * Revision 1.0.1.2  88/02/01  17:34:05  root
X+  * patch12: made a2p take advantage of new awk-compatible split in perl.
X+  * 
X   * Revision 1.0.1.1  88/01/28  11:07:56  root
X   * patch8: changed some misleading comments.
X   * 
X***************
X*** 71,77 ****
X  	    str_cat(str,"';\t\t# field separator from -F switch\n");
X  	}
X  	else if (saw_FS && !const_FS) {
X! 	    str_cat(str,"$FS = '[ \\t\\n]+';\t\t# set field separator\n");
X  	}
X  	if (saw_OFS) {
X  	    str_cat(str,"$, = ' ';\t\t# set output field separator\n");
X--- 74,80 ----
X  	    str_cat(str,"';\t\t# field separator from -F switch\n");
X  	}
X  	else if (saw_FS && !const_FS) {
X! 	    str_cat(str,"$FS = ' ';\t\t# set field separator\n");
X  	}
X  	if (saw_OFS) {
X  	    str_cat(str,"$, = ' ';\t\t# set output field separator\n");
X***************
X*** 361,368 ****
X  	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
X  	str_free(fstr);
X  	numeric |= numarg;
X- 	if (strEQ(str->str_ptr,"$FS = '\240'"))
X- 	    str_set(str,"$FS = '[\240\\n\\t]+'");
X  	break;
X      case OADD:
X  	str = walk(1,level,ops[node+1].ival,&numarg);
X--- 364,369 ----
X***************
X*** 511,517 ****
X  	else if (saw_FS)
X  	    str_cat(str,"$FS");
X  	else
X! 	    str_cat(str,"/[ \\t\\n]+/");
X  	str_cat(str,", ");
X  	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X  	str_free(fstr);
X--- 512,518 ----
X  	else if (saw_FS)
X  	    str_cat(str,"$FS");
X  	else
X! 	    str_cat(str,"' '");
X  	str_cat(str,", ");
X  	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X  	str_free(fstr);
X***************
X*** 1095,1101 ****
X      else if (saw_FS)
X  	str_cat(str," = split($FS);\n");
X      else
X! 	str_cat(str," = split;\n");
X      tab(str,level);
X  }
X  
X--- 1096,1102 ----
X      else if (saw_FS)
X  	str_cat(str," = split($FS);\n");
X      else
X! 	str_cat(str," = split(' ');\n");
X      tab(str,level);
X  }
X  
X
END_OF_FILE
if test 8273 -ne `wc -c <'patch12'`; then
    echo shar: \"'patch12'\" unpacked with wrong size!
fi
# end of 'patch12'
fi
if test -f 'patch13' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'patch13'\"
else
echo shar: Extracting \"'patch13'\" \(12527 characters\)
sed "s/^X//" >'patch13' <<'END_OF_FILE'
X
XSystem: perl version 1.0
XPatch #: 13
XPriority: MEDIUM-HIGH for 20 minutes, then simmer 3 hours
XSubject: fix for faulty patch 12, plus random portability glitches
XFrom: pwcmrd!skipnyc!skip (Skip Gilbrech)
XFrom: kyrimis at Princeton.EDU (Kriton Kyrimis)
X
XDescription:
X	I botched patch #12, so that split(' ') only works on the first
X	line of input due to unintended interference by the optimization
X	that was added at the same time.  Yes, I tested it, but only on
X	one line of input.  *Sigh*
X
X	Some glitches have turned up on some of the rusty pig iron out there,
X	so here are some unglitchifications.
X
XFix:	From rn, say "| patch -p0 -d DIR", where DIR is your perl source
X			      ^^^
X	directory.  Outside of rn, say "cd DIR; patch -p0 <thisarticle".
X	If you don't have the patch program, apply the following by hand,
X	or get patch.
X
X	If patch indicates that patchlevel is the wrong version, you may need
X	to apply one or more previous patches, or the patch may already
X	have been applied.  See the patchlevel.h file to find out what has or
X	has not been applied.  In any event, don't continue with the patch.
X
X	If you are missing previous patches they can be obtained from me:
X
X	Larry Wall
X	lwall at jpl-devvax.jpl.nasa.gov
X
X	If you send a mail message of the following form it will greatly speed
X	processing:
X
X	Subject: Command
X	@SH mailpatch PATH perl 1.0 LIST
X		   ^ note the c
X
X	where PATH is a return path FROM ME TO YOU in Internet notation, and
X	LIST is the number of one or more patches you need, separated by spaces,
X	commas, and/or hyphens.  Saying 35- says everything from 35 to the end.
X
X	You can also get the patches via anonymous FTP from
X	jpl-devvax.jpl.nasa.gov (128.149.8.43).
X
XIndex: patchlevel.h
XPrereq: 12
X1c1
X< #define PATCHLEVEL 12
X---
X> #define PATCHLEVEL 13
X 
XIndex: Configure
XPrereq: 1.0.1.5
X*** Configure.old	Tue Feb  2 11:27:30 1988
X--- Configure	Tue Feb  2 11:27:33 1988
X***************
X*** 8,14 ****
X  # and edit it to reflect your system.  Some packages may include samples
X  # of config.h for certain machines, so you might look for one of those.)
X  #
X! # $Header: Configure,v 1.0.1.5 88/01/30 09:21:20 root Exp $
X  #
X  # Yes, you may rip this off to use in other distribution packages.
X  # (Note: this Configure script was generated automatically.  Rather than
X--- 8,14 ----
X  # and edit it to reflect your system.  Some packages may include samples
X  # of config.h for certain machines, so you might look for one of those.)
X  #
X! # $Header: Configure,v 1.0.1.6 88/02/02 11:20:07 root Exp $
X  #
X  # Yes, you may rip this off to use in other distribution packages.
X  # (Note: this Configure script was generated automatically.  Rather than
X***************
X*** 70,79 ****
X--- 70,81 ----
X  cppminus=''
X  d_bcopy=''
X  d_charsprf=''
X+ d_crypt=''
X  d_index=''
X  d_statblks=''
X  d_stdstdio=''
X  d_strctcpy=''
X+ d_symlink=''
X  d_tminsys=''
X  d_vfork=''
X  d_voidsig=''
X***************
X*** 664,669 ****
X--- 666,681 ----
X      d_charsprf="$undef"
X  fi
X  
X+ : see if crypt exists
X+ echo " "
X+ if $contains crypt libc.list >/dev/null 2>&1; then
X+     echo 'crypt() found.'
X+     d_crypt="$define"
X+ else
X+     echo 'crypt() not found.'
X+     d_crypt="$undef"
X+ fi
X+ 
X  : index or strcpy
X  echo " "
X  dflt=y
X***************
X*** 1233,1238 ****
X--- 1245,1260 ----
X      cc=cc
X  fi
X  
X+ : see if symlink exists
X+ echo " "
X+ if $contains symlink libc.list >/dev/null 2>&1; then
X+     echo 'symlink() found.'
X+     d_symlink="$define"
X+ else
X+     echo 'symlink() not found.'
X+     d_symlink="$undef"
X+ fi
X+ 
X  : see if we should include -lnm
X  echo " "
X  if $test -r /usr/lib/libnm.a || $test -r /usr/local/lib/libnm.a ; then
X***************
X*** 1328,1337 ****
X--- 1350,1361 ----
X  cppminus='$cppminus'
X  d_bcopy='$d_bcopy'
X  d_charsprf='$d_charsprf'
X+ d_crypt='$d_crypt'
X  d_index='$d_index'
X  d_statblks='$d_statblks'
X  d_stdstdio='$d_stdstdio'
X  d_strctcpy='$d_strctcpy'
X+ d_symlink='$d_symlink'
X  d_tminsys='$d_tminsys'
X  d_vfork='$d_vfork'
X  d_voidsig='$d_voidsig'
X 
XIndex: Makefile.SH
XPrereq: 1.0.1.4
X*** Makefile.SH.old	Tue Feb  2 11:27:47 1988
X--- Makefile.SH	Tue Feb  2 11:27:48 1988
X***************
X*** 12,22 ****
X  case "$0" in
X  */*) cd `expr X$0 : 'X\(.*\)/'` ;;
X  esac
X  echo "Extracting Makefile (with variable substitutions)"
X  cat >Makefile <<!GROK!THIS!
X! # $Header: Makefile.SH,v 1.0.1.4 88/01/28 10:17:59 root Exp $
X  #
X  # $Log:	Makefile.SH,v $
X  # Revision 1.0.1.4  88/01/28  10:17:59  root
X  # patch8: added perldb.man
X  # 
X--- 12,31 ----
X  case "$0" in
X  */*) cd `expr X$0 : 'X\(.*\)/'` ;;
X  esac
X+ 
X+ case "$d_symlink" in
X+ *define*) sln='ln -s' ;;
X+ *) sln='ln';;
X+ esac
X+ 
X  echo "Extracting Makefile (with variable substitutions)"
X  cat >Makefile <<!GROK!THIS!
X! # $Header: Makefile.SH,v 1.0.1.5 88/02/02 11:20:49 root Exp $
X  #
X  # $Log:	Makefile.SH,v $
X+ # Revision 1.0.1.5  88/02/02  11:20:49  root
X+ # patch13: added d_symlink dependency, changed TEST to ./perl TEST.
X+ # 
X  # Revision 1.0.1.4  88/01/28  10:17:59  root
X  # patch8: added perldb.man
X  # 
X***************
X*** 44,49 ****
X--- 53,59 ----
X  LARGE = $large $split
X  mallocsrc = $mallocsrc
X  mallocobj = $mallocobj
X+ SLN = $sln
X  
X  libs = $libnm -lm
X  !GROK!THIS!
X***************
X*** 152,158 ****
X  
X  test: perl
X  	chmod 755 t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.*
X! 	cd t && (rm -f perl; ln -s ../perl . || ln ../perl .) && TEST
X  
X  clist:
X  	echo $(c) | tr ' ' '\012' >.clist
X--- 162,168 ----
X  
X  test: perl
X  	chmod 755 t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.*
X! 	cd t && (rm -f perl; $(SLN) ../perl .) && ./perl TEST
X  
X  clist:
X  	echo $(c) | tr ' ' '\012' >.clist
X 
XIndex: arg.c
XPrereq: 1.0.1.6
X*** arg.c.old	Tue Feb  2 11:28:00 1988
X--- arg.c	Tue Feb  2 11:28:04 1988
X***************
X*** 1,6 ****
X! /* $Header: arg.c,v 1.0.1.6 88/02/01 17:32:26 root Exp $
X   *
X   * $Log:	arg.c,v $
X   * Revision 1.0.1.6  88/02/01  17:32:26  root
X   * patch12: made split(' ') behave like awk in ignoring leading white space.
X   * 
X--- 1,9 ----
X! /* $Header: arg.c,v 1.0.1.7 88/02/02 11:22:19 root Exp $
X   *
X   * $Log:	arg.c,v $
X+  * Revision 1.0.1.7  88/02/02  11:22:19  root
X+  * patch13: fixed split(' ') to work right second time.  Added CRYPT dependency.
X+  * 
X   * Revision 1.0.1.6  88/02/01  17:32:26  root
X   * patch12: made split(' ') behave like awk in ignoring leading white space.
X   * 
X***************
X*** 225,231 ****
X  	m = str_get(eval(spat->spat_runtime,Null(STR***)));
X  	if (!*m || (*m == ' ' && !m[1])) {
X  	    m = "[ \\t\\n]+";
X! 	    while (isspace(*s)) s++;
X  	}
X  	if (spat->spat_runtime->arg_type == O_ITEM &&
X  	  spat->spat_runtime[1].arg_type == A_SINGLE) {
X--- 228,234 ----
X  	m = str_get(eval(spat->spat_runtime,Null(STR***)));
X  	if (!*m || (*m == ' ' && !m[1])) {
X  	    m = "[ \\t\\n]+";
X! 	    spat->spat_flags |= SPAT_SKIPWHITE;
X  	}
X  	if (spat->spat_runtime->arg_type == O_ITEM &&
X  	  spat->spat_runtime[1].arg_type == A_SINGLE) {
X***************
X*** 251,256 ****
X--- 254,263 ----
X      if (!ary)
X  	myarray = ary = anew();
X      ary->ary_fill = -1;
X+     if (spat->spat_flags & SPAT_SKIPWHITE) {
X+ 	while (isspace(*s))
X+ 	    s++;
X+     }
X      while (*s && (m = execute(&spat->spat_compex, s, (iters == 0), 1))) {
X  	if (spat->spat_compex.numsubs)
X  	    s = spat->spat_compex.subbase;
X***************
X*** 1952,1959 ****
X--- 1959,1971 ----
X  	retary = Null(STR***);		/* do_stat already did retary */
X  	goto donumset;
X      case O_CRYPT:
X+ #ifdef CRYPT
X  	tmps = str_get(sarg[1]);
X  	str_set(str,crypt(tmps,str_get(sarg[2])));
X+ #else
X+ 	fatal(
X+ 	  "The crypt() function is unimplemented due to excessive paranoia.");
X+ #endif
X  	break;
X      case O_EXP:
X  	value = exp(str_gnum(sarg[1]));
X 
XIndex: config.h.SH
X*** config.h.SH.old	Tue Feb  2 11:28:14 1988
X--- config.h.SH	Tue Feb  2 11:28:16 1988
X***************
X*** 65,70 ****
X--- 65,76 ----
X   */
X  #$d_charsprf	CHARSPRINTF 	/**/
X  
X+ /* CRYPT:
X+  *	This symbol, if defined, indicates that the crypt routine is available
X+  *	to encrypt passwords and the like.
X+  */
X+ #$d_crypt	CRYPT		/**/
X+ 
X  /* index:
X   *	This preprocessor symbol is defined, along with rindex, if the system
X   *	uses the strchr and strrchr routines instead.
X***************
X*** 94,99 ****
X--- 100,111 ----
X   *	routine of some sort instead.
X   */
X  #$d_strctcpy	STRUCTCOPY	/**/
X+ 
X+ /* SYMLINK:
X+  *	This symbol, if defined, indicates that the symlink routine is available
X+  *	to create symbolic links.
X+  */
X+ #$d_symlink	SYMLINK		/**/
X  
X  /* TMINSYS:
X   *	This symbol is defined if this system declares "struct tm" in
X 
XIndex: makedepend.SH
XPrereq: 1.0
X*** makedepend.SH.old	Tue Feb  2 11:28:23 1988
X--- makedepend.SH	Tue Feb  2 11:28:24 1988
X***************
X*** 15,23 ****
X  echo "Extracting makedepend (with variable substitutions)"
X  $spitshell >makedepend <<!GROK!THIS!
X  $startsh
X! # $Header: makedepend.SH,v 1.0 87/12/18 17:54:32 root Exp $
X  #
X  # $Log:	makedepend.SH,v $
X  # Revision 1.0  87/12/18  17:54:32  root
X  # Initial revision
X  # 
X--- 15,26 ----
X  echo "Extracting makedepend (with variable substitutions)"
X  $spitshell >makedepend <<!GROK!THIS!
X  $startsh
X! # $Header: makedepend.SH,v 1.0.1.1 88/02/02 11:24:05 root Exp $
X  #
X  # $Log:	makedepend.SH,v $
X+ # Revision 1.0.1.1  88/02/02  11:24:05  root
X+ # patch13: removed spurious -I./h.
X+ # 
X  # Revision 1.0  87/12/18  17:54:32  root
X  # Initial revision
X  # 
X***************
X*** 83,89 ****
X  	-e 's|\\$||' \
X  	-e p \
X  	-e '}'
X!     $cpp -I/usr/local/include -I. -I./h $file.c | \
X      $sed \
X  	-e '/^# *[0-9]/!d' \
X  	-e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
X--- 86,92 ----
X  	-e 's|\\$||' \
X  	-e p \
X  	-e '}'
X!     $cpp -I/usr/local/include -I. $file.c | \
X      $sed \
X  	-e '/^# *[0-9]/!d' \
X  	-e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
X 
XIndex: t/op.split
XPrereq: 1.0
X*** t/op.split.old	Tue Feb  2 11:28:40 1988
X--- t/op.split	Tue Feb  2 11:28:40 1988
X***************
X*** 1,8 ****
X  #!./perl
X  
X! # $Header: op.split,v 1.0 87/12/18 13:14:20 root Exp $
X  
X! print "1..4\n";
X  
X  $FS = ':';
X  
X--- 1,8 ----
X  #!./perl
X  
X! # $Header: op.split,v 1.0.1.1 88/02/02 11:26:37 root Exp $
X  
X! print "1..6\n";
X  
X  $FS = ':';
X  
X***************
X*** 22,24 ****
X--- 22,31 ----
X  $_ = "a:b:c::::";
X  @ary = split(/:/);
X  if (join(".", at ary) eq "a.b.c") {print "ok 4\n";} else {print "not ok 4\n";}
X+ 
X+ $_ = join(':',split(' ','    a b	c '));
X+ if ($_ eq 'a:b:c') {print "ok 5\n";} else {print "not ok 5\n";}
X+ 
X+ $_ = join(':',split(/ */,"foo  bar bie\tdoll"));
X+ if ($_ eq "f:o:o:b:a:r:b:i:e:\t:d:o:l:l")
X+ 	{print "ok 6\n";} else {print "not ok 6\n";}
X 
XIndex: spat.h
XPrereq: 1.0
X*** spat.h.old	Tue Feb  2 11:28:29 1988
X--- spat.h	Tue Feb  2 11:28:29 1988
X***************
X*** 1,6 ****
X! /* $Header: spat.h,v 1.0 87/12/18 13:06:10 root Exp $
X   *
X   * $Log:	spat.h,v $
X   * Revision 1.0  87/12/18  13:06:10  root
X   * Initial revision
X   * 
X--- 1,9 ----
X! /* $Header: spat.h,v 1.0.1.1 88/02/02 11:24:37 root Exp $
X   *
X   * $Log:	spat.h,v $
X+  * Revision 1.0.1.1  88/02/02  11:24:37  root
X+  * patch13: added flag for stripping leading spaces on split.
X+  * 
X   * Revision 1.0  87/12/18  13:06:10  root
X   * Initial revision
X   * 
X***************
X*** 20,25 ****
X--- 23,29 ----
X  #define SPAT_USE_ONCE 2			/* use pattern only once per article */
X  #define SPAT_SCANFIRST 4		/* initial constant not anchored */
X  #define SPAT_SCANALL 8			/* initial constant is whole pat */
X+ #define SPAT_SKIPWHITE 16		/* skip leading whitespace for split */
X  
X  EXT SPAT *spat_root;		/* list of all spats */
X  EXT SPAT *curspat;		/* what to do \ interps from */
X 
XIndex: stab.c
XPrereq: 1.0.1.1
X*** stab.c.old	Tue Feb  2 11:28:33 1988
X--- stab.c	Tue Feb  2 11:28:34 1988
X***************
X*** 1,6 ****
X! /* $Header: stab.c,v 1.0.1.1 88/01/28 10:35:17 root Exp $
X   *
X   * $Log:	stab.c,v $
X   * Revision 1.0.1.1  88/01/28  10:35:17  root
X   * patch8: changed some stabents to support eval operator.
X   * 
X--- 1,9 ----
X! /* $Header: stab.c,v 1.0.1.2 88/02/02 11:25:53 root Exp $
X   *
X   * $Log:	stab.c,v $
X+  * Revision 1.0.1.2  88/02/02  11:25:53  root
X+  * patch13: moved extern int out of function for a poor Xenix machine.
X+  * 
X   * Revision 1.0.1.1  88/01/28  10:35:17  root
X   * patch8: changed some stabents to support eval operator.
X   * 
X***************
X*** 64,69 ****
X--- 67,74 ----
X      ,0
X      };
X  
X+ extern int errno;
X+ 
X  STR *
X  stab_str(stab)
X  STAB *stab;
X***************
X*** 70,76 ****
X  {
X      register int paren;
X      register char *s;
X-     extern int errno;
X  
X      switch (*stab->stab_name) {
X      case '0': case '1': case '2': case '3': case '4':
X--- 75,80 ----
X
END_OF_FILE
if test 12527 -ne `wc -c <'patch13'`; then
    echo shar: \"'patch13'\" unpacked with wrong size!
fi
# end of 'patch13'
fi
if test -f 'patch14' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'patch14'\"
else
echo shar: Extracting \"'patch14'\" \(2886 characters\)
sed "s/^X//" >'patch14' <<'END_OF_FILE'
X
XSystem: perl version 1.0
XPatch #: 14
XPriority: HIGH
XSubject: a2p incorrectly translates 'for (a in b)' construct.
XFrom: jbs at EDDIE.MIT.EDU (Jeff Siegal)
X
XDescription:
X	The code a2p creates for the 'for (a in b)' construct ends
X	up assigning the wrong value to the key variable.
X
XFix:	From rn, say "| patch -p0 -d DIR", where DIR is your perl source
X			      ^^^
X	directory.  Outside of rn, say "cd DIR; patch -p0 <thisarticle".
X	If you don't have the patch program, apply the following by hand,
X	or get patch.
X
X	If patch indicates that patchlevel is the wrong version, you may need
X	to apply one or more previous patches, or the patch may already
X	have been applied.  See the patchlevel.h file to find out what has or
X	has not been applied.  In any event, don't continue with the patch.
X
X	If you are missing previous patches they can be obtained from me:
X
X	Larry Wall
X	lwall at jpl-devvax.jpl.nasa.gov
X
X	If you send a mail message of the following form it will greatly speed
X	processing:
X
X	Subject: Command
X	@SH mailpatch PATH perl 1.0 LIST
X		   ^ note the c
X
X	where PATH is a return path FROM ME TO YOU in Internet notation, and
X	LIST is the number of one or more patches you need, separated by spaces,
X	commas, and/or hyphens.  Saying 35- says everything from 35 to the end.
X
X	You can also get the patches via anonymous FTP from
X	jpl-devvax.jpl.nasa.gov (128.149.8.43).
X
XIndex: patchlevel.h
XPrereq: 13
X1c1
X< #define PATCHLEVEL 13
X---
X> #define PATCHLEVEL 14
X 
XIndex: x2p/walk.c
XPrereq: 1.0.1.2
X*** x2p/walk.c.old	Tue Feb  2 11:56:10 1988
X--- x2p/walk.c	Tue Feb  2 11:56:13 1988
X***************
X*** 1,6 ****
X! /* $Header: walk.c,v 1.0.1.2 88/02/01 17:34:05 root Exp $
X   *
X   * $Log:	walk.c,v $
X   * Revision 1.0.1.2  88/02/01  17:34:05  root
X   * patch12: made a2p take advantage of new awk-compatible split in perl.
X   * 
X--- 1,9 ----
X! /* $Header: walk.c,v 1.0.1.3 88/02/02 11:54:58 root Exp $
X   *
X   * $Log:	walk.c,v $
X+  * Revision 1.0.1.3  88/02/02  11:54:58  root
X+  * patch14: got return value of each() backwards in translating 'for (a in b)'.
X+  * 
X   * Revision 1.0.1.2  88/02/01  17:34:05  root
X   * patch12: made a2p take advantage of new awk-compatible split in perl.
X   * 
X***************
X*** 962,971 ****
X  	    str_free(fstr);
X  	}
X  	else {
X! 	    str_set(str,"while (($junkkey,$");
X  	    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X  	    str_free(fstr);
X! 	    str_cat(str,") = each(");
X  	    str_scat(str,tmpstr);
X  	    str_cat(str,")) ");
X  	    str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X--- 965,974 ----
X  	    str_free(fstr);
X  	}
X  	else {
X! 	    str_set(str,"while (($");
X  	    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X  	    str_free(fstr);
X! 	    str_cat(str,",$junkval) = each(");
X  	    str_scat(str,tmpstr);
X  	    str_cat(str,")) ");
X  	    str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X
END_OF_FILE
if test 2886 -ne `wc -c <'patch14'`; then
    echo shar: \"'patch14'\" unpacked with wrong size!
fi
# end of 'patch14'
fi
echo shar: End of shell archive.
exit 0
-- 
For comp.sources.unix stuff, mail to sources at uunet.uu.net.



More information about the Comp.sources.unix mailing list