/* file intrinsics for S-Lang */
/* Copyright (c) 1992, 1995 John E. Davis
 * All rights reserved.
 *
 * You may distribute under the terms of either the GNU General Public
 * License or the Perl Artistic License.
 */

#include "config.h"
#include "sl-feat.h"

#include <stdio.h>
#include <string.h>

#ifdef __unix__
# include <sys/types.h>
# ifdef HAVE_FCNTL_H
#  include <fcntl.h>
# endif
# ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
# endif
# include <sys/file.h>
#endif

#if defined (__os2__) && defined (__EMX__)
# include <sys/types.h> /* sys/stat.h requires sys/types.h */
#endif /* __os2__ */

#if defined(__BORLANDC__)
# include <io.h>
# include <dir.h>
#endif

#if defined(__WATCOMC__) || (defined (__WIN32__) && !defined(CYGWIN32))
# include <direct.h>
#endif

#if defined(__DECC) && defined(VMS)
# include <unixio.h>
# include <unixlib.h>
#endif

#ifdef VMS
# include <stat.h>
#else
# include <sys/stat.h>
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#ifndef O_RDWR
#ifndef VMS
# include <fcntl.h>
#endif
#endif

#include <errno.h>

#include "slang.h"
#include "_slang.h"

typedef struct
{
   FILE *fp;			       /* kind of obvious */
   char *file;			       /* file name associated with pointer */
#define SL_READ		0x01
#define SL_WRITE	0x02
#define SL_BINARY	0x04
#define SL_INUSE	0x8000
   unsigned int flags;		       /* modes, etc... */
}
SL_File_Table_Type;

static SL_File_Table_Type SL_File_Table[SL_MAX_FILES];

static SL_File_Table_Type *get_free_file_table_entry (void)
{
   SL_File_Table_Type *t = SL_File_Table, *tmax;

   tmax = t + SL_MAX_FILES;
   while (t < tmax)
     {
	if (t->flags == 0) 
	  {
	     memset ((char *) t, 0, sizeof (SL_File_Table_Type));
	     return t;
	  }
	t++;
     }

   return NULL;
}

/* add trailing slash to dir */
static void fixup_dir (char *dir)
{
#ifndef VMS
   int n;

   if ((n = strlen(dir)) > 1)
     {
	n--;
#if defined(IBMPC_SYSTEM)
      if ( dir[n] != '/' && dir[n] != '\\' )
      	strcat(dir, "\\" );
#else
      if (dir[n] != '/' )
      	strcat(dir, "/" );
#endif
     }
#endif /* !VMS */
}

static void slget_cwd (void)
{
   char cwd[1024];
   char *p;

#ifndef HAVE_GETCWD
   p = getwd (cwd);
#else
# if defined (__EMX__)
   p = _getcwd2(cwd, 1022);	       /* includes drive specifier */
# else
   p = getcwd(cwd, 1022);	       /* djggp includes drive specifier */
# endif
#endif
   
   if (p == NULL)
     {
	_SLerrno_errno = errno;
	_SLang_push_null ();
	return;
     }
   
#ifndef VMS
#ifdef __GO32__
   /* You never know about djgpp since it favors unix */
     {
	char ch;
	p = cwd;
	while ((ch = *p) != 0)
	  {
	     if (ch == '/') *p = '\\';
	     p++;
	  }
     }
#endif
   fixup_dir (cwd);
#endif
   SLang_push_string (cwd);
}

static unsigned int file_process_flags (char *mode)
{
   char ch;
   unsigned int flags = 0;

   while (1)
     {
	ch = *mode++;
	switch (ch)
	  {
	   case 'r': flags |= SL_READ;
	     break;
	   case 'w':
	   case 'a':
	   case 'A':
	     flags |= SL_WRITE;
	     break;
	   case '+': flags |= SL_WRITE | SL_READ;
	     break;
	   case 'b': flags |= SL_BINARY;
	     break;
	   case 0:
	     return flags;

	   default:
	     SLang_verror (SL_INVALID_PARM, "File flag %c is not supported", ch);
	     return 0;
	  }
     }
}

/* returns -1 upon failure or returns a handle to file */
static void SLfopen (char *file, char *mode)
{
   FILE *fp;
   SL_File_Table_Type *t;
   unsigned int flags;
   SLang_MMT_Type *mmt;

   fp = NULL;
   t = NULL;
   mmt = NULL;

   if ((NULL == (t = get_free_file_table_entry ()))
       || (0 == (flags = file_process_flags(mode)))
       || (NULL == (fp = fopen(file, mode)))
       || (NULL == (mmt = SLang_create_mmt (SLANG_FILE_PTR_TYPE, (VOID_STAR) t))))
     goto return_error;

   t->fp = fp;
   t->flags = flags;
   fp = NULL;			       /* allow free_mmt to close fp */

   if ((NULL != (t->file = SLang_create_slstring (file)))
       && (0 == SLang_push_mmt (mmt)))
     return;

   /* drop */

   return_error:
   if (fp != NULL) fclose (fp);
   if (mmt != NULL) SLang_free_mmt (mmt);
   (void) _SLang_push_null ();
}

