-#define PATCHLEVEL 3
+#define PATCHLEVEL 4
-/* $Header: perl.h,v 3.0.1.1 89/10/26 23:17:08 lwall Locked $
+/* $Header: perl.h,v 3.0.1.2 89/11/11 04:39:38 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
+ * Revision 3.0.1.2 89/11/11 04:39:38 lwall
+ * patch2: Configure may now set -DDEBUGGING
+ * patch2: netinet/in.h needed sys/types.h some places
+ * patch2: more <sys/time.h> and <time.h> wrangling
+ * patch2: yydebug moved to where type doesn't matter
+ *
* Revision 3.0.1.1 89/10/26 23:17:08 lwall
* patch1: vfork now conditionally defined based on VFORK
* patch1: DEC risc machines have a buggy memcmp
*
*/
-#ifndef lint
-#define DEBUGGING
-#endif
-
#define VOIDUSED 1
#include "config.h"
#include <setjmp.h>
#include <sys/param.h> /* if this needs types.h we're still wrong */
-#ifdef I_NETINET_IN
-#include <netinet/in.h>
-#endif
-
#ifndef _TYPES_ /* If types.h defines this it's easy. */
#ifndef major /* Does everyone's types.h define this? */
#include <sys/types.h>
#endif
#endif
+#ifdef I_NETINET_IN
+#include <netinet/in.h>
+#endif
+
#include <sys/stat.h>
-#ifdef TMINSYS
+#if defined(TMINSYS) || defined(I_SYSTIME)
#include <sys/time.h>
-#else
-#ifdef I_SYSTIME
-#include <sys/time.h>
-#else
+#ifdef TIMETOO
#include <time.h>
#endif
+#else
+#include <time.h>
#endif
#include <sys/times.h>
#ifdef NDBM
#include <ndbm.h>
#define SOME_DBM
+#ifdef ODBM
+#undef ODBM
+#endif
#else
#ifdef ODBM
#ifdef NULL
#define DIRENT dirent
#else
#ifdef I_SYSDIR
+#ifdef hp9000s500
+#include <ndir.h> /* may be wrong in the future */
+#else
#include <sys/dir.h>
+#endif
#define DIRENT direct
#endif
#endif
#define BYTEORDER 01234
#endif
+#if defined(htonl) && !defined(HTONL)
+#define HTONL
+#endif
+#if defined(htons) && !defined(HTONS)
+#define HTONS
+#endif
+#if defined(ntohl) && !defined(NTOHL)
+#define NTOHL
+#endif
+#if defined(ntohs) && !defined(NTOHS)
+#define NTOHS
+#endif
#ifndef HTONL
-#if BYTEORDER != 04321
+#if (BYTEORDER != 04321) && (BYTEORDER != 087654321)
#define HTONS
#define HTONL
#define NTOHS
#define ntohl my_ntohl
#endif
#else
-#if BYTEORDER == 04321
+#if (BYTEORDER == 04321) || (BYTEORDER == 087654321)
#undef HTONS
#undef HTONL
#undef NTOHS
EXT bool sawi INIT(FALSE); /* study must assume case insensitive */
EXT bool sawvec INIT(FALSE);
-EXT int csh INIT(0); /* 1 if /bin/csh is there, -1 if not */
+#ifdef CSH
+char *cshname INIT(CSH);
+int cshlen INIT(0);
+#endif /* CSH */
#ifdef TAINT
EXT bool tainted INIT(FALSE); /* using variables controlled by $< */
EXT char *debname;
EXT char *debdelim;
#define YYDEBUG 1
-extern int yydebug;
#endif
EXT int perldb INIT(0);
.rn '' }`
-''' $Header: perl.man.1,v 3.0 89/10/18 15:21:29 lwall Locked $
+''' $Header: perl.man.1,v 3.0.1.1 89/11/11 04:41:22 lwall Locked $
'''
''' $Log: perl.man.1,v $
+''' Revision 3.0.1.1 89/11/11 04:41:22 lwall
+''' patch2: explained about sh and ${1+"$@"}
+''' patch2: documented that space must separate word and '' string
+'''
''' Revision 3.0 89/10/18 15:21:29 lwall
''' 3.0 baseline
'''
.I perl
locates the script, it parses the lines and ignores them because
the variable $running_under_some_shell is never true.
+A better construct than $* would be ${1+"$@"}, which handles embedded spaces
+and such in the filenames, but doesn't work if the script is being interpreted
+by csh.
+In order to start up sh rather than csh, some systems may have to replace the
+#! line with a line containing just
+a colon, which will be politely ignored by perl.
.TP 5
.B \-u
causes
.fi
Note that you can put curly brackets around the identifier to delimit it
from following alphanumerics.
+Also note that a single quoted string must be separated from a preceding
+word by a space, since single quote is a valid character in an identifier
+(see Packages).
.PP
Array values are interpolated into double-quoted strings by joining all the
elements of the array with the delimiter specified in the $" variable,
system "echo @ARGV";
.fi
-Within search patterns (which also undergo double-quoteish substitution)
+Within search patterns (which also undergo double-quotish substitution)
there is a bad ambiguity: Is /$foo[bar]/ to be
interpreted as /${foo}[bar]/ (where [bar] is a character class for the
regular expression) or as /${foo[bar]}/ (where [bar] is the subscript to
''' Beginning of part 2
-''' $Header: perl.man.2,v 3.0 89/10/18 15:21:37 lwall Locked $
+''' $Header: perl.man.2,v 3.0.1.1 89/11/11 04:43:10 lwall Locked $
'''
''' $Log: perl.man.2,v $
+''' Revision 3.0.1.1 89/11/11 04:43:10 lwall
+''' patch2: made some line breaks depend on troff vs. nroff
+''' patch2: example of unshift had args backwards
+'''
''' Revision 3.0 89/10/18 15:21:37 lwall
''' 3.0 baseline
'''
print "Files: "
$pattern = <STDIN>;
chop($pattern);
+.ie t \{\
open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\en";
+'br\}
+.el \{\
+ open(pass, \'/etc/passwd\')
+ || die "Can't open passwd: $!\en";
+'br\}
while (<pass>) {
($login,$pass,$uid,$gid) = split(/:/);
$uid{$login} = $uid;
.nf
.ne 3
+.ie t \{\
die "Can't cd to spool: $!\en" unless chdir \'/usr/spool/news\';
+'br\}
+.el \{\
+ die "Can't cd to spool: $!\en"
+ unless chdir \'/usr/spool/news\';
+'br\}
chdir \'/usr/spool/news\' || die "Can't cd to spool: $!\en"
Note that fcntl will produce a fatal error if used on a machine that doesn't implement
fcntl(2).
.Ip "fileno(FILEHANDLE)" 8 4
+.Ip "fileno FILEHANDLE" 8 4
Returns the file descriptor for a filehandle.
Useful for constructing bitmaps for select().
If FILEHANDLE is an expression, the value is taken as the name of
# An internet sockaddr
$sockaddr = 'S n a4 x8';
$hersockaddr = getpeername(S);
+.ie t \{\
($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
+'br\}
+.el \{\
+ ($family, $port, $heraddr) =
+ unpack($sockaddr,$hersockaddr);
+'br\}
.fi
.Ip "getpgrp(PID)" 8 4
.Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8
.Ip "getprotobynumber(NUMBER)" 8
.Ip "getservbyport(PORT,PROTO)" 8
-.Ip "getpwent()" 8
-.Ip "getgrent()" 8
-.Ip "gethostent()" 8
-.Ip "getnetent()" 8
-.Ip "getprotoent()" 8
-.Ip "getservent()" 8
-.Ip "setpwent()" 8
-.Ip "setgrent()" 8
+.Ip "getpwent" 8
+.Ip "getgrent" 8
+.Ip "gethostent" 8
+.Ip "getnetent" 8
+.Ip "getprotoent" 8
+.Ip "getservent" 8
+.Ip "setpwent" 8
+.Ip "setgrent" 8
.Ip "sethostent(STAYOPEN)" 8
.Ip "setnetent(STAYOPEN)" 8
.Ip "setprotoent(STAYOPEN)" 8
.Ip "setservent(STAYOPEN)" 8
-.Ip "endpwent()" 8
-.Ip "endgrent()" 8
-.Ip "endhostent()" 8
-.Ip "endnetent()" 8
-.Ip "endprotoent()" 8
-.Ip "endservent()" 8
+.Ip "endpwent" 8
+.Ip "endgrent" 8
+.Ip "endhostent" 8
+.Ip "endnetent" 8
+.Ip "endprotoent" 8
+.Ip "endservent" 8
These routines perform the same functions as their counterparts in the
system library.
The return values from the various get routines are as follows:
# An internet sockaddr
$sockaddr = 'S n a4 x8';
$mysockaddr = getsockname(S);
+.ie t \{\
($family, $port, $myaddr) = unpack($sockaddr,$mysockaddr);
+'br\}
+.el \{\
+ ($family, $port, $myaddr) =
+ unpack($sockaddr,$mysockaddr);
+'br\}
.fi
.Ip "getsockopt(SOCKET,LEVEL,OPTNAME)" 8 3
.nf
.ne 3
+.ie t \{\
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
+'br\}
+.el \{\
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ gmtime(time);
+'br\}
.fi
All array elements are numeric, and come straight out of a struct tm.
Example:
.nf
+.ie t \{\
$_ = join(\|\':\', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+'br\}
+.el \{\
+ $_ = join(\|\':\',
+ $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+'br\}
.fi
See
if ($sw eq \'-v\') {
# init local array with global array
local(@ARGV) = @ARGV;
- unshift(\'echo\',@ARGV);
+ unshift(@ARGV,\'echo\');
system @ARGV;
}
# @ARGV restored
.nf
.ne 3
+.ie t \{\
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+'br\}
+.el \{\
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ localtime(time);
+'br\}
.fi
All array elements are numeric, and come straight out of a struct tm.
.Ip "lstat(FILEHANDLE)" 8 6
.Ip "lstat FILEHANDLE" 8
.Ip "lstat(EXPR)" 8
+.Ip "lstat SCALARVARIABLE" 8
Does the same thing as the stat() function, but stats a symbolic link
instead of the file the symbolic link points to.
If symbolic links are unimplemented on your system, a normal stat is done.
''' Beginning of part 3
-''' $Header: perl.man.3,v 3.0 89/10/18 15:21:46 lwall Locked $
+''' $Header: perl.man.3,v 3.0.1.1 89/11/11 04:45:06 lwall Locked $
'''
''' $Log: perl.man.3,v $
+''' Revision 3.0.1.1 89/11/11 04:45:06 lwall
+''' patch2: made some line breaks depend on troff vs. nroff
+'''
''' Revision 3.0 89/10/18 15:21:46 lwall
''' 3.0 baseline
'''
open article || die "Can't find article $article: $!\en";
while (<article>) {\|.\|.\|.
+.ie t \{\
open(LOG, \'>>/usr/spool/news/twitlog\'\|); # (log is reserved)
+'br\}
+.el \{\
+ open(LOG, \'>>/usr/spool/news/twitlog\'\|);
+ # (log is reserved)
+'br\}
+.ie t \{\
open(article, "caesar <$article |"\|); # decrypt article
+'br\}
+.el \{\
+ open(article, "caesar <$article |"\|);
+ # decrypt article
+'br\}
+.ie t \{\
open(extract, "|sort >/tmp/Tmp$$"\|); # $$ is our process#
+'br\}
+.el \{\
+ open(extract, "|sort >/tmp/Tmp$$"\|);
+ # $$ is our process#
+'br\}
.ne 7
# process argument list of files along with any includes
print STDERR "Can't open $filename: $!\en";
return;
}
+.ie t \{\
while (<$input>) { # note the use of indirection
+'br\}
+.el \{\
+ while (<$input>) { # note use of indirection
+'br\}
if (/^#include "(.*)"/) {
do process($1, $input);
next;
with \*(L">&\*(R", in which case the rest of the string
is interpreted as the name of a filehandle
(or file descriptor, if numeric) which is to be duped and opened.
+You may use & after >, >>, <, +>, +>> and +<.
+The mode you specify should match the mode of the original filehandle.
Here is a script that saves, redirects, and restores
.I STDOUT
and
-.IR STDIN :
+.IR STDERR :
.nf
.ne 21
$foo = pack("a14","abcdefg");
# "abcdefg\e0\e0\e0\e0\e0\e0\e0"
- $foo = pack("i9pl", gmtime());
+ $foo = pack("i9pl", gmtime);
# a real struct tm (on my system anyway)
.fi
Returns the number of bytes actually read.
SCALAR will be grown or shrunk to the length actually read.
.Ip "readdir(DIRHANDLE)" 8 3
+.Ip "readdir DIRHANDLE" 8
Returns the next directory entry for a directory opened by opendir().
If used in an array context, returns all the rest of the entries in the
directory.
or to block until something becomes ready:
+.ie t \{\
$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
+'br\}
+.el \{\
+ $nfound = select($rout=$rin, $wout=$win,
+ $eout=$ein, undef);
+'br\}
.fi
Any of the bitmasks can also be undef.
.I rand
operator.
If EXPR is omitted, does srand(time).
-.Ip "stat(FILEHANDLE)" 8 6
+.Ip "stat(FILEHANDLE)" 8 8
.Ip "stat FILEHANDLE" 8
.Ip "stat(EXPR)" 8
+.Ip "stat SCALARVARIABLE" 8
Returns a 13-element array giving the statistics for a file, either the file
opened via FILEHANDLE, or named by EXPR.
Typically used as follows:
You can use the substr() function as an lvalue, in which case EXPR must
be an lvalue.
If you assign something shorter than LEN, the string will shrink, and
-if you assign something longer than LEN, the string will grow to accomodate it.
+if you assign something longer than LEN, the string will grow to accommodate it.
To keep the string the same length you may need to pad or chop your value using
sprintf().
.Ip "syscall(LIST)" 8 6
.fi
.Ip "umask(EXPR)" 8 4
.Ip "umask EXPR" 8
+.Ip "umask" 8
Sets the umask for the process and returns the old one.
If EXPR is omitted, merely returns current umask.
.Ip "undef(EXPR)" 8 6
your program, to protect older programs.
.Ip "wait" 8 6
Waits for a child process to terminate and returns the pid of the deceased
-process.
+process, or -1 if there are no child processes.
The status is returned in $?.
+If you expected a child and didn't find it, you probably had a call to
+system, a close on a pipe, or backticks between the fork and the wait.
+These constructs also do a wait and may have harvested your child process.
.Ip "wantarray" 8 4
Returns true if the context of the currently executing subroutine
is looking for an array value.
Produces a message on STDERR just like \*(L"die\*(R", but doesn't exit.
.Ip "write(FILEHANDLE)" 8 6
.Ip "write(EXPR)" 8
-.Ip "write(\|)" 8
+.Ip "write" 8
Writes a formatted record (possibly multi-line) to the specified file,
using the format associated with that file.
By default the format for a file is the one having the same name is the
''' Beginning of part 4
-''' $Header: perl.man.4,v 3.0.1.1 89/10/26 23:18:43 lwall Locked $
+''' $Header: perl.man.4,v 3.0.1.2 89/11/11 04:46:40 lwall Locked $
'''
''' $Log: perl.man.4,v $
+''' Revision 3.0.1.2 89/11/11 04:46:40 lwall
+''' patch2: made some line breaks depend on troff vs. nroff
+''' patch2: clarified operation of ^ and $ when $* is false
+'''
''' Revision 3.0.1.1 89/10/26 23:18:43 lwall
''' patch1: documented the desirability of unnecessary parentheses
'''
This may or may not bother you.
.Sp
Note that scalars are already passed by reference, so you can modify scalar
-arguments without using this mechanism by refering explicitly to the $_[nnn]
+arguments without using this mechanism by referring explicitly to the $_[nnn]
in question.
You can modify all the elements of an array by passing all the elements
as scalars, but you have to use the * mechanism to push, pop or change the
}
.fi
-By default, the ^ character matches only the beginning of the string,
-the $ character matches only at the end (or before the newline at the end)
+By default, the ^ character is only guaranteed to match at the beginning
+of the string,
+the $ character only at the end (or before the newline at the end)
and
.I perl
does certain optimizations with the assumption that the string contains
only one line.
+The behavior of ^ and $ on embedded newlines will be inconsistent.
You may, however, wish to treat a string as a multi-line buffer, such that
the ^ will match after any newline within the string, and $ will match
before any newline.
($name, $aliases, $proto) = getprotobyname('tcp');
($name, $aliases, $port) = getservbyname($port, 'tcp')
unless $port =~ /^\ed+$/;;
+.ie t \{\
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
+'br\}
+.el \{\
+ ($name, $aliases, $type, $len, $thisaddr) =
+ gethostbyname($hostname);
+'br\}
($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
$this = pack($sockaddr, &AF_INET, 0, $thisaddr);
($addr = accept(NS,S)) || die $!;
print "accept ok\en";
- ($af,$port,$inetaddr) = unpack($pat,$addr);
+ ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
@inetaddr = unpack('C4',$inetaddr);
print "$af $port @inetaddr\en";
If you know what version or patchlevel a particular feature was implemented,
you can test $] to see if it will be there.
.Ip 4. 4 4
-Choose mnemonic indentifiers.
+Choose mnemonic identifiers.
.Ip 5. 4 4
Be consistent.
.Sh "Debugging"
If you try to do something insecure, you will get a fatal error saying
something like \*(L"Insecure dependency\*(R" or \*(L"Insecure PATH\*(R".
Note that you can still write an insecure system call or exec,
-but only by explicity doing something like the last example above.
+but only by explicitly doing something like the last example above.
You can also bypass the tainting mechanism by referencing
subpatterns\*(--\c
.I perl
OFS \h'|2.5i'$,
ORS \h'|2.5i'$\e
RLENGTH \h'|2.5i'length($&)
- RS \h'|2.5i'$/
+ RS \h'|2.5i'$\/
RSTART \h'|2.5i'length($\`)
SUBSEP \h'|2.5i'$;
-/* $Header: perl.y,v 3.0.1.1 89/10/26 23:20:41 lwall Locked $
+/* $Header: perl.y,v 3.0.1.2 89/11/11 04:49:04 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.y,v $
+ * Revision 3.0.1.2 89/11/11 04:49:04 lwall
+ * patch2: moved yydebug to where its type doesn't matter
+ * patch2: !$foo++ was unreasonably illegal
+ * patch2: local(@foo) didn't work
+ * patch2: default args to unary operators didn't work
+ *
* Revision 3.0.1.1 89/10/26 23:20:41 lwall
* patch1: grandfathered "format stdout"
* patch1: operator(); is now normally equivalent to operator;
%% /* RULES */
-prog : lineseq
+prog : /* NULL */
+ {
+#if defined(YYDEBUG) && defined(DEBUGGING)
+ yydebug = (debug & 1);
+#endif
+ }
+ /*CONTINUED*/ lineseq
{ if (in_eval)
- eval_root = block_head($1);
+ eval_root = block_head($2);
else
- main_root = block_head($1); }
+ main_root = block_head($2); }
;
compblock: block CONTINUE block
{ $$ = mod_match(O_MATCH, $1, $3); }
| sexpr NMATCH sexpr
{ $$ = mod_match(O_NMATCH, $1, $3); }
- | term INC
- { $$ = addflags(1, AF_POST|AF_UP,
- l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
- | term DEC
- { $$ = addflags(1, AF_POST,
- l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
- | INC term
- { $$ = addflags(1, AF_PRE|AF_UP,
- l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
- | DEC term
- { $$ = addflags(1, AF_PRE,
- l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
| term
{ $$ = $1; }
;
{ $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
| '~' term
{ $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
+ | term INC
+ { $$ = addflags(1, AF_POST|AF_UP,
+ l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
+ | term DEC
+ { $$ = addflags(1, AF_POST,
+ l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
+ | INC term
+ { $$ = addflags(1, AF_PRE|AF_UP,
+ l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
+ | DEC term
+ { $$ = addflags(1, AF_PRE,
+ l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
| FILETEST WORD
{ opargs[$1] = 0; /* force it special */
$$ = make_op($1, 1,
$1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
Nullarg, Nullarg); }
| LOCAL '(' expr ')'
- { $$ = l(make_op(O_ITEM, 1,
+ { $$ = l(localize(make_op(O_ASSIGN, 1,
localize(listish(make_list($3))),
- Nullarg,Nullarg)); }
+ Nullarg,Nullarg))); }
| '(' expr ')'
{ $$ = make_list(hide_ary($2)); }
| '(' ')'
{ $$ = make_op($1,1,cval_to_arg($2),
Nullarg,Nullarg); }
| UNIOP
- { $$ = make_op($1,1,Nullarg,Nullarg,Nullarg);
+ { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
if ($1 == O_EVAL || $1 == O_RESET)
$$ = fixeval($$); }
| UNIOP sexpr
Nullarg, Nullarg)); }
| FUNC0
{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
+ | FUNC0 '(' ')'
+ { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
| FUNC1 '(' ')'
- { $$ = make_op($1, 1, Nullarg, Nullarg, Nullarg);
+ { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
if ($1 == O_EVAL || $1 == O_RESET)
$$ = fixeval($$); }
| FUNC1 '(' expr ')'
-char rcsid[] = "$Header: perly.c,v 3.0 89/10/18 15:22:21 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.1 89/11/11 04:50:04 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perly.c,v $
+ * Revision 3.0.1.1 89/11/11 04:50:04 lwall
+ * patch2: moved yydebug to where its type didn't matter
+ *
* Revision 3.0 89/10/18 15:22:21 lwall
* 3.0 baseline
*
perldb = TRUE;
s++;
goto reswitch;
-#ifdef DEBUGGING
case 'D':
+#ifdef DEBUGGING
#ifdef TAINT
if (euid != uid || egid != gid)
fatal("No -D allowed in setuid scripts");
#endif
debug = atoi(s+1);
-#ifdef YYDEBUG
- yydebug = (debug & 1);
+#else
+ warn("Recompile perl with -DDEBUGGING to use -D switch\n");
#endif
break;
-#endif
case 'e':
#ifdef TAINT
if (euid != uid || egid != gid)
fatal("Execution aborted due to compilation errors.\n");
New(50,loop_stack,128,struct loop);
- New(51,debname,128,char);
- New(52,debdelim,128,char);
+#ifdef DEBUGGING
+ if (debug) {
+ New(51,debname,128,char);
+ New(52,debdelim,128,char);
+ }
+#endif
curstash = defstash;
preprocess = FALSE;
* blame Henry for some of the lack of readability.
*/
-/* $Header: regcomp.c,v 3.0 89/10/18 15:22:29 lwall Locked $
+/* $Header: regcomp.c,v 3.0.1.1 89/11/11 04:51:04 lwall Locked $
*
* $Log: regcomp.c,v $
+ * Revision 3.0.1.1 89/11/11 04:51:04 lwall
+ * patch2: /[\000]/ didn't work
+ *
* Revision 3.0 89/10/18 15:22:29 lwall
* 3.0 baseline
*
}
if (*regparse != ']')
FAIL("unmatched [] in regexp");
- regset(bits,0,0); /* always bomb out on null */
regparse++;
return ret;
}
* blame Henry for some of the lack of readability.
*/
-/* $Header: regexec.c,v 3.0 89/10/18 15:22:53 lwall Locked $
+/* $Header: regexec.c,v 3.0.1.1 89/11/11 04:52:04 lwall Locked $
*
* $Log: regexec.c,v $
+ * Revision 3.0.1.1 89/11/11 04:52:04 lwall
+ * patch2: /\b$foo/ didn't work
+ *
* Revision 3.0 89/10/18 15:22:53 lwall
* 3.0 baseline
*
}
s++;
}
- if (tmp && regtry(prog,s))
+ if ((minlen || tmp) && regtry(prog,s))
goto got_it;
break;
case NBOUND:
goto got_it;
s++;
}
- if (!tmp && regtry(prog,s))
+ if ((minlen || !tmp) && regtry(prog,s))
goto got_it;
break;
case ALNUM:
-/* $Header: stab.c,v 3.0 89/10/18 15:23:23 lwall Locked $
+/* $Header: stab.c,v 3.0.1.1 89/11/11 04:55:07 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.c,v $
+ * Revision 3.0.1.1 89/11/11 04:55:07 lwall
+ * patch2: sys_errlist[sys_nerr] is illegal
+ *
* Revision 3.0 89/10/18 15:23:23 lwall
* 3.0 baseline
*
case '!':
str_numset(stab_val(stab), (double)errno);
str_set(stab_val(stab),
- errno < 0 || errno > sys_nerr ? "(unknown)" : sys_errlist[errno]);
+ errno < 0 || errno >= sys_nerr ? "(unknown)" : sys_errlist[errno]);
stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
break;
case '<':
-/* $Header: str.c,v 3.0.1.1 89/10/26 23:23:41 lwall Locked $
+/* $Header: str.c,v 3.0.1.2 89/11/11 04:56:22 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 3.0.1.2 89/11/11 04:56:22 lwall
+ * patch2: uchar gives Crays fits
+ *
* Revision 3.0.1.1 89/10/26 23:23:41 lwall
* patch1: string ordering tests were wrong
* patch1: $/ now works even when STDSTDIO undefined
else if (*d == '[' && s[-1] == ']') { /* char class? */
int weight = 2; /* let's weigh the evidence */
char seen[256];
- unsigned char uchar = 0, lastuchar;
+ unsigned char unchar = 0, lastunchar;
Zero(seen,256,char);
*--s = '\0';
weight -= 100;
}
for (d++; d < s; d++) {
- lastuchar = uchar;
- uchar = (unsigned char)*d;
+ lastunchar = unchar;
+ unchar = (unsigned char)*d;
switch (*d) {
case '&':
case '$':
- weight -= seen[uchar] * 10;
+ weight -= seen[unchar] * 10;
if (isalpha(d[1]) || isdigit(d[1]) ||
d[1] == '_') {
d = scanreg(d,s,tokenbuf);
}
break;
case '\\':
- uchar = 254;
+ unchar = 254;
if (d[1]) {
if (index("wds",d[1]))
weight += 100;
weight += 100;
break;
case '-':
- if (lastuchar < d[1] || d[1] == '\\') {
- if (index("aA01! ",lastuchar))
+ if (lastunchar < d[1] || d[1] == '\\') {
+ if (index("aA01! ",lastunchar))
weight += 30;
if (index("zZ79~",d[1]))
weight += 30;
weight -= 150;
d = bufptr;
}
- if (uchar == lastuchar + 1)
+ if (unchar == lastunchar + 1)
weight += 5;
- weight -= seen[uchar];
+ weight -= seen[unchar];
break;
}
- seen[uchar]++;
+ seen[unchar]++;
}
#ifdef DEBUGGING
if (debug & 512)
-/* $Header: toke.c,v 3.0.1.1 89/10/26 23:26:21 lwall Locked $
+/* $Header: toke.c,v 3.0.1.2 89/11/11 05:04:42 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 3.0.1.2 89/11/11 05:04:42 lwall
+ * patch2: fixed a CLINE macro conflict
+ *
* Revision 3.0.1.1 89/10/26 23:26:21 lwall
* patch1: disambiguated word after "sort" better
*
char *reparse; /* if non-null, scanreg found ${foo[$bar]} */
+#ifdef CLINE
+#undef CLINE
+#endif
#define CLINE (cmdline = (line < cmdline ? line : cmdline))
#define META(c) ((c) | 128)
retry:
#ifdef YYDEBUG
- if (yydebug)
+ if (debug & 1)
if (index(s,'\n'))
fprintf(stderr,"Tokener at %s",s);
else
}
#endif
bufend = linestr->str_ptr + linestr->str_cur;
- firstline = FALSE;
+ if (firstline) {
+ while (s < bufend && isspace(*s))
+ s++;
+ if (*s == ':') /* for csh's that have to exec sh scripts */
+ s++;
+ firstline = FALSE;
+ }
goto retry;
case ' ': case '\t': case '\f':
s++;
set_csh()
{
- if (!csh) {
- if (stat("/bin/csh",&statbuf) < 0)
- csh = -1;
- else
- csh = 1;
- }
+#ifdef CSH
+ if (!cshlen)
+ cshlen = strlen(cshname);
+#endif
}
-/* $Header: util.c,v 3.0 89/10/18 15:32:43 lwall Locked $
+/* $Header: util.c,v 3.0.1.1 89/11/11 05:06:13 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: util.c,v $
+ * Revision 3.0.1.1 89/11/11 05:06:13 lwall
+ * patch2: made dup2 a little better
+ *
* Revision 3.0 89/10/18 15:32:43 lwall
* 3.0 baseline
*
close(p[THIS]);
}
if (doexec) {
+#if !defined(FCNTL) || !defined(F_SETFD)
+ int fd;
+
+#ifndef NOFILE
+#define NOFILE 20
+#endif
+ for (fd = 3; fd < NOFILE; fd++)
+ close(fd);
+#endif
do_exec(cmd); /* may or may not use the shell */
_exit(1);
}
return fdopen(p[this], mode);
}
+#ifdef NOTDEF
+dumpfds(s)
+char *s;
+{
+ int fd;
+ struct stat tmpstatbuf;
+
+ fprintf(stderr,"%s", s);
+ for (fd = 0; fd < 32; fd++) {
+ if (fstat(fd,&tmpstatbuf) >= 0)
+ fprintf(stderr," %d",fd);
+ }
+ fprintf(stderr,"\n");
+}
+#endif
+
#ifndef DUP2
dup2(oldfd,newfd)
int oldfd;
int newfd;
{
+ int fdtmp[10];
+ int fdx = 0;
+ int fd;
+
close(newfd);
- while (dup(oldfd) != newfd) ; /* good enough for our purposes */
+ while ((fd = dup(oldfd)) != newfd) /* good enough for low fd's */
+ fdtmp[fdx++] = fd;
+ while (fdx > 0)
+ close(fdtmp[--fdx]);
}
#endif
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>s2p <<'!NO!SUBS!'
-# $Header: s2p.SH,v 3.0 89/10/18 15:35:02 lwall Locked $
+# $Header: s2p.SH,v 3.0.1.1 89/11/11 05:08:25 lwall Locked $
#
# $Log: s2p.SH,v $
+# Revision 3.0.1.1 89/11/11 05:08:25 lwall
+# patch2: in s2p, + within patterns needed backslashing
+# patch2: s2p was printing out some debugging info to the output file
+#
# Revision 3.0 89/10/18 15:35:02 lwall
# 3.0 baseline
#
elsif ($c eq ']') {
$inbracket = 0;
}
- elsif (!$repl && index("()",$c) >= 0) {
+ elsif (!$repl && index("()+",$c) >= 0) {
$_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
$i++;
$len++;
local($inbracket);
local($prefix,$delim,$ch);
- delim: while (s:^([^\](|)[\\/]*)([](|)[\\/])::) {
+ delim: while (s:^([^\]+(|)[\\/]*)([]+(|)[\\/])::) {
$prefix = $1;
$delim = $2;
- print "$prefix\t$delim\t$_\n";
if ($delim eq '\\') {
s/(.)//;
$ch = $1;
$inbracket = 1;
s/^\^// && ($delim .= '^');
s/^]// && ($delim .= ']');
- print "$prefix\t$delim\t$_\n";
}
elsif ($delim eq ']') {
$inbracket = 0;
}
elsif ($inbracket || $delim ne $outer) {
- print "Adding\n";
$delim = '\\' . $delim;
}
$addr .= $prefix;
-/* $Header: walk.c,v 3.0 89/10/18 15:35:48 lwall Locked $
+/* $Header: walk.c,v 3.0.1.1 89/11/11 05:09:33 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: walk.c,v $
+ * Revision 3.0.1.1 89/11/11 05:09:33 lwall
+ * patch2: in a2p, awk script with no line actions still needs main loop
+ *
* Revision 3.0 89/10/18 15:35:48 lwall
* 3.0 baseline
*
str_cat(str,"continue {\n $FNRbase = $. if eof;\n}\n");
}
else
- str_cat(str,"# (no line actions)\n");
+ str_cat(str,"while (<>) { } # (no line actions)\n");
if (ops[node+4].ival) {
realexit = TRUE;
str_cat(str,"\n");
projects / p5sagit/p5-mst-13.2.git / commitdiff