/* ** ** read an error file to internal buffer and substitute the filename ** */ char *ePerl_ReadErrorFile(char *filename, char *scriptfile, char *scripturl) { char *rc; FILE *fp = NULL; char *cpBuf = NULL; int nBuf; char *cp; if ((fp = fopen(filename, "r")) == NULL) { ePerl_SetError("Cannot open error file %s for reading", filename); CU(NULL); } fseek(fp, 0, SEEK_END); nBuf = ftell(fp); if ((cpBuf = (char *)malloc(sizeof(char) * nBuf * 2)) == NULL) { ePerl_SetError("Cannot allocate %d bytes of memory", nBuf * 2); CU(NULL); } fseek(fp, 0, SEEK_SET); if (fread(cpBuf, nBuf, 1, fp) == 0) { ePerl_SetError("Cannot read from file %s", filename); CU(NULL); } cpBuf[nBuf] = '\0'; for (cp = cpBuf; cp < cpBuf+nBuf; ) { if ((cp = strstr(cp, scriptfile)) != NULL) { #ifdef HAVE_MEMMOVE (void)memmove(cp+strlen(scripturl), cp+strlen(scriptfile), strlen(cp+strlen(scriptfile))+1); #else (void)bcopy(cp+strlen(scriptfile), cp+strlen(scripturl), strlen(cp+strlen(scriptfile))+1); #endif (void)memcpy(cp, scripturl, strlen(scripturl)); cp += strlen(scripturl); continue; } break; } RETURN_WVAL(cpBuf); CUS: if (cpBuf) free(cpBuf); if (fp) fclose(fp); RETURN_EXRC; }
/* ** convert buffer from bristled format to plain format */ char *ePerl_Bristled2Plain(char *cpBuf) { char *rc; char *cpOutBuf = NULL; char *cpOut = NULL; char *cps, *cpe; char *cps2, *cpe2; int nBuf; char *cpEND; int n; if (strlen(cpBuf) == 0) { /* make sure we return a buffer which the caller can free() */ cpOutBuf = (char *)malloc(sizeof(char) * 1); *cpOutBuf = NUL; return cpOutBuf; } nBuf = strlen(cpBuf); cpEND = cpBuf+nBuf; /* allocate memory for the Perl code */ n = sizeof(char) * nBuf * 10; if (nBuf < 1024) n = 16384; if ((cpOutBuf = (char *)malloc(n)) == NULL) { ePerl_SetError("Cannot allocate %d bytes of memory", n); CU(NULL); } cpOut = cpOutBuf; /* now step through the file and convert it to legal Perl code. This is a bit complicated because we have to make sure that we parse the correct delimiters while the delimiter characters could also occur inside the Perl code! */ cps = cpBuf; while (cps < cpEND) { if (ePerl_case_sensitive_delimiters) cpe = strnstr(cps, ePerl_begin_delimiter, cpEND-cps); else cpe = strncasestr(cps, ePerl_begin_delimiter, cpEND-cps); if (cpe == NULL) { /* there are no more ePerl blocks, so just encapsulate the remaining contents into Perl print constructs */ if (cps < cpEND) { cps2 = cps; /* first, do all complete lines */ while (cps2 < cpEND && (cpe2 = strnchr(cps2, '\n', cpEND-cps2)) != NULL) { if (ePerl_line_continuation && cps < cpe2 && *(cpe2-1) == '\\') { if (cpe2-1-cps2 > 0) { cpOut = ePerl_fprintf(cpOut, "print \""); cpOut = ePerl_Efwrite(cps2, cpe2-1-cps2, 1, cpOut); cpOut = ePerl_fprintf(cpOut, "\";"); } cpOut = ePerl_fprintf(cpOut, "\n"); } else { cpOut = ePerl_fprintf(cpOut, "print \""); cpOut = ePerl_Efwrite(cps2, cpe2-cps2, 1, cpOut); cpOut = ePerl_fprintf(cpOut, "\\n\";\n"); } cps2 = cpe2+1; } /* then do the remainder which is not finished by a newline */ if (cpEND > cps2) { cpOut = ePerl_fprintf(cpOut, "print \""); cpOut = ePerl_Efwrite(cps2, cpEND-cps2, 1, cpOut); cpOut = ePerl_fprintf(cpOut, "\";"); } } break; /* and break the whole processing step */ } else { /* Ok, there is at least one more ePerl block */ /* first, encapsulate the content from current pos up to the begin of the ePerl block as print statements */ if (cps < cpe) { cps2 = cps; while ((cpe2 = strnchr(cps2, '\n', cpe-cps2)) != NULL) { if (ePerl_line_continuation && cps < cpe2 && *(cpe2-1) == '\\') { if (cpe2-1-cps2 > 0) { cpOut = ePerl_fprintf(cpOut, "print \""); cpOut = ePerl_Efwrite(cps2, cpe2-1-cps2, 1, cpOut); cpOut = ePerl_fprintf(cpOut, "\";"); } cpOut = ePerl_fprintf(cpOut, "\n"); } else { cpOut = ePerl_fprintf(cpOut, "print \""); cpOut = ePerl_Efwrite(cps2, cpe2-cps2, 1, cpOut); cpOut = ePerl_fprintf(cpOut, "\\n\";\n"); } cps2 = cpe2+1; } if (cpe > cps2) { cpOut = ePerl_fprintf(cpOut, "print \""); cpOut = ePerl_Efwrite(cps2, cpe-cps2, 1, cpOut); cpOut = ePerl_fprintf(cpOut, "\";"); } } /* just output a leading space to make the -x display more readable. */ if (cpOut > cpOutBuf && *(cpOut-1) != '\n') cpOut = ePerl_fprintf(cpOut, " "); /* skip the start delimiter */ cps = cpe+strlen(ePerl_begin_delimiter); /* recognize the 'print' shortcut with '=', * e.g. <:=$var:> */ if (*cps == '=') { cpOut = ePerl_fprintf(cpOut, "print "); cps++; } /* skip all following whitespaces. Be careful: we could skip newlines too, but then the error output will give wrong line numbers!!! */ while (cps < cpEND) { if (*cps != ' ' && *cps != '\t') break; cps++; } cpe = cps; /* move forward to end of ePerl block. */ if (ePerl_case_sensitive_delimiters) cpe = strnstr(cpe, ePerl_end_delimiter, cpEND-cpe); else cpe = strncasestr(cpe, ePerl_end_delimiter, cpEND-cpe); if (cpe == NULL) { ePerl_SetError("Missing end delimiter"); CU(NULL); } /* step again backward over whitespaces */ for (cpe2 = cpe; cpe2 > cps && (*(cpe2-1) == ' ' || *(cpe2-1) == '\t' || *(cpe2-1) == '\n'); cpe2--) ; /* pass through the ePerl block without changes! */ if (cpe2 > cps) { if (ePerl_convert_entities == TRUE) cpOut = ePerl_Cfwrite(cps, cpe2-cps, 1, cpOut); else cpOut = ePerl_fwrite(cps, cpe2-cps, 1, cpOut); /* be smart and automatically add a semicolon if not provided at the end of the ePerl block. But know the continuation indicator "_". */ if ((*(cpe2-1) != ';') && (*(cpe2-1) != '_') ) cpOut = ePerl_fprintf(cpOut, ";"); if (*(cpe2-1) == '_') cpOut = cpOut - 1; } /* end preserve newlines for correct line numbers */ for ( ; cpe2 <= cpe; cpe2++) if (*cpe2 == '\n') cpOut = ePerl_fprintf(cpOut, "\n"); /* output a trailing space to make the -x display more readable when no newlines have finished the block. */ if (cpOut > cpOutBuf && *(cpOut-1) != '\n') cpOut = ePerl_fprintf(cpOut, " "); /* and adjust the current position to the first character after the end delimiter */ cps = cpe+strlen(ePerl_end_delimiter); /* finally just one more feature: when an end delimiter is directly followed by ``//'' this discards all data up to and including the following newline */ if (cps < cpEND-2 && *cps == '/' && *(cps+1) == '/') { /* skip characters */ cps += 2; for ( ; cps < cpEND && *cps != '\n'; cps++) ; if (cps < cpEND) cps++; /* but preserve the newline in the script */ cpOut = ePerl_fprintf(cpOut, "\n"); } } } RETURN_WVAL(cpOutBuf); CUS: if (cpOutBuf) free(cpOutBuf); RETURN_EXRC; }
/* ** ** read source file into internal buffer ** */ char *ePerl_ReadSourceFile(char *filename, char **cpBufC, int *nBufC) { char *rc; FILE *fp = NULL; char *cpBuf = NULL; int nBuf; char tmpfile[256], *ptr_tmpfile; int usetmp = 0; int c; if (stringEQ(filename, "-")) { /* file is given on stdin */ ptr_tmpfile = mytmpfile("ePerl.source"); sprintf(tmpfile, "%s", ptr_tmpfile); if ((fp = fopen(tmpfile, "w")) == NULL) { ePerl_SetError("Cannot open temporary source file %s for writing", tmpfile); CU(NULL); } nBuf = 0; while ((c = fgetc(stdin)) != EOF) { fprintf(fp, "%c", c); } fclose(fp); fp = NULL; filename = tmpfile; usetmp = 1; } if ((fp = fopen(filename, "r")) == NULL) { ePerl_SetError("Cannot open source file %s for reading", filename); CU(NULL); } fseek(fp, 0, SEEK_END); nBuf = ftell(fp); if (nBuf == 0) { cpBuf = (char *)malloc(sizeof(char) * 1); *cpBuf = NUL; } else { if ((cpBuf = (char *)malloc(sizeof(char) * nBuf+1)) == NULL) { ePerl_SetError("Cannot allocate %d bytes of memory", nBuf); CU(NULL); } fseek(fp, 0, SEEK_SET); if (fread(cpBuf, nBuf, 1, fp) == 0) { ePerl_SetError("Cannot read from file %s", filename); CU(NULL); } cpBuf[nBuf] = '\0'; } *cpBufC = cpBuf; *nBufC = nBuf; RETURN_WVAL(cpBuf); CUS: if (cpBuf) free(cpBuf); if (fp) fclose(fp); if (usetmp) unlink(tmpfile); RETURN_EXRC; }