/* returns pointer to file entry if it is open and consistent with
   flags.  Returns NULL otherwise */
static SLang_MMT_Type *pop_fp (unsigned int flags, FILE **fp_ptr)
{
   SL_File_Table_Type *t;
   SLang_MMT_Type *mmt;

   *fp_ptr = NULL;

   if (NULL == (mmt = SLang_pop_mmt (SLANG_FILE_PTR_TYPE)))
     return NULL;

   t = (SL_File_Table_Type *) SLang_object_from_mmt (mmt);
   if ((t->flags & flags)
       && (NULL != (*fp_ptr = t->fp)))
     return mmt;

   SLang_free_mmt (mmt);
   return NULL;
}

int SLang_pop_fileptr (SLang_MMT_Type **mmt, FILE **fp)
{
   if (NULL == (*mmt = pop_fp (0xFFFF, fp)))
     {
#ifdef EBADF
	_SLerrno_errno = EBADF;
#endif
	return -1;
     }

   return 0;
}

static int close_file_type (SL_File_Table_Type *t)
{
   int ret = -1;

   if (t == NULL)
     return -1;

   if (t->fp != NULL)
     {
	if (EOF == fclose (t->fp))
	  _SLerrno_errno = errno;
	else ret = 0;
     }
   if (t->file != NULL) SLang_free_slstring (t->file);
   memset ((char *) t, 0, sizeof (SL_File_Table_Type));
   return ret;
}

static int SLfclose (void)
{
   SLang_MMT_Type *mmt;
   SL_File_Table_Type *t;
   int ret;
   FILE *fp;

   if (NULL == (mmt = pop_fp (0xFFFF, &fp)))
     return -1;

   t = (SL_File_Table_Type *) SLang_object_from_mmt (mmt);

   ret = close_file_type (t);

   t->flags = SL_INUSE;
   SLang_free_mmt (mmt);
   return ret;
}

/* returns number of characters read and pushes the string to the stack.
   If it fails, it returns -1 */
static int SLfgets (void)
{
   char buf[256];
   char *s, *s1;
   register char *b, *bmax;
   register int ch;
   unsigned int len, dlen;
   FILE *fp;
   SLang_MMT_Type *mmt;
   _SLang_Ref_Type *ref;

   if (NULL == (mmt = pop_fp (SL_READ, &fp))) return -1;
   if (-1 == _SLang_pop_ref (&ref))
     {
	SLang_free_mmt (mmt);
	return -1;
     }
   
   s = NULL;
   len = 0;
   b = buf;
   bmax = b + sizeof (buf);

   while (EOF != (ch = getc(fp)))
     {
	if (b == bmax)
	  {
	     if (NULL == (s1 = SLrealloc (s, len + sizeof(buf) + 1)))
	       goto return_error;

	     s = s1;
	     b = buf;
	     strncpy(s + len, b, sizeof(buf));
	     len += sizeof (buf);
	  }
	*b++ = (char) ch;
	if (ch == '\n') break;
     }

   dlen = (unsigned int) (b - buf);
   /* By construction, something has to be in buf, else EOF */
   if (dlen == 0) goto return_error;

   if (NULL == (s1 = SLrealloc (s, len + dlen + 1)))
     goto return_error;

   strncpy(s1 + len, buf, dlen);
   len += dlen;
   s = s1;
   s[len] = 0;

   if ((-1 == SLang_push_malloced_string (s))
       || (-1 == _SLang_deref_assign (ref)))
     goto return_error;
     
   SLang_free_mmt (mmt);
   _SLang_free_ref (ref);
   return (int) len;

   return_error:
   SLfree (s);			       /* NULL ok */
   SLang_free_mmt (mmt);
   _SLang_free_ref (ref);
   return -1;
}

static int SLfputs (void)
{
   SLang_MMT_Type *mmt;
   FILE *fp;
   char *s;
   int ret;

   if (NULL == (mmt = pop_fp (SL_WRITE, &fp)))
     return -1;

   if (SLang_pop_slstring (&s))
     {
	SLang_free_mmt (mmt);
	return -1;
     }

   if (EOF == fputs(s, fp)) ret = -1;
   else ret = (int) strlen (s);

   SLang_free_mmt (mmt);
   SLang_free_slstring (s);
   return ret;
}

