Re: embedded perl and top_env problem

[p5sagit/p5-mst-13.2.git] / x2p / a2py.c

diff --git a/x2p/a2py.c b/x2p/a2py.c
index bfdf6f0..46ec604 100644 (file)
--- a/x2p/a2py.c
+++ b/x2p/a2py.c
@@ -1,32 +1,36 @@
-/* $Header: a2py.c,v 4.0 91/03/20 01:57:26 lwall Locked $
+/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       a2py.c,v $
- * Revision 4.0  91/03/20  01:57:26  lwall
- * 4.0 baseline.
- * 
  */
 
-#ifdef MSDOS
-#include "../patchlev.h"
+#ifdef OS2
+#include "../patchlevel.h"
 #endif
 #include "util.h"
-char *index();
 
 char *filename;
 char *myname;
 
 int checkers = 0;
+
+int oper0();
+int oper1();
+int oper2();
+int oper3();
+int oper4();
+int oper5();
 STR *walk();
 
-#ifdef MSDOS
+#ifdef OS2
+static void
 usage()
 {
-    printf("\nThis is the AWK to PERL translator, version 3.0, patchlevel %d\n", PATCHLEVEL);
+    printf("\nThis is the AWK to PERL translator, version 5.0, patchlevel %d\n", PATCHLEVEL);
     printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname);
     printf("\n  -D<number>      sets debugging flags."
            "\n  -F<character>   the awk script to translate is always invoked with"
@@ -38,13 +42,14 @@ usage()
     exit(1);
 }
 #endif
+
+int
 main(argc,argv,env)
 register int argc;
 register char **argv;
 register char **env;
 {
     register STR *str;
-    register char *s;
     int i;
     STR *tmpstr;
 
@@ -82,7 +87,7 @@ register char **env;
            break;
        default:
            fatal("Unrecognized switch: %s\n",argv[0]);
-#ifdef MSDOS
+#ifdef OS2
             usage();
 #endif
        }
