/*=====================================================================*/
/*    serrano/prgm/project/bigloo/runtime/Clib/cports.c                */
/*    -------------------------------------------------------------    */
/*    Author      :  Manuel Serrano                                    */
/*    Creation    :  Thu Jul 23 15:34:53 1992                          */
/*    Last change :  Fri Nov 14 17:39:52 2003 (serrano)                */
/*    -------------------------------------------------------------    */
/*    Input ports handling                                             */
/*=====================================================================*/
#include <stdio.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#ifndef _MSC_VER
#   include <dirent.h>
#endif
#include <string.h>
#if( !(defined( NeXT ) && (defined( mc68000 ) || defined( i386 ))) )
#   ifdef HAVE_TERMIO
#      include <termio.h>
#   endif
#endif
#if !defined( sony_news ) && \
    !(defined( NeXT ) && (defined( mc68000 ) || defined( i386 ))) && \
    !defined( _MSC_VER )
#   include <unistd.h>
#endif
#ifndef _MSC_VER
#  include <sys/file.h>
#endif
#include <bigloo.h>
#if( defined( sony_news ) || (defined( NeXT ) && defined( mc68000 )) )
#   include <ctype.h>
#endif

#if POSIX_FILE_OPS
#   include <unistd.h>
#endif

#ifdef _MSC_VER
#   include <io.h>
#   include <windows.h>
#   define pclose _pclose
#   define popen _popen
#   define S_ISDIR( mode ) ((mode & _S_IFDIR) != 0)
#endif

/*---------------------------------------------------------------------*/
/*    isascii                                                          */
/*---------------------------------------------------------------------*/
#if( !defined( isascii ) )
#   define isascii( c ) (!((c) & ~0177))
#endif

/*---------------------------------------------------------------------*/
/*    Global variables                                                 */
/*---------------------------------------------------------------------*/
long default_io_bufsiz;

/*---------------------------------------------------------------------*/
/*    External definitions.                                            */
/*---------------------------------------------------------------------*/
extern obj_t string_to_bstring();
extern obj_t string_to_keyword();
extern obj_t make_input_port( char *, FILE *, obj_t, long );
extern obj_t make_string();

extern long bgl_nb_fread( char *, long , long , FILE * );

#if( !defined( feof ) )
#  define bgl_feof feof
#else
extern int bgl_feof( FILE * );
#endif

/*---------------------------------------------------------------------*/
/*    Prototypes                                                       */
/*---------------------------------------------------------------------*/
static bool_t pipe_name_p( char * );
static char *pipe_name( char * );

/*---------------------------------------------------------------------*/
/*     make_output_port ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
make_output_port( char *name, FILE * file, obj_t kindof ) {
   obj_t new_output_port;

   new_output_port = GC_MALLOC( OUTPUT_PORT_SIZE );

   new_output_port->output_port_t.header = MAKE_HEADER( OUTPUT_PORT_TYPE, 0 );
   new_output_port->output_port_t.file = file;
   new_output_port->output_port_t.name = name;
   new_output_port->output_port_t.kindof = kindof;

   return BGL_HEAP_DEBUG_MARK_OBJ( BREF( new_output_port ) );
}

/*---------------------------------------------------------------------*/
/*    open_output_file ...                                             */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
open_output_file( obj_t name ) {
   FILE *file;
   char *cname= BSTRING_TO_STRING( name );

#if( HAVE_PIPE )
   if( pipe_name_p( cname ) ) {
      if( !(file = popen( pipe_name( cname ), "w" )) )
         return BFALSE;

       return make_output_port( cname, file, KINDOF_PIPE );
   } else
#endif
   {
      if (strcmp( cname, "null:" ) == 0)
#        ifndef _MSC_VER
            cname= "/dev/null";
#        else
            cname= "NUL:";
#        endif

      if( !(file = fopen( cname, "wb" )) )
         return BFALSE;

      return make_output_port( cname, file, KINDOF_FILE) ;
   }
}