static int SLfflush (void)
{
   FILE *fp;
   SLang_MMT_Type *mmt;
   int ret;

   if (NULL == (mmt = pop_fp (SL_WRITE, &fp)))
     return -1;

   if (EOF == fflush (fp)) 
     {
	_SLerrno_errno = errno;	
	ret = -1;
     }   
   else ret = 0;

   SLang_free_mmt (mmt);
   return ret;
}

static int chdir_cmd (char *s)
{
   int ret;

   while (-1 == (ret = chdir (s)))
     {
#ifdef EINTR
	if (errno == EINTR)
	  continue;
#endif
	_SLerrno_errno = errno;
	break;
     }
   return ret;
}

static int mkdir_cmd (char *s, int *mode_ptr)
{
   int ret;
   
   (void) mode_ptr;
   errno = 0;

#if defined (__MSDOS__) && !defined(__GO32__)
# define MKDIR(x,y) mkdir(x)
#else
# if defined (__os2__) && !defined (__EMX__)
#  define MKDIR(x,y) mkdir(x)
# else
#  if defined (__WIN32__) && !defined (CYGWIN32)
#   define MKDIR(x,y) mkdir(x)
#  else
#   define MKDIR mkdir
#  endif
# endif
#endif

   while (-1 == (ret = MKDIR(s, *mode_ptr)))
     {
#ifdef EINTR
	if (errno == EINTR)
	  continue;
#endif
	_SLerrno_errno = errno;
	break;
     }
   return ret;
}

static SLang_Intrin_Fun_Type SLFiles_Name_Table[] =
{
   MAKE_INTRINSIC_SS("fopen", SLfopen, SLANG_VOID_TYPE),
   MAKE_INTRINSIC("fclose", SLfclose, SLANG_INT_TYPE, 0),
   MAKE_INTRINSIC("fgets", SLfgets, SLANG_INT_TYPE, 0),
   MAKE_INTRINSIC("getcwd", slget_cwd, SLANG_VOID_TYPE, 0),
   MAKE_INTRINSIC_SI("mkdir", mkdir_cmd, SLANG_INT_TYPE),
   MAKE_INTRINSIC_S("chdir", chdir_cmd, SLANG_INT_TYPE),
   MAKE_INTRINSIC("fflush", SLfflush, SLANG_INT_TYPE, 0),
   MAKE_INTRINSIC("fputs", SLfputs, SLANG_INT_TYPE, 0),
   SLANG_END_TABLE
};

static void destroy_file_type (unsigned char type, VOID_STAR ptr)
{
   (void) type;
   (void) close_file_type ((SL_File_Table_Type *) ptr);
}

static SLang_MMT_Type *Stdio_Mmts[3];

int SLang_init_slfile (void)
{
   unsigned int i;
   SL_File_Table_Type *s;
   SLang_Class_Type *cl;
   char *names[3];

   if ((-1 == SLadd_intrin_fun_table(SLFiles_Name_Table, "__SLFILE__"))
       || (-1 == _SLerrno_init ()))
     return -1;

   if (NULL == (cl = SLclass_allocate_class ("File_Type")))
     return -1;
   cl->cl_destroy = destroy_file_type;
   if (-1 == SLclass_register_class (cl, SLANG_FILE_PTR_TYPE, sizeof (SL_File_Table_Type), SLANG_CLASS_TYPE_MMT))
     return -1;

   names[0] = "stdin";
   names[1] = "stdout";
   names[2] = "stderr";

   s = SL_File_Table;
   s->fp = stdin;  s->flags = SL_READ;

   s++;
   s->fp = stdout;  s->flags = SL_WRITE;

   s++;
   s->fp = stderr;  s->flags = SL_WRITE|SL_READ;

   s = SL_File_Table;
   for (i = 0; i < 3; i++)
     {
	if (NULL == (s->file = SLang_create_static_slstring (names[i])))
	  return -1;

	if (NULL == (Stdio_Mmts[i] = SLang_create_mmt (SLANG_FILE_PTR_TYPE, (VOID_STAR) s)))
	  return -1;
	SLang_inc_mmt (Stdio_Mmts[i]);

	if (-1 == SLadd_intrinsic_variable (s->file, (VOID_STAR)&Stdio_Mmts[i], SLANG_FILE_PTR_TYPE, 1))
	  return -1;
	s++;
     }

   if ((-1 == SLang_load_string (".(_NARGS 2 - Sprintf exch fputs)fprintf"))
       || (-1 == SLang_load_string (".(_NARGS 1 - Sprintf stdout fputs)printf")))
     return -1;

   return 0;
}