-/* $Header: walk.c,v 3.0.1.6 90/10/16 11:35:51 lwall Locked $
+/* $RCSfile: walk.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 17:33:46 $
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1991, 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: walk.c,v $
- * Revision 3.0.1.6 90/10/16 11:35:51 lwall
- * patch29: a2p mistranslated certain weird field separators
+ * Revision 4.0.1.3 92/06/08 17:33:46 lwall
+ * patch20: in a2p, simplified the filehandle model
+ * patch20: in a2p, made RS="" translate to $/ = "\n\n"
+ * patch20: in a2p, do {...} while ... was missing some reconstruction code
+ * patch20: in a2p, getline should allow variable to be array element
*
- * Revision 3.0.1.5 90/08/09 05:55:01 lwall
- * patch19: a2p emited local($_) without a semicolon
- * patch19: a2p didn't make explicit split on whitespace skip leading whitespace
- * patch19: foreach on a normal array was iterating on values instead of indexes
+ * Revision 4.0.1.2 91/11/05 19:25:09 lwall
+ * patch11: in a2p, split on whitespace produced extra null field
*
- * Revision 3.0.1.4 90/03/01 10:32:45 lwall
- * patch9: a2p didn't put a $ on ExitValue
+ * Revision 4.0.1.1 91/06/07 12:22:04 lwall
+ * patch4: new copyright notice
+ * patch4: a2p didn't correctly implement -n switch
*
- * Revision 3.0.1.3 89/12/21 20:32:35 lwall
- * patch7: in a2p, user-defined functions didn't work on some machines
- *
- * Revision 3.0.1.2 89/11/17 15:53:00 lwall
- * patch5: on Pyramids, index(s, '}' + 128) doesn't find meta-}
- *
- * 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
+ * Revision 4.0 91/03/20 01:58:36 lwall
+ * 4.0 baseline.
*
*/
bool subretnum = FALSE;
bool saw_FNR = FALSE;
bool saw_argv0 = FALSE;
+bool saw_fh = FALSE;
int maxtmp = 0;
char *lparen;
char *rparen;
+char *limit;
STR *subs;
STR *curargs = Nullstr;
type &= 255;
switch (type) {
case OPROG:
+ arymax = 0;
+ if (namelist) {
+ while (isalpha(*namelist)) {
+ for (d = tokenbuf,s=namelist;
+ isalpha(*s) || isdigit(*s) || *s == '_';
+ *d++ = *s++) ;
+ *d = '\0';
+ while (*s && !isalpha(*s)) s++;
+ namelist = s;
+ nameary[++arymax] = savestr(tokenbuf);
+ }
+ }
+ if (maxfld < arymax)
+ maxfld = arymax;
opens = str_new(0);
subs = str_new(0);
str = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
str_cat(str,"chop;\t# strip record separator\n");
tab(str,level);
}
- arymax = 0;
- if (namelist) {
- while (isalpha(*namelist)) {
- for (d = tokenbuf,s=namelist;
- isalpha(*s) || isdigit(*s) || *s == '_';
- *d++ = *s++) ;
- *d = '\0';
- while (*s && !isalpha(*s)) s++;
- namelist = s;
- nameary[++arymax] = savestr(tokenbuf);
- }
- }
- if (maxfld < arymax)
- maxfld = arymax;
if (do_split)
emit_split(str,level);
str_scat(str,fstr);
str_cat(str,"\n\
sub Pick {\n\
local($mode,$name,$pipe) = @_;\n\
- $fh = $opened{$name};\n\
- if (!$fh) {\n\
- $fh = $opened{$name} = 'fh_' . ($nextfh++ + 0);\n\
- open($fh,$mode.$name.$pipe);\n\
- }\n\
+ $fh = $name;\n\
+ open($name,$mode.$name.$pipe) unless $opened{$name}++;\n\
}\n\
");
}
str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec));
str_free(fstr);
numeric |= numarg;
+ if (strEQ(str->str_ptr,"$/ = ''"))
+ str_set(str, "$/ = \"\\n\\n\"");
break;
case OADD:
prec = P_ADD;
if (useval)
str_cat(str,"(");
if (len > 0) {
- str_cat(str,"$");
str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
if (!*fstr->str_ptr) {
- str_cat(str,"_");
+ str_cat(str,"$_");
len = 2; /* a legal fiction */
}
str_free(fstr);
s = savestr(tokenbuf);
for (t = tokenbuf; *t; t++) {
*t &= 127;
+ if (islower(*t))
+ *t = toupper(*t);
if (!isalpha(*t) && !isdigit(*t))
*t = '_';
}
if (!index(tokenbuf,'_'))
- strcpy(t,"_fh");
+ strcpy(t,"_FH");
tmp3str = hfetch(symtab,tokenbuf);
if (!tmp3str) {
do_opens = TRUE;
break;
case OSPLIT:
str = str_new(0);
+ limit = ", 9999)";
numeric = 1;
tmpstr = walk(1,level,ops[node+2].ival,&numarg,P_MIN);
if (useval)
}
else if (saw_FS)
str_cat(str,"$FS");
- else
+ else {
str_cat(str,"' '");
+ limit = ")";
+ }
str_cat(str,", ");
str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
str_free(fstr);
- str_cat(str,", 9999)");
+ str_cat(str,limit);
if (useval) {
str_cat(str,")");
}
s = "\"";
*d++ = *t++ + 128;
switch (*t) {
- case '\\': case '"': case 'n': case 't':
+ case '\\': case '"': case 'n': case 't': case '$':
break;
default: /* hide this from perl */
*d++ = '\\' + 128;
s = savestr(tokenbuf);
for (t = tokenbuf; *t; t++) {
*t &= 127;
+ if (islower(*t))
+ *t = toupper(*t);
if (!isalpha(*t) && !isdigit(*t))
*t = '_';
}
if (!index(tokenbuf,'_'))
- strcpy(t,"_fh");
+ strcpy(t,"_FH");
str_free(tmpstr);
safefree(s);
str_set(str,"close ");
str_cat(str,tokenbuf);
}
else {
- sprintf(tokenbuf,"$fh = delete $opened{%s} && close($fh)",
- tmpstr->str_ptr);
+ sprintf(tokenbuf,"delete $opened{%s} && close(%s)",
+ tmpstr->str_ptr, tmpstr->str_ptr);
str_free(tmpstr);
str_set(str,tokenbuf);
}
s = savestr(tokenbuf);
for (t = tokenbuf; *t; t++) {
*t &= 127;
+ if (islower(*t))
+ *t = toupper(*t);
if (!isalpha(*t) && !isdigit(*t))
*t = '_';
}
if (!index(tokenbuf,'_'))
- strcpy(t,"_fh");
+ strcpy(t,"_FH");
tmp3str = hfetch(symtab,tokenbuf);
if (!tmp3str) {
str_cat(opens,"open(");
str_cat(str,"printf");
else
str_cat(str,"print");
+ saw_fh = 0;
if (len == 3 || do_fancy_opens) {
- if (*tokenbuf)
+ if (*tokenbuf) {
str_cat(str," ");
+ saw_fh = 1;
+ }
str_cat(str,tokenbuf);
}
tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN);
}
if (*tmpstr->str_ptr) {
str_cat(str," ");
- str_scat(str,tmpstr);
+ if (!saw_fh && *tmpstr->str_ptr == '(') {
+ str_cat(str,"(");
+ str_scat(str,tmpstr);
+ str_cat(str,")");
+ }
+ else
+ str_scat(str,tmpstr);
}
else {
str_cat(str," $_");
tmpstr = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
else
tmpstr = str_new(0);;
- if (!*tmpstr->str_ptr) {
+ if (!tmpstr->str_ptr || !*tmpstr->str_ptr) {
if (lval_field) {
t = saw_OFS ? "$," : "' '";
if (split_to_array) {
str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
str_free(fstr);
break;
+ case ODO:
+ str = str_new(0);
+ str_set(str,"do ");
+ str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+ str_free(fstr);
+ if (str->str_ptr[str->str_cur - 1] == '\n')
+ --str->str_cur;;
+ str_cat(str," while (");
+ str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+ str_free(fstr);
+ str_cat(str,");");
+ break;
case OFOR:
str = str_new(0);
str_set(str,"for (");
https://perl5.git.perl.org / perl5.git / blobdiff