/* $Header: archimedes.c,v 3.0.1.1 90/03/27 16:10:41 lwall Locked $
 *
 *    (C) Copyright 1989, 1990 Paul Moore.
 *
 *    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.
 *
 * $Log:	archimedes.c,v $
 * Revision 3.0.1.1  90/03/27  16:10:41  lwall
 * patch16: MSDOS support
 * 
 * Revision 1.1  90/03/18  20:32:01  dds
 * Initial revision
 *
 */

/*
 * Various Unix compatibility functions for Archimedes RISC OS.
 */

#include <limits.h>

#include "EXTERN.h"
#include "perl.h"

/*
 * Sleep function.
 */
void
sleep(unsigned len)
{
	time_t end;

	end = time((time_t *)0) + len;
	while (time((time_t *)0) < end)
		;
}

/*
 * Make and remove directories
 */
int
mkdir(char *dir)
{
	int retval = 0;
	int type;
	_kernel_osfile_block blk;

	if ((type = _kernel_osfile(17,dir,&blk)) != 0)
	{
		err_no = 215;
		sprintf(err_mess, "%s '%s' already exists",
			type == 1 ? "File" : "Directory", dir);
		retval = -1;
	}

	blk.start = 0;
	if (_kernel_osfile(8,dir,&blk) == _kernel_ERROR)
	{
		retval = -1;
		save_err();
	}

	return retval;
}

int
rmdir(char *dir)
{
	int retval = 0;
	int type;
	_kernel_osfile_block blk;

	/* Check that it's a directory */
	if ((type = _kernel_osfile(17,dir,&blk)) != 2)
	{
		blk.load = type;
		_kernel_osfile(19,dir,&blk);
		retval = -1;
	}
	else if (_kernel_osfile(6,dir,&blk) == _kernel_ERROR)
	{
		retval = -1;
	}

	if (retval == -1)
		save_err();

	return retval;
}

int
unlink(char *file)
{
	int retval = 0;
	_kernel_osfile_block blk;

	if (_kernel_osfile(6,file,&blk) == _kernel_ERROR)
	{
		save_err();
		retval = -1;
	}

	return retval;
}

/*
 * Set the timestamp for a file
 */
void
stamp (char *file)
{
	_kernel_osfile_block blk;

	_kernel_osfile(9,file,&blk);
}

/*
 * Set environment variables
 */
void
setenv(char *var, char *val)
{
	if (val)
		_kernel_setenv(var,val);
	else
	{
		_kernel_swi_regs regs;

		regs.r[0] = (int)var;
		regs.r[1] = 0;
		regs.r[2] = -1;
		regs.r[3] = 0;
		regs.r[4] = 0;
		
		_kernel_swi(OS_SetVarVal,&regs,&regs);
	}
}

/*
 * The following code is based on the do_exec and do_aexec functions
 * in file doio.c
 */
int
do_aspawn(really,arglast)
STR *really;
int *arglast;
{
    USE(really);
    return exec_cmdv(0, arglast);
}

int
do_spawn(cmd)
char *cmd;
{
    register STR *str;
    register int status;

    _kernel_setenv("Sys$ReturnCode","0");

    if (*cmd == '\0')
	return 0;

    str = str_make("Call:",5);
    str_cat(str,cmd);
    status = system(str->str_ptr);
    str_free(str);

    if (status == _kernel_ERROR)
	save_err();

    return status;
}

/*
 * Generic exec- or spawn-type command execution.
 */
