perl 2.0 (no announcement message available)perl-2.0

Some of the enhancements from Perl1 included:

    * New regexp routines derived from Henry Spencer's.
          o Support for /(foo|bar)/.
          o Support for /(foo)*/ and /(foo)+/.
          o \s for whitespace, \S for non-, \d for digit, \D nondigit 
    * Local variables in blocks, subroutines and evals.
    * Recursive subroutine calls are now supported.
    * Array values may now be interpolated into lists: unlink 'foo', 'bar', @trashcan, 'tmp';
    * File globbing.
    * Use of <> in array contexts returns the whole file or glob list.
    * New iterator for normal arrays, foreach, that allows both read and write.
    * Ability to open pipe to a forked off script for secure pipes in setuid scripts.
    * File inclusion via do 'foo.pl';
    * More file tests, including -t to see if, for instance, stdin is a terminal. File tests now behave in a more correct manner. You can do file tests on filehandles as well as filenames. The special filetests -T and -B test a file to see if it's text or binary.
    * An eof can now be used on each file of the <> input for such purposes as resetting the line numbers or appending to each file of an inplace edit.
    * Assignments can now function as lvalues, so you can say things like ($HOST = $host) =~ tr/a-z/A-Z/; ($obj = $src) =~ s/\.c$/.o/;
    * You can now do certain file operations with a variable which holds the name of a filehandle, e.g. open(++$incl,$includefilename); $foo = <$incl>;
    * Warnings are now available (with -w) on use of uninitialized variables and on identifiers that are mentioned only once, and on reference to various undefined things.
    * There is now a wait operator.
    * There is now a sort operator.
    * The manual is now not lying when it says that perl is generally faster than sed. I hope.

1 files changed, 63 insertions, 18 deletions

diff --git a/x2p/a2py.c b/x2p/a2py.c
index c99504046a..3adbd65fd3 100644
--- a/x2p/a2py.c
+++ b/x2p/a2py.c
@@ -1,11 +1,8 @@
-/* $Header: a2py.c,v 1.0.1.1 88/01/28 11:07:08 root Exp $
+/* $Header: a2py.c,v 2.0 88/06/05 00:15:41 root Exp $
  *
  * $Log:	a2py.c,v $
- * Revision 1.0.1.1  88/01/28  11:07:08  root
- * patch8: added support for FOO=bar switches using eval.
- * 
- * Revision 1.0  87/12/18  17:50:33  root
- * Initial revision
+ * Revision 2.0  88/06/05  00:15:41  root
+ * Baseline version 2.0.
  * 
  */
 
@@ -14,6 +11,8 @@ char *index();
 
 char *filename;
 
+int checkers = 0;
+
 main(argc,argv,env)
 register int argc;
 register char **argv;
@@ -116,7 +115,10 @@ register char **env;
     /* second pass to produce new program */
 
     tmpstr = walk(0,0,root,&i);
-    str = str_make("#!/bin/perl\n\n");
+    str = str_make("#!/usr/bin/perl\neval \"exec /usr/bin/perl -S $0 $*\"\n\
+    if $running_under_some_shell;\n\
+			# this emulates #! processing on NIH machines.\n\
+			# (remove #! line above if indigestible)\n\n");
     str_cat(str,
       "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;\n");
     str_cat(str,
@@ -133,6 +135,13 @@ register char **env;
 #endif
     fixup(str);
     putlines(str);
+    if (checkers) {
+	fprintf(stderr,
+	  "Please check my work on the %d line%s I've marked with \"#???\".\n",
+		checkers, checkers == 1 ? "" : "s" );
+	fprintf(stderr,
+	  "The operation I've selected may be wrong for the operand types.\n");
+    }
     exit(0);
 }
 
@@ -214,6 +223,7 @@ yylex()
 	XTERM(tmp);
     case '~':
 	s++;
+	yylval = string("~",1);
 	XTERM(MATCHOP);
     case '+':
     case '-':
@@ -284,6 +294,10 @@ yylex()
     case '>':
 	s++;
 	tmp = *s++;
+	if (tmp == '>') {
+	    yylval = string(">>",2);
+	    XTERM(GRGR);
+	}
 	if (tmp == '=') {
 	    yylval = string(">=",2);
 	    XTERM(RELOP);
@@ -537,7 +551,31 @@ register char *s;
     default:
 	fatal("Search pattern not found:\n%s",str_get(linestr));
     }
-    s = cpytill(tokenbuf,s,s[-1]);
+
+    d = tokenbuf;
+    for (; *s; s++,d++) {
+	if (*s == '\\') {
+	    if (s[1] == '/')
+		*d++ = *s++;
+	    else if (s[1] == '\\')
+		*d++ = *s++;
+	}
+	else if (*s == '[') {
+	    *d++ = *s++;
+	    do {
+		if (*s == '\\' && s[1])
+		    *d++ = *s++;
+		if (*s == '/' || (*s == '-' && s[1] == ']'))
+		    *d++ = '\\';
+		*d++ = *s++;
+	    } while (*s && *s != ']');
+	}
+	else if (*s == '/')
+	    break;
+	*d = *s;
+    }
+    *d = '\0';
+
     if (!*s)
 	fatal("Search pattern not terminated:\n%s",str_get(linestr));
     s++;
@@ -562,18 +600,22 @@ register char *s;
     case '1': case '2': case '3': case '4': case '5':
     case '6': case '7': case '8': case '9': case '0' : case '.':
 	d = tokenbuf;
-	while (isdigit(*s) || *s == '_')
-	    *d++ = *s++;
-	if (*s == '.' && index("0123456789eE",s[1]))
-	    *d++ = *s++;
-	while (isdigit(*s) || *s == '_')
-	    *d++ = *s++;
-	if (index("eE",*s) && index("+-0123456789",s[1]))
+	while (isdigit(*s)) {
 	    *d++ = *s++;
-	if (*s == '+' || *s == '-')
+	}
+	if (*s == '.' && index("0123456789eE",s[1])) {
 	    *d++ = *s++;
-	while (isdigit(*s))
+	    while (isdigit(*s)) {
+		*d++ = *s++;
+	    }
+	}
+	if (index("eE",*s) && index("+-0123456789",s[1])) {
 	    *d++ = *s++;
+	    if (*s == '+' || *s == '-')
+		*d++ = *s++;
+	    while (isdigit(*s))
+		*d++ = *s++;
+	}
 	*d = '\0';
 	yylval = string(tokenbuf,0);
 	break;
@@ -728,7 +770,7 @@ int maybe;
 	return 0;
     else if ((ops[arg].ival & 255) != OBLOCK)
 	return oper2(OBLOCK,arg,maybe);
-    else if ((ops[arg].ival >> 8) != 2)
+    else if ((ops[arg].ival >> 8) < 2)
 	return oper2(OBLOCK,ops[arg+1].ival,maybe);
     else
 	return arg;
@@ -841,12 +883,15 @@ putone()
 	if (*t == 127) {
 	    *t = ' ';
 	    strcpy(t+strlen(t)-1, "\t#???\n");
+	    checkers++;
 	}
     }
     t = tokenbuf;
     if (*t == '#') {
 	if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
 	    return;
+	if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
+	    return;
     }
     fputs(tokenbuf,stdout);
 }