@@ -92,7 +97,7 @@ register char **env;
     /* open script */
 
     if (argv[0] == Nullch) {
-#ifdef MSDOS
+#ifdef OS2
        if ( isatty(fileno(stdin)) )
            usage();
 #endif
@@ -151,16 +156,15 @@ register char **env;
     /* second pass to produce new program */
 
     tmpstr = walk(0,0,root,&i,P_MIN);
-    str = str_make("#!");
+    str = str_make(STARTPERL);
+    str_cat(str, "\neval 'exec ");
     str_cat(str, BIN);
-    str_cat(str, "/perl\neval \"exec ");
-    str_cat(str, BIN);
-    str_cat(str, "/perl -S $0 $*\"\n\
+    str_cat(str, "/perl -S $0 ${1+\"$@\"}'\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");
+      "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;\n");
     str_cat(str,
       "                        # process any FOO=bar switches\n\n");
     if (do_opens && opens) {
@@ -192,6 +196,7 @@ register char **env;
 
 int idtype;
 
+int
 yylex()
 {
     register char *s = bufptr;
@@ -201,7 +206,7 @@ yylex()
   retry:
 #ifdef YYDEBUG
     if (yydebug)
-       if (index(s,'\n'))
+       if (strchr(s,'\n'))
            fprintf(stderr,"Tokener at %s",s);
        else
            fprintf(stderr,"Tokener at %s\n",s);
@@ -213,6 +218,12 @@ yylex()
             *s++,filename,line);
        goto retry;
     case '\\':
+       s++;
+       if (*s && *s != '\n') {
+           yyerror("Ignoring spurious backslash");
+           goto retry;
+       }
+       /*FALLSTHROUGH*/
     case 0:
        s = str_get(linestr);
        *s = '\0';
@@ -799,6 +810,8 @@ register char *s;
                *d++ = *s++;
            else if (s[1] == '\\')
                *d++ = *s++;
+           else if (s[1] == '[')
+               *d++ = *s++;
        }
        else if (*s == '[') {
            *d++ = *s++;
@@ -823,6 +836,7 @@ register char *s;
     return s;
 }
 
+void
 yyerror(s)
 char *s;
 {
@@ -843,13 +857,17 @@ register char *s;
        while (isdigit(*s)) {
            *d++ = *s++;
        }
-       if (*s == '.' && index("0123456789eE",s[1])) {
-           *d++ = *s++;
-           while (isdigit(*s)) {
+       if (*s == '.') {
+           if (isdigit(s[1])) {
                *d++ = *s++;
+               while (isdigit(*s)) {
+                   *d++ = *s++;
+               }
            }
+           else
+               s++;
        }
-       if (index("eE",*s) && index("+-0123456789",s[1])) {
+       if (strchr("eE",*s) && strchr("+-0123456789",s[1])) {
            *d++ = *s++;
            if (*s == '+' || *s == '-')
                *d++ = *s++;
@@ -863,8 +881,10 @@ register char *s;
     return s;
 }
 
+int
 string(ptr,len)
 char *ptr;
+int len;
 {
     int retval = mop;
 
@@ -879,6 +899,7 @@ char *ptr;
     return retval;
 }
 
+int
 oper0(type)
 int type;
 {
@@ -892,6 +913,7 @@ int type;
     return retval;
 }
 
+int
 oper1(type,arg1)
 int type;
 int arg1;
@@ -907,6 +929,7 @@ int arg1;
     return retval;
 }
 
+int
 oper2(type,arg1,arg2)
 int type;
 int arg1;
@@ -924,6 +947,7 @@ int arg2;
     return retval;
 }
 
+int
 oper3(type,arg1,arg2,arg3)
 int type;
 int arg1;
@@ -943,6 +967,7 @@ int arg3;
     return retval;
 }
 
+int
 oper4(type,arg1,arg2,arg3,arg4)
 int type;
 int arg1;
@@ -964,6 +989,7 @@ int arg4;
     return retval;
 }
 
+int
 oper5(type,arg1,arg2,arg3,arg4,arg5)
 int type;
 int arg1;
@@ -989,6 +1015,7 @@ int arg5;
 
 int depth = 0;
 
+void
 dump(branch)
 int branch;
 {
@@ -1016,6 +1043,7 @@ int branch;
     }
 }
 
+int
 bl(arg,maybe)
 int arg;
 int maybe;
@@ -1030,6 +1058,7 @@ int maybe;
        return arg;
 }
 
+void
 fixup(str)
 STR *str;
 {
@@ -1055,6 +1084,7 @@ STR *str;
     }
 }
 
+void
 putlines(str)
 STR *str;
 {
@@ -1131,6 +1161,7 @@ STR *str;
     }
 }
 
+void
 putone()
 {
     register char *t;
@@ -1153,6 +1184,7 @@ putone()
     fputs(tokenbuf,stdout);
 }
 
+int
 numary(arg)
 int arg;
 {
@@ -1167,6 +1199,7 @@ int arg;
     return arg;
 }
 
+int
 rememberargs(arg)
 int arg;
 {
@@ -1189,6 +1222,7 @@ int arg;
     return arg;
 }
 
+int
 aryrefarg(arg)
 int arg;
 {
@@ -1203,6 +1237,7 @@ int arg;
     return arg;
 }
 
+int
 fixfargs(name,arg,prevargs)
 int name;
 int arg;
@@ -1241,6 +1276,7 @@ int prevargs;
     return numargs;
 }
 
+int
 fixrargs(name,arg,prevargs)
 char *name;
 int arg;
@@ -1262,7 +1298,6 @@ int prevargs;
 
        sprintf(tmpbuf,"%s:%d",name,prevargs);
        str = hfetch(curarghash,tmpbuf);
-       fprintf(stderr,"Looking for %s\n",tmpbuf);
        if (str && strEQ(str->str_ptr,"*")) {
            if (type == OVAR || type == OSTAR) {
                ops[arg].ival &= ~255;
@@ -1276,4 +1311,3 @@ int prevargs;
     }
     return numargs;
 }
-