ossp-pkg/eperl/eperl_sys.c
/*
** ____ _
** ___| _ \ ___ _ __| |
** / _ \ |_) / _ \ '__| |
** | __/ __/ __/ | | |
** \___|_| \___|_| |_|
**
** 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 <rse@engelschall.com>
**
** 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");
strcpy(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*/