int
exec_cmdv(chain,arglast)
int chain;
int *arglast;
{
    register STR **st = stack->ary_array;
    register int sp = arglast[1];
    register int items = arglast[2] - sp;
    register char *a;
    register char *arg;
    STR *tmps;
    int quotes;
    int status = 0;

    if (items) {
	st += ++sp;

	/* First, insert "Call:" */
	tmps = str_make("Call:", 5);

	/* Now add the command name */
	str_scat(tmps,*st);

	/* Now add each argument in turn */
	for (--items, ++st; items > 0; --items, ++st) {
	    if (!*st)
		continue;

	    /* Separate with spaces */
	    str_ncat(tmps, " ", 1);

	    arg = str_get(*st);

	    /* Do we need to quote this arg? */
	    quotes = (index(arg,'"') || index(arg,' ') || index(arg,'\t'));

	    if (!quotes)
	    	str_scat(tmps, *st);
	    else {
		str_ncat(tmps, "\"", 1);

		/* Add the argument string, backslashing " and \ */
		while ((a = strpbrk(arg,"\"\\")) != Nullch) {
		    str_ncat(tmps, arg, a - arg);
		    str_ncat(tmps, "\\", 1);
		    str_ncat(tmps, a, 1);
		    arg = a + 1;
		}

		str_cat(tmps, arg);
		str_ncat(tmps, "\"", 1);
	    }
	}

	_kernel_setenv("Sys$ReturnCode","0");
	status = system(str_get(tmps));

	str_free(tmps);

	if (status == _kernel_ERROR)
		save_err();
	else if (chain)
		exit(0);
    }

    return status;
}

/*
 * Execute a new command, based on an argv array
 */
void
execv(cmd,argv)
char *cmd;
char **argv;
{
    register char *a;
    register char *arg;
    STR *tmps;
    int quotes;
    int result;

    /* First, insert "Call:" */
    tmps = str_make("Call:", 5);

    /* Now add the command name */
    str_cat(tmps, cmd);

    /* Now add each argument in turn */
    for (++argv; *argv; ++argv)
    {
	if (!**argv)
	    continue;

	/* Separate with spaces */
	str_ncat(tmps, " ", 1);

	arg = *argv;

	/* Do we need to quote this arg? */
	quotes = (index(arg,'"') || index(arg,' ') || index(arg,'\t'));

	if (!quotes)
	    str_cat(tmps, arg);
	else {
	    str_ncat(tmps, "\"", 1);

	    /* Add the argument string, backslashing " and \ */
	    while ((a = strpbrk(arg,"\"\\")) != Nullch) {
		str_ncat(tmps, arg, a - arg);
		str_ncat(tmps, "\\", 1);
		str_ncat(tmps, a, 1);
		arg = a + 1;
	    }

	    str_cat(tmps, arg);
	    str_ncat(tmps, "\"", 1);
	}
    }

    _kernel_setenv("Sys$ReturnCode","0");

    result = system(str_get(tmps));
    str_free(tmps);

    if (result != _kernel_ERROR)
	exit(0);
    else
	save_err();
}

#define SECS1970 2208988800.0 /* Number of seconds from 1/1/1900 to 1/1/1970 */

/*
 * Get a file's catalogue information
 */
int
stat (char *file, struct stat *buf)
{
	int res;
	_kernel_osfile_block blk;

	res = _kernel_osfile(5,file,&blk);

	if (res == _kernel_ERROR || res == 0)
		return -1;

	buf->st_type = res;
	buf->st_load = blk.load;
	buf->st_exec = blk.exec;
	buf->st_length = blk.start;
	buf->st_attr = blk.end;

	if ((blk.load & 0xFFF00000) != 0xFFF00000)
	{
		buf->st_ftype = -1;
		buf->st_time = 0.0;
		buf->st_utime = 0;
	}
	else
	{
		double n;
		buf->st_ftype = ((blk.load >> 8) & 0xFFF);
		n = (double)((unsigned)(blk.load & 0xFF));
		n *= 4294967296.0;	/* 2^32 */
		n += (double)((unsigned)blk.exec);
		buf->st_time = n;
		n /= 100.0;
		n -= SECS1970;

		if (n < 0.0)
		{
			n = 0.0;
			if (dowarn)
				warn("Timestamp too small in stat (%s): set to %d\n",
					file, n);
		}
		else if (n > (double)UINT_MAX)
		{
			n = (double)UINT_MAX;
			if (dowarn)
				warn("Timestamp too large in stat (%s): set to %d\n",
					file, n);
		}

		buf->st_utime = (time_t)n;
	}

	return 0;
}

/*
 * Scan through the OS variables selected by a pattern
 */
