Index: ossp-pkg/eperl/ChangeLog RCS File: /v/ossp/cvs/ossp-pkg/eperl/ChangeLog,v rcsdiff -q -kk '-r1.10' '-r1.11' -u '/v/ossp/cvs/ossp-pkg/eperl/ChangeLog,v' 2>/dev/null --- ChangeLog 2000/07/03 08:34:54 1.10 +++ ChangeLog 2000/07/03 09:05:26 1.11 @@ -12,6 +12,7 @@ Changes between 2.2.14 and 2.3.0 -------------------------------- + 20000703 o merged in latest WML 2.0.2 ePerl changes 20000703 o upgraded to new GNU shtool 1.5.0 20000501 o upgraded to new GNU shtool 1.4.9 970811 o Fixed stringEQn() defines in eperl_global.h Index: ossp-pkg/eperl/Makefile.in RCS File: /v/ossp/cvs/ossp-pkg/eperl/Makefile.in,v rcsdiff -q -kk '-r1.6' '-r1.7' -u '/v/ossp/cvs/ossp-pkg/eperl/Makefile.in,v' 2>/dev/null --- Makefile.in 2000/07/03 08:39:02 1.6 +++ Makefile.in 2000/07/03 09:05:26 1.7 @@ -43,24 +43,18 @@ libsubdir = @libsubdir@ libdir = $(prefix)/lib$(libsubdir) mandir = $(prefix)/man/man1 - +tmpdir = @tmpdir@ # ------------------------------------------------ # THE RELEASE STUFF (MACROS) # ------------------------------------------------ _GETDISTINFO = \ - _version=`$(SHTOOL) version -l c -d short eperl_version.c`; \ - _date=`date '+%y%m%d_%H%M'` + _version=`$(SHTOOL) version -lc -dshort eperl_version.c` _BUILDDIST = \ - echo "Creating tarball..."; \ - gtar --no-recursion -cvf - `find * -depth -print | sort` | grep -v CVS | grep -v .cvsignore \ - tardy --user_number=1000 --user_name=rse \ - --group_number=1000 --group_name=en \ - --prefix=$${_distname} - |\ - gzip >$${_tarball}; \ - echo "Done"; \ + $(SHTOOL) tarball -o $${_tarball} -d $${_distname} -u rse -g eperl \ + -e 'CVS,\.cvsignore,\.configure,\.\#.*,\.[ao]$$' -c 'gzip --best' . ls -l $${_tarball} _NEWVERS = \ @@ -85,7 +79,7 @@ # THE DEFAULT TARGET # ------------------------------------------------ -all: config eperl eperl.1 +all: eperl eperl.1 # ------------------------------------------------ @@ -111,18 +105,18 @@ release: distclean fixperm @$(_GETDISTINFO); \ _distname="eperl-$${_version}"; \ - _tarball="/tmp/$${_distname}.tar.gz"; \ + _tarball="$(tmpdir)/$${_distname}.tar.gz"; \ echo "Release Distribution: ePerl Version $$_version"; \ $(_BUILDDIST); \ - mv /tmp/$${_distname}.tar.gz $${_distname}.tar.gz + mv $(tmpdir)/$${_distname}.tar.gz $${_distname}.tar.gz snap: distclean fixperm @$(_GETDISTINFO); \ - _distname="eperl-$${_version}-SNAP-$${_date}"; \ - _tarball="/tmp/$${_distname}.tar.gz"; \ - echo "Snap of whole source tree: ePerl Version $$_version as of $${_date}"; \ + _distname="eperl-$${_version}-SNAP"; \ + _tarball="$(tmpdir)/$${_distname}.tar.gz"; \ + echo "Snap of whole source tree: ePerl Version $$_version"; \ $(_BUILDDIST); \ - mv /tmp/$${_distname}.tar.gz $${_distname}.tar.gz + mv $(tmpdir)/$${_distname}.tar.gz $${_distname}.tar.gz new-version: @V="$(VERSION)"; \ @@ -188,9 +182,7 @@ eperl: $(OBJS) $(CC) $(LDFLAGS) -o eperl $(OBJS) $(LDLIBS) $(dmalloc) - @if [ "x$(debug)" = xoff ]; then \ - strip eperl; \ - fi + @[ "x$(debug)" = xon ] || strip eperl eperl_main.o: eperl_main.c $(CC) $(CFLAGS) -c eperl_main.c @@ -261,7 +253,7 @@ ./etc/mkproto eperl_proto.h $(PROTO_SRCS) fixperm: - ./etc/fixperm * + $(SHTOOL) fixperm * # ------------------------------------------------ @@ -270,12 +262,12 @@ eperl.1: eperl.pod eperl_version.c V=`$(SHTOOL) version -l c -d short eperl_version.c`; \ - sed -e "s|\@V\@|$$V|g" -e "s|\@prefix\@|$(prefix)|" /tmp/eperl.pod; \ + sed -e "s|\@V\@|$$V|g" -e "s|\@prefix\@|$(prefix)|" $(tmpdir)/eperl.pod; \ pod2man --section=1 \ --center="Ralf S. Engelschall" \ --release="EN" \ - /tmp/eperl.pod >eperl.1 && \ - rm -f /tmp/eperl.pod + $(tmpdir)/eperl.pod >eperl.1 && \ + rm -f $(tmpdir)/eperl.pod # ------------------------------------------------ @@ -309,6 +301,7 @@ # TEST SUITE # ------------------------------------------------ +check: test test: @cd t; make test @@ -337,24 +330,15 @@ -rm -f libeperl.a -rm -f core *.core -realclean: - -rm -f $(OBJS) - -rm -f eperl - -rm -f $(SOBJS) - -rm -f libeperl.a - -rm -f core *.core +realclean: clean -rm -f eperl_perl5_sm.h -rm -f eperl.1 -rm -f eperl_readme.[ch] -rm -f eperl_license.[ch] distclean: - -rm -f $(OBJS) - -rm -f eperl - -rm -f $(SOBJS) - -rm -f libeperl.a - -rm -f core *.core -rm -f eperl_perl5_sm.h + -rm -f eperl.1 eperl-*.tar.gz -rm -f config_ac.h config_sc.h -rm -f config.status config.cache config.log -rm -f Makefile Index: ossp-pkg/eperl/eperl_sys.c RCS File: /v/ossp/cvs/ossp-pkg/eperl/eperl_sys.c,v co -q -kk -p'1.6' '/v/ossp/cvs/ossp-pkg/eperl/eperl_sys.c,v' | diff -u /dev/null - -L'ossp-pkg/eperl/eperl_sys.c' 2>/dev/null --- ossp-pkg/eperl/eperl_sys.c +++ - 2024-05-02 16:40:17.391503061 +0200 @@ -0,0 +1,438 @@ +/* +** ____ _ +** ___| _ \ ___ _ __| | +** / _ \ |_) / _ \ '__| | +** | __/ __/ __/ | | | +** \___|_| \___|_| |_| +** +** ePerl -- Embedded Perl 5 Language +** +** ePerl interprets an ASCII file bristled with Perl 5 program statements +** by evaluating the Perl 5 code while passing through the plain ASCII +** data. It can operate both as a standard Unix filter for general file +** generation tasks and as a powerful Webserver scripting language for +** dynamic HTML page programming. +** +** ====================================================================== +** +** Copyright (c) 1996,1997,1998 Ralf S. Engelschall +** +** This program is free software; it may be redistributed and/or modified +** only under the terms of either the Artistic License or the GNU General +** Public License, which may be found in the ePerl source distribution. +** Look at the files ARTISTIC and COPYING or run ``eperl -l'' to receive +** a built-in copy of both license files. +** +** This program is distributed in the hope that it will be useful, but +** WITHOUT ANY WARRANTY; without even the implied warranty of +** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the +** Artistic License or the GNU General Public License for more details. +** +** ====================================================================== +** +** eperl_sys.c -- ePerl system functions +*/ + +#include "eperl_config.h" +#include "eperl_global.h" +#include "eperl_proto.h" + + +/* +** +** own setenv() function which works with Perl +** +*/ + +extern char **environ; + +char **mysetenv(char **env, char *var, char *str, ...) +{ + va_list ap; + char ca[1024]; + char ca2[1024]; + char *cp; + int i; + char **envN; + static int stillcalled = FALSE; + int replaced = FALSE; + + /* create the key=val string */ + va_start(ap, str); + vsprintf(ca, str, ap); + va_end(ap); + sprintf(ca2, "%s=%s", var, ca); + cp = strdup(ca2); + + /* now duplicate the old structure */ + for (i = 0; env[i] != NULL; i++) + ; + if ((envN = (char **)malloc(sizeof(char *) * (i+2))) == NULL) + return environ; + for (i = 0; env[i] != NULL; i++) { + if (!replaced && (strncmp(env[i], var, strlen(var)) == 0)) { + envN[i] = cp; + replaced = TRUE; + } + else + envN[i] = env[i]; + } + + /* add the new entry if not replaced */ + if (!replaced) + envN[i++] = cp; + envN[i] = NULL; + + /* set the libc/exec variable which Perl uses */ + if (stillcalled) + free(environ); + stillcalled = TRUE; + environ = envN; + + return envN; +} + + +/* +** +** I/O handle redirection +** +*/ + +#define HANDLE_STDIN 0 +#define HANDLE_STDOUT 1 +#define HANDLE_STDERR 2 +#define HANDLE_STORE_STDIN 10 +#define HANDLE_STORE_STDOUT 11 +#define HANDLE_STORE_STDERR 12 + +static int IO_redirected_stdin = FALSE; +static int IO_redirected_stdout = FALSE; +static int IO_redirected_stderr = FALSE; + +void IO_redirect_stdin(FILE *fp) +{ + if (IO_redirected_stdin) + IO_restore_stdin(); + + /* first copy the current stdin to the store handle */ + (void)dup2(HANDLE_STDIN, HANDLE_STORE_STDIN); + + /* then copy the new handle to stdin */ + (void)dup2(fileno(fp), HANDLE_STDIN); + + /* and remember the fact */ + IO_redirected_stdin = TRUE; +} + +void IO_redirect_stdout(FILE *fp) +{ + if (IO_redirected_stdout) + IO_restore_stdout(); + + /* first copy the current stdout to the store handle */ + (void)dup2(HANDLE_STDOUT, HANDLE_STORE_STDOUT); + + /* then copy the new handle to stdout */ + (void)dup2(fileno(fp), HANDLE_STDOUT); + + /* and remember the fact */ + IO_redirected_stdout = TRUE; +} + +void IO_redirect_stderr(FILE *fp) +{ + if (IO_redirected_stderr) + IO_restore_stderr(); + + /* first copy the current stderr to the store handle */ + (void)dup2(HANDLE_STDERR, HANDLE_STORE_STDERR); + + /* then copy the new handle to stderr */ + (void)dup2(fileno(fp), HANDLE_STDERR); + + /* and remember the fact */ + IO_redirected_stderr = TRUE; +} + +int IO_is_stdin_redirected(void) +{ + return IO_redirected_stdin; +} + +int IO_is_stdout_redirected(void) +{ + return IO_redirected_stdout; +} + +int IO_is_stderr_redirected(void) +{ + return IO_redirected_stderr; +} + +void IO_restore_stdin(void) +{ + if (IO_redirected_stdin) { + dup2(HANDLE_STORE_STDIN, HANDLE_STDIN); + IO_redirected_stdin = FALSE; + } +} + +void IO_restore_stdout(void) +{ + if (IO_redirected_stdout) { + dup2(HANDLE_STORE_STDOUT, HANDLE_STDOUT); + IO_redirected_stdout = FALSE; + } +} + +void IO_restore_stderr(void) +{ + if (IO_redirected_stderr) { + dup2(HANDLE_STORE_STDERR, HANDLE_STDERR); + IO_redirected_stderr = FALSE; + } +} + + +/* +** +** Temporary filename support +** +*/ + +static char *mytmpfiles[100] = { NULL }; +static int mytmpfilecnt = 0; + +char *mytmpfile(char *id) +{ + char ca[1024]; + char *cp, *tmpdir; + int i; + + if ((tmpdir = getenv("TMPDIR")) == NULL) + tmpdir = "/tmp"; + sprintf(ca, "%s/%s.%d.tmp%d", tmpdir, id, (int)getpid(), mytmpfilecnt++); + cp = strdup(ca); + for (i = 0; mytmpfiles[i] != NULL; i++) + ; + mytmpfiles[i++] = cp; + mytmpfiles[i] = NULL; + return cp; +} + +void remove_mytmpfiles(void) +{ + int i; + + for (i = 0; mytmpfiles[i] != NULL; i++) { + unlink(mytmpfiles[i]); + } +} + + +/* +** +** ISO time +** +*/ + +char *isotime(time_t *t) +{ + struct tm *tm; + char timestr[128]; + + tm = localtime(t); + sprintf(timestr, "%02d-%02d-%04d %02d:%02d", + tm->tm_mday, tm->tm_mon+1, tm->tm_year+1900, + tm->tm_hour, tm->tm_min); + return strdup(timestr); +} + + +/* +** +** 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"); + stcpy(tmpfile, 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; +} + +/* +** +** 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; +} + +/* +** +** path support +** +*/ + +char *filename(char *path) +{ + static char file[MAXPATHLEN]; + char *cp; + + if (path[strlen(path)-1] == '/') + return ""; + else { + for (cp = path+strlen(path); cp > path && *(cp-1) != '/'; cp--) + ; + if (cp == path+1) + cp--; + strcpy(file, cp); + return file; + } +} + +char *dirname(char *path) +{ + static char dir[MAXPATHLEN]; + char *cp; + + if (path[strlen(path)-1] == '/') + return path; + else { + strcpy(dir, path); + for (cp = dir+strlen(dir); cp > dir && *(cp-1) != '/'; cp--) + ; + *cp = NUL; + return dir; + } +} + +char *abspath(char *path) +{ + static char apath[MAXPATHLEN]; + static char cwd[MAXPATHLEN]; + char *cp; + + if (path[0] == '/') + return path; + else { + /* remember current working dir */ + getcwd(cwd, MAXPATHLEN); + /* determine dir of path */ + cp = dirname(path); + chdir(cp); + getcwd(apath, MAXPATHLEN); + /* restore cwd */ + chdir(cwd); + /* add file part again */ + if (apath[strlen(apath)-1] != '/') + strcpy(apath+strlen(apath), "/"); + strcpy(apath+strlen(apath), path); + return apath; + } +} + +/*EOF*/