/*---------------------------------------------------------------------*/
/*    append_output_file ...                                           */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
append_output_file( obj_t name ) {
   FILE *file;

   if( !(file = fopen( BSTRING_TO_STRING(name), "a+b ")) )
      return BFALSE;

   return make_output_port( BSTRING_TO_STRING(name),
			    file,
			    KINDOF_FILE );
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    open_output_string ...                                           */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
open_output_string() {
   char *buffer;
   obj_t port;

   port = GC_MALLOC( OUTPUT_STRING_PORT_SIZE );

   /* We allocate a buffer filled of zero */
   buffer = BGL_HEAP_DEBUG_MARK_STR(
      (char *)(GC_MALLOC_ATOMIC(OUTPUT_STRING_PORT_BUFFER_SIZE + 1)) );
   bzero( buffer, OUTPUT_STRING_PORT_BUFFER_SIZE + 1 );

   port->output_string_port_t.header = MAKE_HEADER(OUTPUT_STRING_PORT_TYPE, 0);
   port->output_string_port_t.buffer = buffer;
   port->output_string_port_t.size = OUTPUT_STRING_PORT_BUFFER_SIZE;
   port->output_string_port_t.offset = 0;

   return BGL_HEAP_DEBUG_MARK_OBJ( BREF( port ) );
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    get_output_string ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
get_output_string( obj_t port ) {
   if( OUTPUT_STRING_PORTP(port) ) {
      if( OUTPUT_STRING_PORT(port).size == 0 )
	 return make_string( 0, ' ' );
      else
	 return string_to_bstring_len( OUTPUT_STRING_PORT(port).buffer,
				       OUTPUT_STRING_PORT(port).offset);
   } else {
      C_FAILURE( "get-output-string", "Not a string port", port );
      return BUNSPEC;
   }
}

/*---------------------------------------------------------------------*/
/*    close_output_port ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
close_output_port( obj_t port ) {
   if( OUTPUT_STRING_PORTP(port) ) {
      obj_t res;

      /* dont reset the output buffer otherwise, in multihtreaded */
      /* environments we could have one core dump because of a    */
      /* thread writing to a port while another one is closing    */
      /* port.                                                    */
      res = string_to_bstring_len( OUTPUT_STRING_PORT(port).buffer,
				   OUTPUT_STRING_PORT(port).offset );
      OUTPUT_PORT(port).kindof = KINDOF_CLOSED;
/* 	 OUTPUT_STRING_PORT(port).buffer = 0L;                         */
/* 	 OUTPUT_STRING_PORT(port).size = 0;                            */

      return res;
   } else {
      /* We do not close console ports (e.g. stdout, stderr) */
      switch( (long)(OUTPUT_PORT(port).kindof) ) {
	 case (long)KINDOF_FILE:
	    OUTPUT_PORT(port).kindof = KINDOF_CLOSED;
	    fclose( OUTPUT_PORT(port).file );
	    break;

#if( HAVE_PIPE )
	 case (long)KINDOF_PROCPIPE:
	    OUTPUT_PORT(port).kindof = KINDOF_CLOSED;
	    fclose( OUTPUT_PORT(port).file );
	    break;

	 case (long)KINDOF_PIPE:
	    OUTPUT_PORT(port).kindof = KINDOF_CLOSED;
	    pclose( OUTPUT_PORT(port).file );
	    break;
#endif

	 case (long)KINDOF_CLOSED:
	    break;
      }

      return port;
   }
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    make_input_port ...                                              */
/*---------------------------------------------------------------------*/
obj_t
make_input_port( char *name, FILE * file, obj_t kindof, long bufsiz ) {
   obj_t new_input_port;

   /* An input port cannot be allocated as an atomic object    */
   /* because it holds a buffer and a name that are GC objects */
   new_input_port = GC_MALLOC( INPUT_PORT_SIZE );

   new_input_port->input_port_t.header = MAKE_HEADER( INPUT_PORT_TYPE, 0 );
   new_input_port->input_port_t.kindof = kindof;
   new_input_port->input_port_t.name = name;
   new_input_port->input_port_t.file = file;
   new_input_port->input_port_t.filepos = 0;
   new_input_port->input_port_t.bufsiz = bufsiz;
   new_input_port->input_port_t.eof = 0;
   new_input_port->input_port_t.matchstart = 0;
   new_input_port->input_port_t.matchstop = 0;
   new_input_port->input_port_t.forward = 0;
   new_input_port->input_port_t.abufsiz = 1;
   new_input_port->input_port_t.lastchar = '\n';
   new_input_port->input_port_t.syseof = bgl_feof;

   switch( (long)kindof ) {
     case (long)KINDOF_CONSOLE:
     case (long)KINDOF_SOCKET:
     case (long)KINDOF_PIPE:
     case (long)KINDOF_PROCPIPE:
	new_input_port->input_port_t.sysread = (int (*)())bgl_nb_fread;
	break;

     case (long)KINDOF_FILE:
	new_input_port->input_port_t.sysread = (int (*)())fread;
	break;

     case (long)KINDOF_PROCEDURE:
	/* do nothing (sysread, will be set by calling function) */
	break;

     default:
	new_input_port->input_port_t.sysread = (int (*)())fread;
     }


   if( bufsiz > 0 ) {
      new_input_port->input_port_t.buffer = BGL_HEAP_DEBUG_MARK_STR(
	 (unsigned char *)GC_MALLOC_ATOMIC(bufsiz + 1) );
      new_input_port->input_port_t.buffer[ 0 ] = '\0';
   } else
      new_input_port->input_port_t.buffer = '\0';

   return BGL_HEAP_DEBUG_MARK_OBJ( BREF( new_input_port ) );
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    open_input_pipe ...                                              */
/*---------------------------------------------------------------------*/
obj_t
open_input_pipe( obj_t name, obj_t bbufsiz ) {
#if( HAVE_PIPE )
   FILE *file;
   char *cname = BSTRING_TO_STRING( name );

   if( !(file = popen( cname, "r" )) )
      return BFALSE;

   setvbuf( file, NULL, _IONBF, 0 );  /* we use our own buffer */

   return make_input_port( (char *)cname, file, KINDOF_PIPE, CINT(bbufsiz) );
#else
   return BFLASE;
#endif
}

/*---------------------------------------------------------------------*/
/*    open_input_file ...                                              */
/*    -------------------------------------------------------------    */
/*    !!! WARNING !!! WARNING !!! WARNING !!! WARNING !!! WARNING !!!  */
/*    We fill up its associated buffer when opening an input port.     */
/*    -------------------------------------------------------------    */
/*    This function open two kind of files. Regular file and Unix      */
/*    like pipes when the file name is something like "| ...".         */
/*---------------------------------------------------------------------*/
obj_t
open_input_file( obj_t name, obj_t bbufsiz ) {
   FILE *file;
   char *cname = BSTRING_TO_STRING( name );

#if( HAVE_PIPE )
   if( pipe_name_p( cname ) ) {
      if( !(file = popen( pipe_name( cname ), "r" ) ) )
	 return BFALSE;

      setvbuf( file, NULL, _IONBF, 0 );  /* we use our own buffer */

      return make_input_port( cname, file, KINDOF_PIPE,
			      CINT( bbufsiz ) );
   } else
#endif
   {
      if (strcmp( cname, "null:" ) == 0)
#        ifndef _MSC_VER
            cname= "/dev/null";
#        else
            cname= "NUL:";
#        endif

      if( !(file = fopen( cname, "rb" )) )
         return BFALSE;

      setvbuf( file, NULL, _IONBF, 0 );  /* we use our own buffer */

      return make_input_port( cname, file, KINDOF_FILE, CINT( bbufsiz ) );
   }
}

/*---------------------------------------------------------------------*/
/*    open_input_console ...                                           */
/*---------------------------------------------------------------------*/
obj_t
open_input_console() {
   return make_input_port( "[stdin]", stdin, KINDOF_CONSOLE,
			   default_io_bufsiz );
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    file_to_buffered_input_port ...                                  */
/*---------------------------------------------------------------------*/
obj_t
file_to_buffered_input_port( FILE * file, long bufsize ) {
   if (file == stdin)
      return open_input_console();
   else {
      long bsize = bufsize <= 0 ? default_io_bufsiz : bufsize;

      return make_input_port( "[file]", file, KINDOF_FILE, bsize );
   }
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    file_to_input_port ...                                           */
/*---------------------------------------------------------------------*/
obj_t
file_to_input_port( FILE * file ) {
   return file_to_buffered_input_port( file, -1 );
}

/*---------------------------------------------------------------------*/
/*    open_input_string ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
open_input_string( obj_t string ) {
   obj_t port;
   long bufsiz = STRING_LENGTH( string );

   port = make_input_port( "[string]", 0L, KINDOF_STRING, bufsiz + 1 );

   CREF(port)->input_port_t.eof = 1;
   CREF(port)->input_port_t.abufsiz = bufsiz + 1;
   memcpy( &RGC_BUFFER(port)[ 0 ], BSTRING_TO_STRING(string), bufsiz );
   RGC_BUFFER(port)[ bufsiz ] = '\0';

   return port;
}

/*---------------------------------------------------------------------*/
/*    static int                                                       */
/*    input_procedure ...                                              */
/*    -------------------------------------------------------------    */
/*    uses the 5. parameter: data                                      */
/*---------------------------------------------------------------------*/
static int
input_procedure( unsigned char *buffer,
		 int s,
		 int n,
		 FILE *pair,
		 unsigned char **data ) {

   /* we cast back to obj_t */
   obj_t port = CAR( (obj_t )pair );
   obj_t p = CDR( (obj_t )pair );
   obj_t o = PROCEDURE_ENTRY( p )( p, BEOA );

   int size = n * s;

   if( size && CHARP( o ) ) {
      buffer[ 0 ] = CCHAR( o );
      return 1;
   }
   
   if( STRINGP( o ) ) {
      char *s= BSTRING_TO_STRING( o );
      int len= STRING_LENGTH( o );
      if( (len > size) ) {
	 *data = s;
	 return len;
      } else {
	 memcpy( buffer, s, len);
	 return len;
      }
   }
   
   if( EOF_OBJECTP( o ) || (o == BFALSE) ) {
      CREF(port)->input_port_t.eof = 1;
      return 0;
   }
   
   C_FAILURE( "input-procedure-port",
	      "Procedure result must be a string, or a char, or #f, or the eof-object",
	      o );
   return -1;
}

/*---------------------------------------------------------------------*/
/*    open_input_procedure ...                                         */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
open_input_procedure( obj_t fun ) {
   obj_t port;

   port = make_input_port( "[procedure]", 0L, KINDOF_PROCEDURE, default_io_bufsiz);

   CREF( port )->input_port_t.file = MAKE_PAIR( port, fun );

   CREF( port )->input_port_t.sysread = &input_procedure;

   return port;
}


/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    open_input_c_string ...                                          */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
open_input_c_string( char *c_string ) {
   obj_t port;
   long bufsiz = (long)strlen( c_string );
   char *new_string = 0;

   if( bufsiz > 0 )
      new_string = BGL_HEAP_DEBUG_MARK_STR(
	 (char *)GC_MALLOC_ATOMIC(bufsiz + 1) );

   strcpy( new_string, c_string );

   port = make_input_port( "[c_string]", 0L, KINDOF_STRING, 0 );

   CREF(port)->input_port_t.eof = 1;
   CREF(port)->input_port_t.bufsiz = bufsiz + 1;
   CREF(port)->input_port_t.abufsiz = bufsiz + 1;
   CREF(port)->input_port_t.buffer = (unsigned char *)new_string;

   return port;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    reopen_input_c_string ...                                        */
/*    -------------------------------------------------------------    */
/*    Simply changes the input buffer of an input string. Does not     */
/*    re-allocate a brand new input-port.                              */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
reopen_input_c_string( obj_t port, char *c_string ) {
   long bufsiz = (long)strlen(c_string);

   if( CREF(port)->input_port_t.bufsiz < (bufsiz + 1) ) {
      CREF(port)->input_port_t.bufsiz = bufsiz + 1;
      CREF(port)->input_port_t.buffer =
	 (unsigned char *)BGL_HEAP_DEBUG_MARK_STR(
	    (char *)GC_MALLOC_ATOMIC(bufsiz + 1));
   }

   CREF(port)->input_port_t.abufsiz = bufsiz + 1;
   CREF(port)->input_port_t.matchstart = 0;
   CREF(port)->input_port_t.matchstop = 0;
   CREF(port)->input_port_t.forward = 0;
   CREF(port)->input_port_t.lastchar = '\n';
   strcpy( (char *)(CREF(port)->input_port_t.buffer), (char *)c_string );

   return port;
}

/*---------------------------------------------------------------------*/
/*    close_input_port ...                                             */
/*    -------------------------------------------------------------    */
/*    This function does erase the RGC_BUFFER otherwise we could       */
/*    have a problem in multithreaded environment (a thread reading    */
/*    while another one is closing the same port).                     */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
close_input_port( obj_t port ) {
   if( INPUT_PORTP( port ) ) {
      /* We do not close the console port */
      switch( (long)(INPUT_PORT( port ).kindof) ) {

	 case (long)KINDOF_FILE:
	 case (long)KINDOF_SOCKET:
	    INPUT_PORT( port ).kindof = KINDOF_CLOSED;
	    INPUT_PORT( port ).eof = 1;
/* 	    RGC_BUFFER( port ) = 0L;                                   */
	    fclose( (FILE *)INPUT_PORT( port ).file );
	    break;

#if( HAVE_PIPE )
	 case (long)KINDOF_PROCPIPE:
	    INPUT_PORT( port ).kindof = KINDOF_CLOSED;
	    INPUT_PORT( port ).eof = 1;
/* 	    RGC_BUFFER( port ) = 0L;                                   */
	    fclose( (FILE *)INPUT_PORT( port ).file );
	    break;

	 case (long)KINDOF_PIPE:
	    INPUT_PORT( port ).kindof = KINDOF_CLOSED;
	    INPUT_PORT( port ).eof = 1;
/* 	    RGC_BUFFER( port ) = 0L;                                   */
	    pclose( (FILE *)INPUT_PORT( port ).file );
	    break;
#endif

	 case (long)KINDOF_PROCEDURE:
	    INPUT_PORT( port ).kindof = KINDOF_CLOSED;
	    INPUT_PORT( port ).eof = 1;
/* 	    RGC_BUFFER( port ) = 0L;                                   */
	    break;

	 case (long)KINDOF_STRING:
	    INPUT_PORT( port ).kindof = KINDOF_CLOSED;
	    break;

	 case (long)KINDOF_CLOSED:
	 case (long)KINDOF_CONSOLE:
	    break;

	 default:
	    C_FAILURE( "close-input-port", "unknown input-port type", port );
	    break;
      }
   }

   return port;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    bgl_input_port_seek ...                                          */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
bgl_input_port_seek( obj_t port, long pos ) {
   if( INPUT_PORT_ON_FILEP( port ) ) {
      if( fseek( INPUT_PORT( port ).file, pos, SEEK_SET ) )
	 return BFALSE;
      INPUT_PORT( port ).filepos = pos;
      INPUT_PORT( port ).eof = 0;
      INPUT_PORT( port ).matchstart = 0;
      INPUT_PORT( port ).matchstop = 0;
      INPUT_PORT( port ).forward = 0;
      INPUT_PORT( port ).abufsiz = 1;
      INPUT_PORT( port ).lastchar = '\n';
      INPUT_PORT( port ).buffer[0] = '\0';

      return BTRUE;
   }

   if( INPUT_PORT_ON_STRINGP( port ) && (pos < INPUT_PORT( port ).bufsiz) ) {
      INPUT_PORT( port ).filepos = pos;
      INPUT_PORT( port ).matchstart = pos;
      INPUT_PORT( port ).matchstop = pos;
      INPUT_PORT( port ).forward = pos;

      return BTRUE;
   }

   return BFALSE;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    bgl_output_port_seek ...                                         */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
bgl_output_port_seek( obj_t port, long pos ) {
   if( OUTPUT_FILE_PORTP( port ) ) {
      if( fseek( OUTPUT_PORT(port).file, pos, SEEK_SET ) )
	 return BFALSE;
      return BTRUE;
   }
   if( OUTPUT_STRING_PORTP( port ) ) {
      if( pos >= OUTPUT_STRING_PORT( port ).size )
	 return BFALSE;

      OUTPUT_STRING_PORT( port ).offset = pos;
      return BTRUE;
   }
   return BFALSE;
}
   
/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    bgl_input_port_reopen ...                                        */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
bgl_input_port_reopen( obj_t port ) {
   FILE *nf;
   
   if( !INPUT_PORT_ON_FILEP( port ) )
      return BFALSE;

   nf = freopen( INPUT_PORT( port ).name, "r", (FILE *)INPUT_PORT(port).file );

   if( !nf ) return BFALSE;
   
   INPUT_PORT( port ).file = (void *)nf;
      
   /* we use our own buffer */
   setvbuf( (FILE *)INPUT_PORT( port ).file, NULL, _IONBF, 0 );

   INPUT_PORT( port ).filepos = 0;
   INPUT_PORT( port ).eof = 0;
   INPUT_PORT( port ).matchstart = 0;
   INPUT_PORT( port ).matchstop = 0;
   INPUT_PORT( port ).forward = 0;
   INPUT_PORT( port ).abufsiz = 1;
   INPUT_PORT( port ).lastchar = '\n';
   INPUT_PORT( port ).buffer[ 0 ] = '\0';

   return BTRUE;
}

/*---------------------------------------------------------------------*/
/*    obj                                                              */
/*    reset_console ...                                                */
/*    -------------------------------------------------------------    */
/*    We flush input port, for ^C to work correctly within the         */
/*    interpreter. The only place this function is called is in the    */
/*    REPL (see Eva/eval.scm).                                         */
/*---------------------------------------------------------------------*/
obj_t
reset_console( obj_t port ) {
   if( INPUT_PORT( port ).kindof == KINDOF_CONSOLE ) {
      INPUT_PORT( port ).matchstart = 0;
      INPUT_PORT( port ).matchstop = 0;
      INPUT_PORT( port ).abufsiz = 1;
      INPUT_PORT( port ).buffer[ 0 ] = '\0';
      INPUT_PORT( port ).lastchar = '\n';
   }

   return BUNSPEC;
}

/*---------------------------------------------------------------------*/
/*     bgl_init_io ...                                                 */
/*---------------------------------------------------------------------*/
void
bgl_init_io() {
#if( !defined( _SBFSIZ ) )
#   define _SBFSIZ 1
#endif

   default_io_bufsiz = BUFSIZ * _SBFSIZ;

   BGL_CURRENT_OUTPUT_PORT_SET(
      make_output_port("stdout", stdout, KINDOF_CONSOLE) );
   BGL_CURRENT_ERROR_PORT_SET(
      make_output_port("stderr", stderr, KINDOF_CONSOLE) );
   BGL_CURRENT_INPUT_PORT_SET(
      open_input_console() );
}

/*---------------------------------------------------------------------*/
/*    fexists ...                                                      */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
fexists( char *name ) {
#if( HAVE_PIPE )
   if( pipe_name_p( name ) ) {
      return 1;
   }
#else
   if( pipe_name_p(name) ) {
      return 0;
   }
#endif

# ifndef _MSC_VER
    return !access( name, F_OK );
# else
    /* !!!!! verify semantics of Unix' access */
    return !_access( name, 0 );        
# endif
}

/*---------------------------------------------------------------------*/
/*    bool_t                                                           */
/*    reset_eof ...                                                    */
/*    -------------------------------------------------------------    */
/*    The function erase the end-of-file of input console port.        */
/*    This allows, restart reading after a ^D.                         */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
reset_eof( obj_t port ) {
   if( INPUT_PORT( port ).kindof == KINDOF_CONSOLE ) {
      /* we forget about EOF */
      INPUT_PORT( port ).eof = 0;

      /* we cleanup buffer   */
      reset_console( port );

      /* we clear errors.    */
      clearerr( stdin );

      return 1;
   }
   else
      return 0;
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    strport_flush ...                                                */
/*    -------------------------------------------------------------    */
/*    On flush un string port.                                         */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
strport_flush( obj_t port ) {
   obj_t res;

   if( OUTPUT_STRING_PORT(port).buffer ) {
      res = string_to_bstring( OUTPUT_STRING_PORT(port).buffer );

      OUTPUT_STRING_PORT(port).offset = 0;
      OUTPUT_STRING_PORT(port).buffer[ 0 ] = 0;
      
      return res;
   } else {
      return string_to_bstring( "" );
   }
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    strport_grow ...                                                 */
/*---------------------------------------------------------------------*/
obj_t
strport_grow( obj_t p ) {
   long old_size, new_size;
   char *old_buffer, *new_buffer;

   old_buffer = OUTPUT_STRING_PORT(p).buffer;
   old_size = OUTPUT_STRING_PORT(p).size;

   if( old_size == 0 ) {
      C_FAILURE( "string-port", "port closed", p );

      return p;
   } else {
      new_size = old_size * 2;
      new_buffer = BGL_HEAP_DEBUG_MARK_STR(
	 /* FIXME realloc? */
	 (char *)(GC_MALLOC_ATOMIC(new_size + 1)) );
      memcpy( new_buffer, old_buffer, old_size );
      new_buffer[ old_size ] ='\0';

      OUTPUT_STRING_PORT(p).buffer = new_buffer;
      OUTPUT_STRING_PORT(p).size = new_size;

      return p;
   }
}

/*---------------------------------------------------------------------*/
/*    static bool_t                                                    */
/*    pipe_name_p ...                                                  */
/*    -------------------------------------------------------------    */
/*    Is a file name a pipe name ? A pipe name start by the            */
/*    sequence "| ".                                                   */
/*---------------------------------------------------------------------*/
static bool_t
pipe_name_p( char *name ) {
   return( (name[ 0 ] == '|') && (name[ 1 ] == ' ') );
}

/*---------------------------------------------------------------------*/
/*    char *                                                           */
/*    pipe_name ...                                                    */
/*    -------------------------------------------------------------    */
/*    Pipe name to name translation.                                   */
/*---------------------------------------------------------------------*/
static char *
pipe_name( char *pipe_name ) {
   return (pipe_name + 1);
}

/*---------------------------------------------------------------------*/
/*    bool_t                                                           */
/*    directoryp ...                                                   */
/*    -------------------------------------------------------------    */
/*    Is a file a directory?                                           */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
bool_t
directoryp( char *name ) { 
   struct stat buf;

   if( stat( name, &buf ) == -1 )
      return 0;

   return S_ISDIR( buf.st_mode & S_IFMT );
}

/*---------------------------------------------------------------------*/
/*    obj_t                                                            */
/*    directory_to_list ...                                            */
/*---------------------------------------------------------------------*/
BGL_RUNTIME_DEF
obj_t
directory_to_list( char *name ) {
   obj_t res = BNIL;
#ifndef _MSC_VER
   DIR *dir;
   struct dirent *dirent;

   if( (dir = opendir( name )) ) {
      while( (dirent = readdir( dir )) ) {
	 char *fname = dirent->d_name;

	 if( strcmp( fname, "." ) && strcmp( fname, ".." ) )
	    res = MAKE_PAIR( string_to_bstring( fname ), res );
      }
      closedir( dir );
   }
#else
   char *const path= (char *)malloc( strlen( name ) + 2 + 1 );

   strcpy( path, name );
   strcat( path, "\\*" );

   {
      WIN32_FIND_DATA find_data;
      HANDLE hSearch = FindFirstFile( path, &find_data );

      if( hSearch != INVALID_HANDLE_VALUE ) {
         BOOL keep_going;

         do {
            if( (strcmp( find_data.cFileName, "." ) != 0)
                && (strcmp( find_data.cFileName, ".." ) != 0) )
               res = MAKE_PAIR( string_to_bstring( find_data.cFileName ),
				res );
            keep_going= FindNextFile( hSearch, &find_data );
         } while( keep_going );

         FindClose( hSearch );
      }
   }
#endif
   return res;
}

/*---------------------------------------------------------------------*/
/*    bgl_sendchars ...                                                */
/*    -------------------------------------------------------------    */
/*    uses sendfile to "copy" the input-port to the output-port        */
/*    flushes output-port!                                             */
/*---------------------------------------------------------------------*/
obj_t
bgl_sendchars( obj_t inport, obj_t outport, int size ) {
   /* we suppose that FILE* has no buffer! */
   struct input_port inp = (INPUT_PORT( inport));
   struct output_port outp = (OUTPUT_PORT( outport));
   int resultat;
   int data_size;

#if( !BGL_HAVE_SENDFILE )
   return BFALSE;
#else
   {
      struct stat in;
      struct stat out;
      /* first test if bigloo-KINDOF_FILE, then see if fstats succeed */
      /* finally test if input_port is a regular file and output_port */
      /* is either a regular file or a socket                         */
      if( (inp.kindof != KINDOF_FILE) || (outp.kindof != KINDOF_FILE) ||
	  fstat( fileno( (FILE *)inp.file ), &in) ||
	  fstat( fileno( (FILE *)outp.file ), &out) ||
	  !S_ISREG(in.st_mode) ||
	  !(S_ISREG(out.st_mode) || S_ISSOCK(out.st_mode)) ) {
	 return BFALSE;
      }
   }

   data_size = inp.abufsiz - inp.matchstop - 1;

   if( size >= 0 && data_size > size ) {
      return BFALSE;
   }

   fwrite( &(inp.buffer[inp.matchstop]), data_size, 1, (FILE *)outp.file );

   if( ferror( (FILE *)outp.file ) || fflush( (FILE *)outp.file ) ) {
      C_FAILURE( "bgl_sendchars", "output-file error", outport);
      return BFALSE;
   }

   /* buffer is now empty */
   inp.matchstart = 0;
   inp.matchstop = 0;
   inp.forward = 0;
   inp.abufsiz = 1;

   if( size >= 0 ) {
      size -= data_size;
   }

   resultat = sendfile( fileno( outp.file ), fileno( inp.file ), 0,  size );
   if( resultat == -1 ) {
      C_FAILURE( "bgl_sendchars",
		 "sendfile (direct transfer) failed",
		 MAKE_PAIR(inport, outport) );
      return BINT( resultat );
   }
   inp.filepos += resultat + data_size;
   fseek( (FILE *)inp.file, inp.filepos, SEEK_SET );

   return BINT( resultat + data_size );
#endif
}