char *
getenvar (char *pat, char **val)
{
	static char buffer[255];
	static char *pattern;
	static char *name_ptr;
	_kernel_swi_regs regs;

	if (pat)
	{
		pattern = pat;
		name_ptr = 0;
	}

	regs.r[0] = (int)pattern;
	regs.r[1] = (int)buffer;
	regs.r[2] = 255;
	regs.r[3] = (int)name_ptr;
	regs.r[4] = 3;

	if (_kernel_swi(OS_ReadVarVal,&regs,&regs))
		return 0;

	name_ptr = (char *)regs.r[3];
	buffer[regs.r[2]] = '\0';

	*val = buffer;
	return name_ptr;
}

/*
 * Save the last OS error return value
 */
void
save_err (void)
{
	_kernel_oserror *err = _kernel_last_oserror();

	if (err)
	{
		err_no = err->errnum;
		strcpy(err_mess, err->errmess);
	}
	else
	{
		err_no = 0;
		strcpy(err_mess, "");
	}
}

/*
 * Get the program start time (as a double)
 */
void os_starttime (double *dp)
{
	int i;
	double tmp;
	unsigned char *time;

	_kernel_swi_regs regs;
	_kernel_oserror *err = _kernel_swi(OS_GetEnv, &regs, &regs);

	if (err)
	{
		err_no = err->errnum;
		strcpy(err_mess, err->errmess);
		*dp = 0.0;
		return;
	}

	time = (unsigned char *) regs.r[2];
	tmp = 0.0;

	for (i = 4; i >= 0; --i)
	{
		tmp *= 256.0;
		tmp += (double)(time[i]);
	}

	*dp = tmp;
}

/* Rename a file. If a simple OS rename fails, the file is copied.
 * This allows renames across filing system boundaries.
 * If the destination filename exists, the function deletes it (even
 * if locked) first.
 * This function does its best to be totally paranoid about errors, and
 * returns failure if the rename does not work.
 * Returns 0 on success, 1 on failure.
 */
int frename(const char *old, const char *new)
{
	register int result;
	register int n;
	FILE *in, *out;
	_kernel_osfile_block blk;
	char buf[BUFSIZ];

	/* Check the new file. If it exists, and is not a directory,
	 * unlock it (if necessary) and delete it.
	 */
	result = _kernel_osfile (17, new, &blk);

	/* If the file is a directory, or an error occurred, return failure */
	if (result == 2 || result == _kernel_ERROR)
		return 1;

	/* If the file exists and is locked, unlock it */
	if (result == 1 && (blk.end & 0x0008) != 0)
	{
		blk.end &= ~0x0008;
		if (_kernel_osfile(4, new, &blk) == _kernel_ERROR)
			return 1;
	}

	/* If the file exists, delete it */
	if (result == 1 && _kernel_osfile(6, new, &blk) == _kernel_ERROR)
		return 1;

	/* Now try a simple OS rename */
	if (rename(old, new) == 0)
		return 0;

	/* No luck. Get the old file attributes (to ensure that it exists,
	 * and is not locked, and for later copying to the new file).
	 */
	result = _kernel_osfile (17, old, &blk);

	/* If the file is not a simple file, or an error occurred,
	 * or the file is locked, return failure.
	 */
	if (result != 1 || (blk.end & 0x0008) != 0)
		return 1;
	
	/* Now prepare to copy the file */
	if ((in = fopen(old, "rb")) == NULL)
		return 1;

	if ((out = fopen(new, "wb")) == NULL)
	{
		fclose(in);
		return 1;
	}

	/* Copy the file */
	while (!feof(in))
	{
		n = fread(buf, 1, BUFSIZ, in);
		if (ferror(in) || fwrite(buf, 1, n, out) != n)
		{
			fclose(in);
			fclose(out);
			remove(new);
			return 1;
		}
	}

	if (ferror(in) || fclose(in) == EOF || ferror(out) || fclose(out) == EOF)
	{
		remove(new);
		return 1;
	}

	/* Now copy the file attributes across, and delete the old
	 * file. Don't worry about errors - they're not too serious,
	 * and it's too late to do much anyway.
	 */
	_kernel_osfile(1, new, &blk);
	_kernel_osfile(6, old, &blk);

	return 0;
}
