See patch #19.
#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $Header: relink,v 3.0.1.2 90/08/09 03:17:44 lwall Locked $
+#
+# $Log: relink,v $
+# Revision 3.0.1.2 90/08/09 03:17:44 lwall
+# patch19: added man page for relink and rename
+#
($op = shift) || die "Usage: relink perlexpr [filenames]\n";
if (!@ARGV) {
- if (-t) {
- @ARGV = <*>;
- }
- else {
- @ARGV = <STDIN>;
- chop(@ARGV);
- }
+ @ARGV = <STDIN>;
+ chop(@ARGV);
}
for (@ARGV) {
next unless -l; # symbolic link?
symlink($_, $name);
}
}
+##############################################################################
+
+ # These next few lines are legal in both Perl and nroff.
+
+.00; # finish .ig
+
+'di \" finish diversion--previous line must be blank
+.nr nl 0-1 \" fake up transition to first page again
+.nr % 0 \" start at page 1
+';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+.TH RELINK 1 "July 30, 1990"
+.AT 3
+.SH LINK
+relink \- relinks multiple symbolic links
+.SH SYNOPSIS
+.B relink perlexpr [symlinknames]
+.SH DESCRIPTION
+.I Relink
+relinks the symbolic links given according to the rule specified as the
+first argument.
+The argument is a Perl expression which is expected to modify the $_
+string in Perl for at least some of the names specified.
+For each symbolic link named on the command line, the Perl expression
+will be executed on the contents of the symbolic link with that name.
+If a given symbolic link's contents is not modified by the expression,
+it will not be changed.
+If a name given on the command line is not a symbolic link, it will be ignored.
+If no names are given on the command line, names will be read
+via standard input.
+.PP
+For example, to relink all symbolic links in the current directory
+pointing to somewhere in X11R3 so that they point to X11R4, you might say
+.nf
+
+ relink 's/X11R3/X11R4/' *
+
+.fi
+To change all occurences of links in the system from /usr/spool to /var/spool,
+you'd say
+.nf
+
+ find / -type l -print | relink 's#/usr/spool#/var/spool#'
+
+.fi
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+ln(1)
+.br
+perl(1)
+.SH DIAGNOSTICS
+If you give an invalid Perl expression you'll get a syntax error.
+.SH BUGS
+.ex
#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $Header: rename,v 3.0.1.2 90/08/09 03:17:57 lwall Locked $
+#
+# $Log: rename,v $
+# Revision 3.0.1.2 90/08/09 03:17:57 lwall
+# patch19: added man page for relink and rename
+#
($op = shift) || die "Usage: rename perlexpr [filenames]\n";
if (!@ARGV) {
- if (-t) {
- @ARGV = <*>;
- }
- else {
- @ARGV = <STDIN>;
- chop(@ARGV);
- }
+ @ARGV = <STDIN>;
+ chop(@ARGV);
}
for (@ARGV) {
$was = $_;
die $@ if $@;
rename($was,$_) unless $was eq $_;
}
+##############################################################################
+
+ # These next few lines are legal in both Perl and nroff.
+
+.00; # finish .ig
+
+'di \" finish diversion--previous line must be blank
+.nr nl 0-1 \" fake up transition to first page again
+.nr % 0 \" start at page 1
+';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+.TH RENAME 1 "July 30, 1990"
+.AT 3
+.SH NAME
+rename \- renames multiple files
+.SH SYNOPSIS
+.B rename perlexpr [files]
+.SH DESCRIPTION
+.I Rename
+renames the filenames supplied according to the rule specified as the
+first argument.
+The argument is a Perl expression which is expected to modify the $_
+string in Perl for at least some of the filenames specified.
+If a given filename is not modified by the expression, it will not be
+renamed.
+If no filenames are given on the command line, filenames will be read
+via standard input.
+.PP
+For example, to rename all files matching *.bak to strip the extension,
+you might say
+.nf
+
+ rename 's/\e.bak$//' *.bak
+
+.fi
+To translate uppercase names to lower, you'd use
+.nf
+
+ rename 'y/A-Z/a-z/' *
+
+.fi
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+mv(1)
+.br
+perl(1)
+.SH DIAGNOSTICS
+If you give an invalid Perl expression you'll get a syntax error.
+.SH BUGS
+.I Rename
+does not check for the existence of target filenames, so use with care.
+.ex
--- /dev/null
+$sizeof{'char'} = 1;
+$sizeof{'int'} = 4;
+$sizeof{'long'} = 4;
+$sizeof{'struct arpreq'} = 36;
+$sizeof{'struct ifconf'} = 8;
+$sizeof{'struct ifreq'} = 32;
+$sizeof{'struct ltchars'} = 6;
+$sizeof{'struct pcntl'} = 116;
+$sizeof{'struct rtentry'} = 52;
+$sizeof{'struct sgttyb'} = 6;
+$sizeof{'struct tchars'} = 6;
+$sizeof{'struct ttychars'} = 14;
+$sizeof{'struct winsize'} = 8;
+$sizeof{'struct termios'} = 132;
--- /dev/null
+;# pwd.pl - keeps track of current working directory in PWD environment var
+;#
+;# $Header: pwd.pl,v 3.0.1.1 90/08/09 04:01:24 lwall Locked $
+;#
+;# $Log: pwd.pl,v $
+;# Revision 3.0.1.1 90/08/09 04:01:24 lwall
+;# patch19: Initial revision
+;#
+;#
+;# Usage:
+;# require "pwd.pl";
+;# &initpwd;
+;# ...
+;# &chdir($newdir);
+
+package pwd;
+
+sub main'initpwd {
+ if ($ENV{'PWD'}) {
+ local($dd,$di) = stat('.');
+ local($pd,$pi) = stat($ENV{'PWD'});
+ return if $di == $pi && $dd == $pd;
+ }
+ chop($ENV{'PWD'} = `pwd`);
+}
+
+sub main'chdir {
+ local($newdir) = shift;
+ if (chdir $newdir) {
+ if ($newdir =~ m#^/#) {
+ $ENV{'PWD'} = $newdir;
+ }
+ else {
+ local(@curdir) = split(m#/#,$ENV{'PWD'});
+ @curdir = '' unless @curdir;
+ foreach $component (split(m#/#, $newdir)) {
+ next if $component eq '.';
+ pop(@curdir),next if $component eq '..';
+ push(@curdir,$component);
+ }
+ $ENV{'PWD'} = join('/',@curdir) || '/';
+ }
+ }
+ else {
+ 0;
+ }
+}
+
-/* $Header: popen.c,v 3.0.1.1 90/03/27 16:11:57 lwall Locked $
+/* $Header: popen.c,v 3.0.1.2 90/08/09 04:04:42 lwall Locked $
*
* (C) Copyright 1988, 1990 Diomidis Spinellis.
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: popen.c,v $
+ * Revision 3.0.1.2 90/08/09 04:04:42 lwall
+ * patch19: various MSDOS and OS/2 patches folded in
+ *
* Revision 3.0.1.1 90/03/27 16:11:57 lwall
* patch16: MSDOS support
*
switch (*t) {
case 'r':
- sprintf(buff, "%s >%s", command, name);
+ sprintf(buff, "%s>%s", command, name);
if (system(buff) || (f = fopen(name, "r")) == NULL) {
free(name);
return NULL;
--- /dev/null
+/*
+ * Pipe support for OS/2.
+ *
+ * WARNING: I am guilty of chumminess with the runtime library because
+ * I had no choice. Details to follow.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#define INCL_DOSPROCESS
+#define INCL_DOSQUEUES
+#define INCL_DOSMISC
+#define INCL_DOSMEMMGR
+#include <os2.h>
+
+extern char **environ;
+
+/* This mysterious array _osfile is used internally by the runtime
+ * library to remember assorted things about open file handles.
+ * The problem is that we are creating file handles via DosMakePipe,
+ * rather than via the runtime library. This means that we have
+ * to fake the runtime library into thinking that the handles we've
+ * created are honest file handles. So just before doing the fdopen,
+ * we poke in a magic value that fools the library functions into
+ * thinking that the handle is already open in text mode.
+ *
+ * This might not work for your compiler, so beware.
+ */
+extern char _osfile[];
+
+/* The maximum number of simultaneously open pipes. We create an
+ * array of this size to record information about each open pipe.
+ */
+#define MAXPIPES 5
+
+/* Information to remember about each open pipe.
+ * The (FILE *) that popen returns is stored because that's the only
+ * way we can keep track of the pipes.
+ */
+typedef struct pipeinfo {
+ FILE *pfId; /* Which FILE we're talking about */
+ HFILE hfMe; /* handle I should close at pclose */
+ PID pidChild; /* Child's PID */
+ CHAR fReading; /* A read or write pipe? */
+} PIPEINFO, *PPIPEINFO; /* pi and ppi */
+
+static PIPEINFO PipeInfo[MAXPIPES];
+
+FILE *mypopen(const char *command, const char *t)
+{
+ typedef char *PSZZ;
+ PSZZ pszzPipeArgs = 0;
+ PSZZ pszzEnviron = 0;
+ PSZ *ppsz;
+ PSZ psz;
+ FILE *f;
+ HFILE hfMe, hfYou;
+ HFILE hf, hfSave;
+ RESULTCODES rc;
+ USHORT us;
+ PPIPEINFO ppi;
+ UINT i;
+
+ /* Validate pipe type */
+ if (*t != 'w' && *t != 'r') fatal("Unknown pipe type");
+
+ /* Room for another pipe? */
+ for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++)
+ if (ppi->pfId == 0) goto foundone;
+ return NULL;
+
+foundone:
+
+ /* Make the pipe */
+ if (DosMakePipe(&hfMe, &hfYou, 0)) return NULL;
+
+ /* Build the environment. First compute its length, then copy
+ * the environment strings into it.
+ */
+ i = 0;
+ for (ppsz = environ; *ppsz; ppsz++) i += 1 + strlen(*ppsz);
+ New(1204, pszzEnviron, 1+i, CHAR);
+
+ psz = pszzEnviron;
+ for (ppsz = environ; *ppsz; ppsz++) {
+ strcpy(psz, *ppsz);
+ psz += 1 + strlen(*ppsz);
+ }
+ *psz = 0;
+
+ /* Build the command string to execute.
+ * 6 = length(0 "/c " 0 0)
+ */
+ if (DosScanEnv("COMSPEC", &psz)) psz = "C:\\OS2\\cmd.exe";
+#if 0
+ New(1203, pszzPipeArgs, strlen(psz) + strlen(command) + 6, CHAR);
+#else
+#define pszzPipeArgs buf
+#endif
+ sprintf(pszzPipeArgs, "%s%c/c %s%c", psz, 0, command, 0);
+
+ /* Now some stuff that depends on what kind of pipe we're doing.
+ * We pull a sneaky trick; namely, that stdin = 0 = false,
+ * and stdout = 1 = true. The end result is that if the
+ * pipe is a read pipe, then hf = 1; if it's a write pipe, then
+ * hf = 0 and Me and You are reversed.
+ */
+ if (!(hf = (*t == 'r'))) {
+ /* The meaning of Me and You is reversed for write pipes. */
+ hfSave = hfYou; hfYou = hfMe; hfMe = hfSave;
+ }
+
+ ppi->fReading = hf;
+
+ /* Trick number 1: Fooling the runtime library into thinking
+ * that the file handle is legit.
+ *
+ * Trick number 2: Don't let my handle go over to the child!
+ * Since the child never closes it (why should it?), I'd better
+ * make sure he never sees it in the first place. Otherwise,
+ * we are in deadlock city.
+ */
+ _osfile[hfMe] = 0x81; /* Danger, Will Robinson! */
+ if (!(ppi->pfId = fdopen(hfMe, t))) goto no_fdopen;
+ DosSetFHandState(hfMe, OPEN_FLAGS_NOINHERIT);
+
+ /* Save the original handle because we're going to diddle it */
+ hfSave = 0xFFFF;
+ if (DosDupHandle(hf, &hfSave)) goto no_dup_init;
+
+ /* Force the child's handle onto the stdio handle */
+ if (DosDupHandle(hfYou, &hf)) goto no_force_dup;
+ DosClose(hfYou);
+
+ /* Now run the guy servicing the pipe */
+ us = DosExecPgm(NULL, 0, EXEC_ASYNCRESULT, pszzPipeArgs, pszzEnviron,
+ &rc, pszzPipeArgs);
+
+ /* Restore stdio handle, even if exec failed. */
+ DosDupHandle(hfSave, &hf); close(hfSave);
+
+ /* See if the exec succeeded. */
+ if (us) goto no_exec_pgm;
+
+ /* Remember the child's PID */
+ ppi->pidChild = rc.codeTerminate;
+
+ Safefree(pszzEnviron);
+
+ /* Phew. */
+ return ppi->pfId;
+
+ /* Here is where we clean up after an error. */
+no_exec_pgm: ;
+no_force_dup: close(hfSave);
+no_dup_init: fclose(f);
+no_fdopen:
+ DosClose(hfMe); DosClose(hfYou);
+ ppi->pfId = 0;
+ Safefree(pszzEnviron);
+ return NULL;
+}
+
+
+/* mypclose: Closes the pipe associated with the file handle.
+ * After waiting for the child process to terminate, its return
+ * code is returned. If the stream was not associated with a pipe,
+ * we return -1.
+ */
+int
+mypclose(FILE *f)
+{
+ PPIPEINFO ppi;
+ RESULTCODES rc;
+ USHORT us;
+
+ /* Find the pipe this (FILE *) refers to */
+ for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++)
+ if (ppi->pfId == f) goto foundit;
+ return -1;
+foundit:
+ if (ppi->fReading && !DosRead(fileno(f), &rc, 1, &us) && us > 0) {
+ DosKillProcess(DKP_PROCESSTREE, ppi->pidChild);
+ }
+ fclose(f);
+ DosCwait(DCWA_PROCESS, DCWW_WAIT, &rc, &ppi->pidChild, ppi->pidChild);
+ ppi->pfId = 0;
+ return rc.codeResult;
+}
+
+/* pipe: The only tricky thing is letting the runtime library know about
+ * our two new file descriptors.
+ */
+int pipe(int filedes[2])
+{
+ HFILE hfRead, hfWrite;
+ USHORT usResult;
+
+ usResult = DosMakePipe(&hfRead, &hfWrite, 0);
+ if (usResult) {
+ /* Error 4 == ERROR_TOO_MANY_OPEN_FILES */
+ errno = (usResult == 4) ? ENFILE : ENOMEM;
+ return -1;
+ }
+ _osfile[hfRead] = _osfile[hfWrite] = 0x81;/* Danger, Will Robinson! */
+ filedes[0] = hfRead;
+ filedes[1] = hfWrite;
+ return 0;
+}
-#define PATCHLEVEL 24
+#define PATCHLEVEL 25
* blame Henry for some of the lack of readability.
*/
-/* $Header: regcomp.c,v 3.0.1.3 90/03/12 16:59:22 lwall Locked $
+/* $Header: regcomp.c,v 3.0.1.4 90/08/09 05:05:33 lwall Locked $
*
* $Log: regcomp.c,v $
+ * Revision 3.0.1.4 90/08/09 05:05:33 lwall
+ * patch19: sped up /x+y/ patterns greatly by not retrying on every x
+ * patch19: inhibited backoff on patterns anchored to the end like /\s+$/
+ * patch19: sped up {m,n} on simple items
+ * patch19: optimized /.*whatever/ to /^.*whatever/
+ * patch19: fixed character classes to allow backslashing hyphen
+ *
* Revision 3.0.1.3 90/03/12 16:59:22 lwall
* patch13: pattern matches can now use \0 to mean \000
*
* of the structure of the compiled regexp. [I'll say.]
*/
regexp *
-regcomp(exp,xend,fold,rare)
+regcomp(exp,xend,fold)
char *exp;
char *xend;
int fold;
-int rare;
{
register regexp *r;
register char *scan;
int curback;
extern char *safemalloc();
extern char *savestr();
+ int sawplus = 0;
if (exp == NULL)
fatal("NULL regexp argument");
first = scan;
while ((OP(first) > OPEN && OP(first) < CLOSE) ||
(OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
- (OP(first) == PLUS) )
+ (OP(first) == PLUS) ||
+ (OP(first) == CURLY && ARG1(first) > 0) ) {
+ if (OP(first) == CURLY)
+ first += 4;
+ else if (OP(first) == PLUS)
+ sawplus = 2;
first = NEXTOPER(first);
+ }
/* Starting-point info. */
if (OP(first) == EXACTLY) {
r->regstclass = first;
else if (OP(first) == BOUND || OP(first) == NBOUND)
r->regstclass = first;
- else if (OP(first) == BOL)
- r->reganch++;
+ else if (OP(first) == BOL ||
+ (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) )
+ r->reganch = 1; /* kinda turn .* into ^.* */
+ r->reganch |= sawplus;
#ifdef DEBUGGING
if (debug & 512)
next++;
}
if (*next == '}') { /* got one */
- regsawbracket++; /* remember we clobbered exp */
if (!max)
max = next;
regparse++;
iter = atoi(regparse);
+ if (flags&SIMPLE) { /* we can do it right after all */
+ int tmp;
+
+ reginsert(CURLY, ret);
+ if (*max == ',')
+ max++;
+ tmp = atoi(max);
+ if (tmp && tmp < iter)
+ fatal("Can't do {n,m} with n > m");
+ if (regcode != ®dummy) {
+#ifdef REGALIGN
+ *(unsigned short *)(ret+3) = iter;
+ *(unsigned short *)(ret+5) = tmp;
+#else
+ ret[3] = iter >> 8; ret[4] = iter & 0377;
+ ret[5] = tmp >> 8; ret[6] = tmp & 0377;
+#endif
+ }
+ regparse = next;
+ goto nest_check;
+ }
+ regsawbracket++; /* remember we clobbered exp */
if (iter > 0) {
ch = *max;
sprintf(regparse,"%.*d", max-regparse, iter - 1);
*max = ch;
- if (*max == ',' && atoi(max+1) > 0) {
+ if (*max == ',' && max[1] != '}') {
+ if (atoi(max+1) <= 0)
+ fatal("Can't do {n,m} with n > m");
ch = *next;
sprintf(max+1,"%.*d", next-(max+1), atoi(max+1) - 1);
*next = ch;
}
- if (iter != 1 || (*max == ',' || atoi(max+1))) {
+ if (iter != 1 || *max == ',') {
regparse = origparse; /* back up input pointer */
regnpar = orignpar; /* don't make more parens */
}
register char *ret;
register int def;
+ ret = regnode(ANYOF);
if (*regparse == '^') { /* Complement of range. */
- ret = regnode(ANYBUT);
regparse++;
def = 0;
} else {
- ret = regnode(ANYOF);
def = 255;
}
bits = regcode;
for (class = 0; class < 32; class++)
regc(def);
if (*regparse == ']' || *regparse == '-')
- regset(bits,def,lastclass = *regparse++);
+ goto skipcond; /* allow 1st char to be ] or - */
while (regparse < regxend && *regparse != ']') {
+ skipcond:
class = UCHARAT(regparse++);
if (class == '\\') {
class = UCHARAT(regparse++);
break;
}
}
- if (!range && class == '-' && regparse < regxend &&
- *regparse != ']') {
- range = 1;
- continue;
- }
if (range) {
if (lastclass > class)
FAIL("invalid [] range in regexp");
+ range = 0;
}
- else
- lastclass = class - 1;
- range = 0;
- for (lastclass++; lastclass <= class; lastclass++) {
+ else {
+ lastclass = class;
+ if (*regparse == '-' && regparse+1 < regxend &&
+ regparse[1] != ']') {
+ regparse++;
+ range = 1;
+ continue; /* do it next time */
+ }
+ }
+ for ( ; lastclass <= class; lastclass++) {
regset(bits,def,lastclass);
if (regfold && isupper(lastclass))
regset(bits,def,tolower(lastclass));
register char *src;
register char *dst;
register char *place;
+ register offset = (op == CURLY ? 4 : 0);
if (regcode == ®dummy) {
#ifdef REGALIGN
- regsize += 4;
+ regsize += 4 + offset;
#else
- regsize += 3;
+ regsize += 3 + offset;
#endif
return;
}
src = regcode;
#ifdef REGALIGN
- regcode += 4;
+ regcode += 4 + offset;
#else
- regcode += 3;
+ regcode += 3 + offset;
#endif
dst = regcode;
while (src > opnd)
*place++ = op;
*place++ = '\0';
*place++ = '\0';
+ while (offset-- > 0)
+ *place++ = '\0';
}
/*
else
fprintf(stderr,"(%d)", (s-r->program)+(next-s));
s += 3;
- if (op == ANYOF || op == ANYBUT) {
+ if (op == ANYOF) {
s += 32;
}
if (op == EXACTLY) {
fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
if (r->regstclass)
fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
- if (r->reganch)
+ if (r->reganch & 1)
fprintf(stderr,"anchored ");
+ if (r->reganch & 2)
+ fprintf(stderr,"plus ");
if (r->regmust != NULL)
fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
r->regback);
case ANYOF:
p = "ANYOF";
break;
- case ANYBUT:
- p = "ANYBUT";
- break;
case BRANCH:
p = "BRANCH";
break;
case NDIGIT:
p = "NDIGIT";
break;
+ case CURLY:
+ (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}",
+ ARG1(op),ARG2(op));
+ p = NULL;
+ break;
case REF:
case REF+1:
case REF+2:
-/* $Header: regcomp.h,v 3.0 89/10/18 15:22:39 lwall Locked $
+/* $Header: regcomp.h,v 3.0.1.1 90/08/09 05:06:49 lwall Locked $
*
* $Log: regcomp.h,v $
+ * Revision 3.0.1.1 90/08/09 05:06:49 lwall
+ * patch19: sped up {m,n} on simple items
+ *
* Revision 3.0 89/10/18 15:22:39 lwall
* 3.0 baseline
*
#define BOL 1 /* no Match "" at beginning of line. */
#define EOL 2 /* no Match "" at end of line. */
#define ANY 3 /* no Match any one character. */
-#define ANYOF 4 /* str Match any character in this string. */
-#define ANYBUT 5 /* str Match any character not in this string. */
+#define ANYOF 4 /* str Match character in (or not in) this class. */
+#define CURLY 5 /* str Match this simple thing {n,m} times. */
#define BRANCH 6 /* node Match this alternative, or the next... */
#define BACK 7 /* no Match "", "next" ptr points backward. */
#define EXACTLY 8 /* str Match this string (preceded by length). */
#ifndef DOINIT
extern char varies[];
#else
-char varies[] = {BRANCH,BACK,STAR,PLUS,
+char varies[] = {BRANCH,BACK,STAR,PLUS,CURLY,
REF+1,REF+2,REF+3,REF+4,REF+5,REF+6,REF+7,REF+8,REF+9,0};
#endif
#ifndef DOINIT
extern char simple[];
#else
-char simple[] = {ANY,ANYOF,ANYBUT,ALNUM,NALNUM,SPACE,NSPACE,DIGIT,NDIGIT,0};
+char simple[] = {ANY,ANYOF,ALNUM,NALNUM,SPACE,NSPACE,DIGIT,NDIGIT,0};
#endif
EXT char regdummy;
#ifndef lint
#ifdef REGALIGN
#define NEXT(p) (*(short*)(p+1))
+#define ARG1(p) (*(unsigned short*)(p+3))
+#define ARG2(p) (*(unsigned short*)(p+5))
#else
#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
+#define ARG1(p) (((*((p)+3)&0377)<<8) + (*((p)+4)&0377))
+#define ARG2(p) (((*((p)+5)&0377)<<8) + (*((p)+6)&0377))
#endif
#else /* lint */
#define NEXT(p) 0
* blame Henry for some of the lack of readability.
*/
-/* $Header: regexec.c,v 3.0.1.3 90/02/28 18:14:39 lwall Locked $
+/* $Header: regexec.c,v 3.0.1.4 90/08/09 05:12:03 lwall Locked $
*
* $Log: regexec.c,v $
+ * Revision 3.0.1.4 90/08/09 05:12:03 lwall
+ * patch19: sped up /x+y/ patterns greatly by not retrying on every x
+ * patch19: inhibited backoff on patterns anchored to the end like /\s+$/
+ * patch19: sped up {m,n} on simple items
+ * patch19: $' broke on embedded nulls
+ * patch19: $ will now only match at end of string if $* == 0
+ *
* Revision 3.0.1.3 90/02/28 18:14:39 lwall
* patch9: /[\200-\377]/ didn't work on machines with signed chars
* patch9: \d, \w, and \s could misfire on characters with high bit set
/* Simplest case: anchored match need be tried only once. */
/* [unless multiline is set] */
- if (prog->reganch) {
+ if (prog->reganch & 1) {
if (regtry(prog, string))
goto got_it;
else if (multiline) {
/* for multiline we only have to try after newlines */
if (s > string)
s--;
- for (; s < strend; s++) {
- if (*s == '\n') {
- if (++s < strend && regtry(prog, s))
+ while (s < strend) {
+ if (*s++ == '\n') {
+ if (s < strend && regtry(prog, s))
goto got_it;
}
}
/* Messy cases: unanchored match. */
if (prog->regstart) {
- /* We know what string it must start with. */
- if (prog->regstart->str_pok == 3) {
+ if (prog->reganch & 2) { /* we have /x+whatever/ */
+ /* it must be a one character string */
+ i = prog->regstart->str_ptr[0];
+ while (s < strend) {
+ if (*s == i) {
+ if (regtry(prog, s))
+ goto got_it;
+ s++;
+ while (s < strend && *s == i)
+ s++;
+ }
+ s++;
+ }
+ }
+ else if (prog->regstart->str_pok == 3) {
+ /* We know what string it must start with. */
#ifndef lint
while ((s = fbminstr((unsigned char*)s,
(unsigned char*)strend, prog->regstart)) != NULL)
goto phooey;
}
if (c = prog->regstclass) {
+ int doevery = (prog->reganch & 2) == 0;
+
if (minlen)
dontbother = minlen - 1;
strend -= dontbother; /* don't bother with what can't match */
+ tmp = 1;
/* We know what class it must start with. */
switch (OP(c)) {
- case ANYOF: case ANYBUT:
+ case ANYOF:
c = OPERAND(c);
while (s < strend) {
i = UCHARAT(s);
- if (!(c[i >> 3] & (1 << (i&7))))
- if (regtry(prog, s))
+ if (!(c[i >> 3] & (1 << (i&7)))) {
+ if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case ALNUM:
while (s < strend) {
i = *s;
- if (isALNUM(i))
- if (regtry(prog, s))
+ if (isALNUM(i)) {
+ if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case NALNUM:
while (s < strend) {
i = *s;
- if (!isALNUM(i))
- if (regtry(prog, s))
+ if (!isALNUM(i)) {
+ if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case SPACE:
while (s < strend) {
- if (isSPACE(*s))
- if (regtry(prog, s))
+ if (isSPACE(*s)) {
+ if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case NSPACE:
while (s < strend) {
- if (!isSPACE(*s))
- if (regtry(prog, s))
+ if (!isSPACE(*s)) {
+ if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case DIGIT:
while (s < strend) {
- if (isDIGIT(*s))
- if (regtry(prog, s))
+ if (isDIGIT(*s)) {
+ if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case NDIGIT:
while (s < strend) {
- if (!isDIGIT(*s))
- if (regtry(prog, s))
+ if (!isDIGIT(*s)) {
+ if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
if (prog->subbase)
Safefree(prog->subbase);
prog->subbase = s;
+ prog->subend = s+i;
}
else
s = prog->subbase;
((nextchar || locinput < regeol) &&
locinput[-1] == '\n') )
{
- regtill--;
+ regtill = regbol;
break;
}
return(0);
case EOL:
if ((nextchar || locinput < regeol) && nextchar != '\n')
return(0);
- regtill--;
+ if (!multiline && regeol - locinput > 1)
+ return 0;
+ regtill = regbol;
break;
case ANY:
if ((nextchar == '\0' && locinput >= regeol) ||
/* Inline the first character, for speed. */
if (*s != nextchar)
return(0);
- if (locinput + ln > regeol)
+ if (regeol - locinput < ln)
return 0;
if (ln > 1 && bcmp(s, locinput, ln) != 0)
return(0);
nextchar = *locinput;
break;
case ANYOF:
- case ANYBUT:
s = OPERAND(scan);
if (nextchar < 0)
nextchar = UCHARAT(locinput);
}
}
break;
+ case CURLY:
+ ln = ARG1(scan); /* min to match */
+ n = ARG2(scan); /* max to match */
+ scan = NEXTOPER(scan) + 4;
+ goto repeat;
case STAR:
+ ln = 0;
+ n = 0;
+ scan = NEXTOPER(scan);
+ goto repeat;
case PLUS:
/*
* Lookahead to avoid useless match attempts
* when we know what character comes next.
*/
+ ln = 1;
+ n = 0;
+ scan = NEXTOPER(scan);
+ repeat:
if (OP(next) == EXACTLY)
nextchar = *(OPERAND(next)+1);
else
nextchar = -1000;
- ln = (OP(scan) == STAR) ? 0 : 1;
reginput = locinput;
- n = regrepeat(NEXTOPER(scan));
+ n = regrepeat(scan, n);
+ if (!multiline && OP(next) == EOL)
+ ln = n; /* why back off? */
while (n >= ln) {
/* If it could work, try it. */
if (nextchar == -1000 || *reginput == nextchar)
* rather than incrementing count on every character.]
*/
static int
-regrepeat(p)
+regrepeat(p, max)
char *p;
+int max;
{
register char *scan;
register char *opnd;
register char *loceol = regeol;
scan = reginput;
+ if (max && max < loceol - scan)
+ loceol = scan + max;
opnd = OPERAND(p);
switch (OP(p)) {
case ANY:
scan++;
break;
case ANYOF:
- case ANYBUT:
c = UCHARAT(scan);
while (scan < loceol && !(opnd[c >> 3] & (1 << (c & 7)))) {
scan++;
* not the System V one.
*/
-/* $Header: regexp.h,v 3.0 89/10/18 15:22:46 lwall Locked $
+/* $Header: regexp.h,v 3.0.1.1 90/08/09 05:12:55 lwall Locked $
*
* $Log: regexp.h,v $
+ * Revision 3.0.1.1 90/08/09 05:12:55 lwall
+ * patch19: $' broke on embedded nulls
+ *
* Revision 3.0 89/10/18 15:22:46 lwall
* 3.0 baseline
*
int regback; /* Can regmust locate first try? */
char *precomp; /* pre-compilation regular expression */
char *subbase; /* saved string so \digit works forever */
+ char *subend; /* end of subbase */
char reganch; /* Internal use only. */
char do_folding; /* do case-insensitive match? */
char lastparen; /* last paren matched */
-/* $Header: stab.c,v 3.0.1.6 90/03/27 16:22:11 lwall Locked $
+/* $Header: stab.c,v 3.0.1.7 90/08/09 05:17:48 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.7 90/08/09 05:17:48 lwall
+ * patch19: fixed double include of <signal.h>
+ * patch19: $' broke on embedded nulls
+ * patch19: $< and $> better supported on machines without setreuid
+ * patch19: Added support for linked-in C subroutines
+ * patch19: %ENV wasn't forced to be global like it should
+ * patch19: $| didn't work before the filehandle was opened
+ * patch19: $! now returns "" in string context if errno == 0
+ *
* Revision 3.0.1.6 90/03/27 16:22:11 lwall
* patch16: support for machines that can't cast negative floats to unsigned ints
*
#include "EXTERN.h"
#include "perl.h"
+#ifndef NSIG
#include <signal.h>
+#endif
static char *sig_name[] = {
SIG_NAME,0
if (curspat) {
if (curspat->spat_regexp &&
(s = curspat->spat_regexp->endp[0]) ) {
- str_set(stab_val(stab),s);
+ str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
}
else
str_nset(stab_val(stab),"",0);
str_numset(stab_val(stab),(double)arybase);
break;
case '|':
+ if (!stab_io(curoutstab))
+ stab_io(curoutstab) = stio_new();
str_numset(stab_val(stab),
(double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
break;
break;
case '!':
str_numset(stab_val(stab), (double)errno);
- str_set(stab_val(stab), strerror(errno));
+ str_set(stab_val(stab), errno ? strerror(errno) : "");
stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
break;
case '<':
#endif
str_set(stab_val(stab),buf);
break;
+ default:
+ {
+ struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
+
+ if (uf && uf->uf_val)
+ uf->uf_val(uf->uf_index, stab_val(stab));
+ }
+ break;
}
return stab_val(stab);
}
stab->str_pok = 1;
strcpy(stab_magic(stab),"StB");
stab_val(stab) = Str_new(70,0);
- stab_line(stab) = line;
+ stab_line(stab) = curcmd->c_line;
}
- else
+ else {
stab = stabent(s,TRUE);
+ if (!stab_xarray(stab))
+ aadd(stab);
+ if (!stab_xhash(stab))
+ hadd(stab);
+ if (!stab_io(stab))
+ stab_io(stab) = stio_new();
+ }
str_sset(str,stab);
}
break;
stab_io(curoutstab)->page = (long)str_gnum(str);
break;
case '|':
+ if (!stab_io(curoutstab))
+ stab_io(curoutstab) = stio_new();
stab_io(curoutstab)->flags &= ~IOF_FLUSH;
if (str_gnum(str) != 0.0) {
stab_io(curoutstab)->flags |= IOF_FLUSH;
if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
uid = (int)getuid();
#else
- fatal("setruid() not implemented");
+ if (uid == euid) /* special case $< = $> */
+ setuid(uid);
+ else
+ fatal("setruid() not implemented");
#endif
#endif
break;
if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
euid = (int)geteuid();
#else
- fatal("seteuid() not implemented");
+ if (euid == uid) /* special case $> = $< */
+ setuid(euid);
+ else
+ fatal("seteuid() not implemented");
#endif
#endif
break;
case ':':
chopset = str_get(str);
break;
+ default:
+ {
+ struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
+
+ if (uf && uf->uf_set)
+ uf->uf_set(uf->uf_index, str);
+ }
+ break;
}
break;
}
ARRAY *oldstack = stack;
SUBR *sub;
+#ifdef OS2 /* or anybody else who requires SIG_ACK */
+ signal(sig, SIG_ACK);
+#endif
stab = stabent(
str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
TRUE)), TRUE);
if (*name == 'I' && strEQ(name, "INC"))
global = TRUE;
}
- else if (*name >= 'A') {
+ else if (*name > 'A') {
if (*name == 'E' && strEQ(name, "ENV"))
global = TRUE;
}
stab->str_pok = 1;
strcpy(stab_magic(stab),"StB");
stab_val(stab) = Str_new(72,0);
- stab_line(stab) = line;
+ stab_line(stab) = curcmd->c_line;
str_magic(stab,stab,'*',name,len);
return stab;
}
stab = (STAB*)entry->hent_val;
if (stab->str_pok & SP_MULTI)
continue;
- line = stab_line(stab);
+ curcmd->c_line = stab_line(stab);
warn("Possible typo: \"%s\"", stab_name(stab));
}
}
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>s2p <<'!NO!SUBS!'
-# $Header: s2p.SH,v 3.0.1.3 90/03/01 10:31:21 lwall Locked $
+# $Header: s2p.SH,v 3.0.1.4 90/08/09 05:50:43 lwall Locked $
#
# $Log: s2p.SH,v $
+# Revision 3.0.1.4 90/08/09 05:50:43 lwall
+# patch19: s2p didn't translate \n right
+#
# Revision 3.0.1.3 90/03/01 10:31:21 lwall
# patch9: s2p didn't handle \< and \>
#
$len = length($_);
$_ = substr($_,0,--$len);
}
+ elsif (substr($_,$i,1) =~ /^[n]$/) {
+ ;
+ }
elsif (!$repl && substr($_,$i,1) =~ /^[(){}\w]$/) {
$i--;
$len--;
if ($delim eq '\\') {
s/(.)//;
$ch = $1;
- $delim = '' if $ch =~ /^[(){}\w]$/;
+ $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
$ch = 'b' if $ch =~ /^[<>]$/;
$delim .= $ch;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff