From: miker@quasar.ucar.edu (Mike Reetz)
Subject: New version of file_io.mr
Date: Fri, 19 May 1995 10:49:06 -0600 (MDT)

:	"@(#)shar.sh	1.8"
#! /bin/sh
#
#	This is a shell archive.
#	Remove everything above this line and run sh on the resulting file.
#	If this archive is complete, you will see this message at the end:
#	"All files extracted"
#
#	Created: Fri May 19 10:45:09 MDT 1995 by miker at UCAR
#	Files archived in this archive:
#	Makefile
#	README
#	fgiusr.c
#	file_io.1
#	file_io.c
#	file_io_setup.4gl
#	global_defs.4gl
#	global_defs.h
#
#--------------------
if [ -f Makefile -a "$1" != "-c" ]
then echo shar: Makefile already exists
else
echo 'x - Makefile (238 characters)'
sed -e 's/^X//' >Makefile <<'SHAR-EOF'
X
X
Xall: customfglgo customfgldb
X
Xcustomfglgo: fgiusr.c file_io.o
X	cfglgo fgiusr.c $(LDFLAGS) $(LIBS) -o customfglgo
X
Xcustomfgldb: fgiusr.c file_io.o
X	cfgldb fgiusr.c $(LDFLAGS) $(LIBS) -o customfgldb
X
Xfile_io.o:file_io.c
X	cc -c file_io.c
X
SHAR-EOF
if [ `wc -c <Makefile` -ne 238 ]
then echo shar: Makefile unpacked with wrong size
fi
# end of overwriting check
fi
#--------------------
if [ -f README -a "$1" != "-c" ]
then echo shar: README already exists
else
echo 'x - README (64 characters)'
sed -e 's/^X//' >README <<'SHAR-EOF'
XThis is a set of File I/O Routines for Informix 4GL
Xprograms.
X
X
SHAR-EOF
if [ `wc -c <README` -ne 64 ]
then echo shar: README unpacked with wrong size
fi
# end of overwriting check
fi
#--------------------
if [ -f fgiusr.c -a "$1" != "-c" ]
then echo shar: fgiusr.c already exists
else
echo 'x - fgiusr.c (2455 characters)'
sed -e 's/^X//' >fgiusr.c <<'SHAR-EOF'
X/***************************************************************************
X *
X *			   INFORMIX SOFTWARE, INC.
X *
X *			      PROPRIETARY DATA
X *
X *	THIS DOCUMENT CONTAINS TRADE SECRET DATA WHICH IS THE PROPERTY OF 
X *	INFORMIX SOFTWARE, INC.  THIS DOCUMENT IS SUBMITTED TO RECIPIENT IN
X *	CONFIDENCE.  INFORMATION CONTAINED HEREIN MAY NOT BE USED, COPIED OR 
X *	DISCLOSED IN WHOLE OR IN PART EXCEPT AS PERMITTED BY WRITTEN AGREEMENT 
X *	SIGNED BY AN OFFICER OF INFORMIX SOFTWARE, INC.
X *
X *	THIS MATERIAL IS ALSO COPYRIGHTED AS AN UNPUBLISHED WORK UNDER
X *	SECTIONS 104 AND 408 OF TITLE 17 OF THE UNITED STATES CODE. 
X *	UNAUTHORIZED USE, COPYING OR OTHER REPRODUCTION IS PROHIBITED BY LAW.
X *
X *
X *  Title:	fgiusr.c
X *  Sccsid:	@(#)fgiusr.c	7.2	7/8/90  13:50:19
X *  Description:
X *		definition of user C functions
X *
X ***************************************************************************
X */
X
X/***************************************************************************
X *
X * This table is for user-defined C functions.
X *
X * Each initializer has the form:
X *
X *	"name", name, nargs,
X *
X * Variable # of arguments:
X *
X *	set nargs to -(maximum # args)
X *
X * Be sure to declare name before the table and to leave the
X * line of 0's at the end of the table.
X *
X * Example:
X *
X *	You want to call your C function named "mycfunc" and it expects
X *	2 arguments.  You must declare it:
X *
X *		int mycfunc();
X *
X *	and then insert an initializer for it in the table:
X *
X *		"mycfunc", mycfunc, 2,
X *
X ***************************************************************************
X */
X
X#include "fgicfunc.h"
X
Xint openfile();
Xint readchar();
Xint readline();
Xint writechar();
Xint writeline();
Xint closefile();
Xint tmpfilename();
Xint getprocid();
Xint getpprocid();
Xint statfile();
Xint deletefile();
Xint createfile();
Xint purgefile();
Xint fileseek();
Xint renamefile();
Xint filetell();
Xint upshift();
Xint downshift();
X
X
Xcfunc_t usrcfuncs[] = 
X    {
X    "openfile", openfile, 2,
X    "readchar", readchar, 1,
X    "readline", readline, 1,
X    "writechar", writechar, 2,
X    "writeline", writeline, 4,
X    "closefile", closefile, 1,
X    "tmpfilename", tmpfilename, 2,
X    "getprocid", getprocid, 0,
X    "getpprocid", getpprocid, 0,
X    "statfile", statfile, 1,
X    "deletefile", deletefile, 1,
X    "createfile", createfile, 1,
X    "purgefile", purgefile, 1,
X    "fileseek", fileseek, 3,
X    "renamefile", renamefile, 2,
X    "filetell", filetell, 1,
X    0, 0, 0
X    };
SHAR-EOF
if [ `wc -c <fgiusr.c` -ne 2455 ]
then echo shar: fgiusr.c unpacked with wrong size
fi
# end of overwriting check
fi
#--------------------
if [ -f file_io.1 -a "$1" != "-c" ]
then echo shar: file_io.1 already exists
else
echo 'x - file_io.1 (22978 characters)'
sed -e 's/^X//' >file_io.1 <<'SHAR-EOF'
X.\" @(#)file_io.1 1.0 94/05/06 MWR;
X.TH FILE_IO 1 "24 March 1995" "UCAR MIS Toolkit" "UCAR MIS Toolkit"
X.SH NAME
Xfile_io \- File I/O Routines for Informix 4GL
X.SH SYNOPSIS
X.B file_io
Xis a set of routines used to provide file I/O functionality to both
Xcompiled and interpreted 4GL programs.  The routines are outlined
Xbelow.
X.SH SUMMARY OF ROUTINES
X.LP
Xopenfile(charstr filename, int file_flags) RETUNING int file_descriptor
X.LP
Xclosefile(int file_descriptor) RETURNING error_num
X.LP
Xreadchar(int file_descriptor) RETURNING int error_num, char character_read
X.LP
Xreadline(int file_descriptor) RETURNING int error_num, charstr line_read
X.LP
Xwritechar(int file_descriptor, char char_to_write) RETURNING int error_num
X.LP
Xwriteline(int file_descriptor, charstr line_to_write, int str_length, int add_newline) RETURNING int error_num
X.LP
Xtmpfilename(charstr temp_dir_name, charstr tempfile_name_prefix) RETURNING int error_num, charstr temporary_filename
X.LP
Xdeletefile(charstr filename_to_delete) RETURNING int error_num
X.LP
Xstatfile(charstr filename_to_stat) RETURNING int error_num, charstr owner_name, charstr group_name, charstr mode_string, long file_size, int file_type, charstr last_access_time, charstr last_modification_time, charstr last_status_change_time
X.LP
Xcreatefile(charstr filename_to_create) RETURNING int error_num
X.LP
Xpurgefile(charstr filename_to_purge) RETURNING int error_num
X.LP
Xfileseek(int file_descriptor, long offset, int origin) RETURNING int error_num
X.LP
Xrenamefile(charstr orig_file_name, charstr new_file_name) RETURNING int error_num
X.LP
Xfiletell(int file_descriptor) RETURNING long offset
X.LP
Xcopyfile(charstr source_file, charstr destination_file) RETURNING int error_num
X.LP
Xgetprocid() RETURNING int pid
X.LP
Xgetpprocid() RETURNING int ppid
X.LP
X.SH ROUTINES INCLUDED
X.LP
X.SH openfile(charstr filename, int file_flags) RETUNING int file_descriptor
X.LP
X.BR openfile
Xis used to open a file for reading, writing, or both.  The
X.I filename
Xis a character string that represents a valid file name.  This name can be
Xa either a relative or absolute path.  The maximum
X.I filename
Xlength is 1024 characters.  The
X.I file_flags
Xparameter is an integer that indicates what mode to open the file
X.I filename.
X.nf
XThe available modes are:
X	OPENNOMATTERWHAT     50
X	OPENIFEXISTS         51
X	OPENIFNOTEXISTS      52
X	OPENTRUNCATE         53
X	OPENAPPEND           54
X	OPENREADONLY         55
X.fi
XYou can either use the "text" version of these numbers (if you
Xuse the 
X.BR file_io_initialize
Xroutine outlined below or the numeric version.  
X.LP
XThe value returned is an integer.  If the integer is positive (ie >0)
Xthen the 
X.BR openfile
Xcall was successful and the returned value is the file descriptor to be
Xused to reference this file.  If the returned value is negative (ie <0)
Xthen an error occured.  The possible errors returned from 
X.BR openfile
Xare:
X.nf
X	OPENERROR          -1
X	OPENARGERROR       -2
X.fi
X.I OPENERROR
Xindicates that the call to
X.BR openfile
Xfailed for some reason.  This usually indicates that the 
X.I filename
Xwas improperly formed or that if you are using the 
X.I OPENIFEXISTS
Xor
X.I OPENIFNOTEXISTS
Xflags then the file you wish to open either does not exist or
Xit does exist respectively.
X.I OPENARGERROR
Xis returned if the wrong number of paramters is passed to 
X.BR openfile.
X.LP
XThe
X.I OPENNOMATTERWHAT
Xflag tries to open the file
X.I filename.
XThe file is truncated to zero length (if it existed) and the file
Xposition pointer is placed at the beginning of the file.  If the file
Xdid not exist then it is created and the file position pointer is
Xplaced at the beginning of the file.  The
X.I OPENIFEXISTS
Xflag indicates that the file is only to be opened if it already exists.
XIf it exists then the file is opened, the file position pointer is placed
Xat the beginning of the file and a file descriptor to that file is 
Xreturned.  The
X.I OPENIFNOTEXISTS
Xflag performs the same as the
X.I OPENIFEXISTS
Xflag except that it only works for files that do not already exist.  For
Xeach of these flags an
X.I OPENERROR
Xerror is returned if the file does not exist or does already exist respectively.
XThe 
X.I OPENTRUNCATE
Xflag indicates the
X.BR openfile
Xshould try to open the indicated file and truncate it to zero length if it
Xexists.  If it does not exist, then 
X.I OPENERROR
Xis returned.
X.I OPENAPPEND
Xindicates that 
X.BR openfile
Xshould try to open the indicated file and place the file position pointer
Xat the end of the file.  This will only work for files that already exist.
X.I OPENREADONLY
Xindicates that
X.BR openfile
Xshould try to open the indicated file in Read Only mode.
X.I OPENERROR
Xis returned if the file does not already exist.
X.LP
X.SH closefile(int file_descriptor) RETURNING error_num
X.LP
X.BR closefile
Xis used to close a file, flush any buffers associated with that file, and
Xreturn the file descriptor to the list of free file descriptors.  This command
Xeffectively flushes any read/write buffers associated with the file indicated
Xby
X.I file_descriptor
Xand frees the file desciptor.  After a call to
X.BR closefile
Xno other subsequent read/write/seek operations can take place using that
X.I file_descriptor
Xuntil a call to 
X.BR openfile
Xis performed.
X.LP
X.BR closefile
Xreturns one of two values:
X.nf
X	CLOSEERROR    -1
X	CLOSEOK        0
X.fi
X.I CLOSEERROR
Xis returned if there was an error during the closing of the file.  This
Xcould indicate that the 
X.I file_descriptor
Xis invalid or some system error has occured.  
X.I CLOSEOK
Xis returned if the call was successful.
X.LP
X.SH readchar(int file_descriptor) RETURNING int error_num, char character_read
X.SH readline(int file_descriptor) RETURNING int error_num, charstr line_read
X.LP
X.BR readchar
Xallows you to read a single character from the file indicated by
X.I file_descriptor.
X.BR readline
Xallows you read an entire line (delimited by a NEWLINE, ASCII 10 character) from
Xthe file indicated by
X.I file_descriptor.
X.BR readchar
Xor
X.BR readline
Xreturn one of three possible values in addition to the character/line that was read.
XThis value is returned in
X.I error_num
Xand are as follows:
X.nf
X	READERROR   -1
X	READEOF      0
X	READOK       1
X.fi
X.I READERROR
Xindicates that some type of error occured during the 
X.BR readchar
Xor
X.BR readline
Xcall.  If
X.I READERROR
Xis returned then
X.I character_read
Xor
X.I line_read
Xis considered unreliable.  If
X.I READEOF
Xis returned in the
X.I error_num
Xreturn value then this indicates that the end of the file has been reached.  If this
Xoccurs then
X.I character_read
Xor
X.I line_read
Xis likewise considered unreliable.  If
X.I READOK
Xis returned then the read was successful and 
X.I character_read
Xis the next character in the file or
X.I line_read
Xis the next line in the file.  This function also moves the file position
Xpointer forward by one character or moves the file position pointer to the
Xbeginning of the next line.
X.LP
XThe
X.I line_read
Xreturned from
X.BR readline
Xdoes not include the NEWLINE character.
X.LP
XThe maximum line length that
X.BR readline
Xis able to handle is now set to 1024 characters.  If the line read exceeds this, then
Xthe first 1024 characters are returned and the
X.I error_num
Xis set to:
X.nf
X	MAXLINELENREACHED   -50
X.fi
X.LP
X.SH writechar(int file_descriptor, char char_to_write) RETURNING int error_num
X.LP
X.BR writechar
Xallows you to write a single character to the file indicated by
X.I file_descriptor.
X.BR writechar
Xcan return one of two values in 
X.I error_num:
X.nf
X	WRITEERROR    -1
X	WRITEOK        1
X.fi
XIf 
X.I WRITEERROR
Xis returned then some error occured during the
X.BR writechar
Xcall and it is unknown if the
X.I char_to_write
Xwas written to the file indicated by
X.I file_descriptor.
XIf
X.I WRITEOK
Xis returned in
X.I error_num
Xthen it is guaranteed that the 
X.I char_to_write
Xis written to file
X.I file_descriptor
Xif the file is properly closed with
X.BR closefile
X(see above).
X.LP
X.SH writeline(int file_descriptor, charstr line_to_write, 
X.SH    int str_length, int add_newline) RETURNING int error_num
X.LP
X.BR writeline
Xallows you to write an entire string of characters to a file.  As input this function needs a
X.I file_descriptor
Xso it knows what file to write to, a string of characters to write indicated in
X.I line_to_write,
Xthe number of characters to write to the file as indicated in
X.I str_length,
Xand lastly, an indicator as to whether to add a NEWLINE to the end of the
X.I line_to_write
Xor not.  This is done via a TRUE (to add a NEWLINE) or FALSE (do not add a NEWLINE) in
X4GL.
X.LP
XThe returned value is the same as that of
X.BR writechar
X(see above).
X.LP
XThe maximum number of characters that can be written in a single call to
X.BR writeline
Xis 1024.  Like
X.BR writechar,
Xif this is exceeded then the
X.I MAXLINELENREACHED
Xerror is returned and none of the characters are written to the file.
X.LP
XNOTE:  This does not mean that the maximum line length that can be written using this
Xroutine is 1024.  Multiple calls to 
X.BR writeline
Xcan be put together (with only the last one indicating that a NEWLINE should be
Xappended to the line) and a line of >1024 characters could be written.  But, this
Xline would be impossible to be read by
X.BR readline
X(see above).
X.LP
XThe reason that the length of the string must be passed is that strings are passed
Xin unCLIPPED form (ie they are padded with SPACES up to the size of the Informix
Xcharacter string).  The 
X.BR writeline
Xroutine must know how many characters to write.  It can not arbitrarily decide
Xto not write the trailing whitespace or to truncate the string.
X.LP
X.SH tmpfilename(charstr temp_dir_name, charstr tempfile_name_prefix) 
X.SH	RETURNING int error_num, charstr temporary_filename
X.LP
XThe
X.BR tmpfilename
Xroutine returns in
X.I temporary_filename
Xa filename that is unique and unused in directory indicated by
X.I temp_dir_name
Xand with a prefix of
X.I tempfile_name_prefix.
X.LP
X.BR tempfilename
Xcan return the following 
X.I error_num
Xvalues:
X.nf
X	TMPFILENAMEERROR   -1
X	TMPFILENAMEOK       0
X.fi
XIf 
X.I TMPFILENAMEERROR
Xis returned then some error occured during the call to
X.BR tmpfilename
Xand the value returned in
X.I temporary_filename
Xis considered unreliable.  If 
X.I TMPFILENAMEOK
Xis returned then the value returned in
X.I temporary_filename
Xis a filename that is unused and unique.
X.LP
XTo illustrate the use of the parameters an example is best.  Here is a sample call
Xin Informix 4GL and what would be returned barring an error:
X.nf
X	CALL tmpfilename("/var/tmp", "test_file") RETURNING err_num, tmpfilename
X	IF err_num = 0 THEN
X		DISPLAY "Temp File Name is ", tmpfilename CLIPPED
X	END IF
X.fi
X.LP
XThis code snippet might produce something like:
X.nf
X	Temp File Name is /var/tmp/test_fileFa8A2e
X.fi
X.LP
XNotice that the full directory name as given in
X.I temp_dir_name
Xis included and that likewise the 
X.I tempfile_name_prefix
Xis included.  To produce a 
X.I temporary_filename
Xfor the current directory use a
X.I temp_dir_name
Xof "./".
X.LP
X.SH deletefile(charstr filename_to_delete) RETURNING int error_num
X.LP
X.BR deletefile
Xallows you to delete a file from the file system by name.  This name is
Xindicated via
X.I filename_to_delete.
X.LP
X.BR deletefile
Xcan return one of two values in
X.I error_num:
X.nf
X	DELETEFILEERROR   -1
X	DELETEFILEOK       0
X.fi
X.LP
XIf
X.I DELETEFILEERROR
Xis returned then the delete did no occur for some reason.  If 
X.I error_num
Xis 
X.I DELETEFILEOK
Xthen the file deletion was successful.
X.LP
XThe maximum length of the
X.I filename_to_delete
Xis 1024.  
X.LP
X.SH statfile(charstr filename_to_stat) RETURNING int error_num, 
X.SH 	charstr owner_name, charstr group_name, charstr mode_string, 
X.SH 	long file_size, int file_type, charstr last_access_time, 
X.SH 	charstr last_modification_time, charstr last_status_change_time
X.LP
X.BR statfile
Xis used to obtain information about a file.  
X.I filename_to_stat
Xis the name of the file you wish information about (Maximum filename length is
X1024).
X.LP
XThe information returned from a call to 
X.BR statfile
Xis the owner of the file, the group of the file, the mode of the file, 
Xthe size of the file (in bytes), the file type, the last access time, the 
Xlast modification time, and the last status change of the file.  The 
Xformat of the returned values are as follows:
X.nf
X	owner_name              CHAR[8]                  Ex. "root"
X	group_name              CHAR[8]                  Ex. "staff"
X	mode_string             CHAR[3]                  Ex. "644"
X	file_size               INTEGER                  Ex. 10240
X	file_type               INTEGER                  Ex. see below
X	last_access_time        DATETIME Year to second  Ex. 1994-12-31 23:59:59
X	last_modification_time  DATETIME Year to second  Ex. 1994-12-31 23:59:59
X	last_status_change_time DATETIME Year to second  Ex. 1994-12-31 23:59:59
X.fi
XSee stat(2) for more detailed about these returned values.
X.LP
X.I error_num
Xcan return one of two values:
X.nf
X	STATFILEERROR    -1
X	STATFILEOK        0
X.fi
X.LP
XIf 
X.I STATFILEERROR
Xis returned then all other returned values are considered unreliable.  If
X.I STATFILEOK
Xis returned then the returned values can be trusted.
X.LP
XThe values that can be returned in the
X.I file_type
Xvalue are defined as follows:
X.nf
X	FT_PLAINFILE     110
X	FT_DIRECTORY     111
X	FT_BLOCKSPECIAL  112
X	FT_CHARSPECIAL   113
X	FT_FIFO          114
X	FT_SYMLINK       115
X	FT_UNKNOWN       150
X.fi
X.LP
X.I FT_PLAINFILE
Xis defined as any file that is an executable or data.  These files are denoted 
Xin a
X.I ls -l
Xcommand if the initial character of the mode portion of the output is a dash (-).
X.I FT_DIRECTORY
Xis returned if the 
X.I filename_to_stat
Xis a directory.  These files are denotes in a
X.I ls -l
Xcommand if the initial character of the mode portion of the output is a "d".
X.I FT_BLOCKSPECIAL
Xis returned if the
X.I filename_to_stat
Xis a Block Special device.  These files are denoted in the output of a
X.I ls -l
Xcommand if the initial character of the mode portion of the output is a "b".
X.I FT_CHARSPECIAL
Xis returned if the 
X.I filename_to_stat
Xis a Character Special Device.  These file are denoted in the output of a 
X.I ls -l
Xcommand if the initial character of the mode portion of the output is "c".
X.I FT_FIFO
Xis returned is the
X.I filename_to_stat
Xis a FIFO.  These files are  denoted in the output of a
X.I ls -l
Xcommand if the initial character of the mode portion of the output is "p".
X.I FT_SYMLINK
Xis returned is the
X.I filename_to_stat
Xis a Symbolic Link.  These files are  denoted in the output of a
X.I ls -l
Xcommand if the initial character of the mode portion of the output is "l".
X.I FT_UNKNOWN
Xis returned for all other types of files.
X.LP
X.SH createfile(charstr filename_to_create) RETURNING int error_num
X.LP
X.BR createfile
Xis used to create a file with the name indicated in
X.I filename_to_create.
X.BR createfile
Xcan return one of two possible values in
X.I error_num:
X.nf
X	CREATEFILEOK       0
X	CREATEFILEERROR   -1
X.fi
X.I CREATEFILEOK
Xis returned if the file indicated in
X.I filename_to_create
Xwas successfully created.
X.I CREATEFILEERROR
Xis returned if an error occured.  In this case, the file was not created due
Xto possible permission problems, disk out of space, etc.
X.LP
X.SH purgefile(charstr filename_to_purge) RETURNING int error_num
X.LP
X.BR purgefile
Xis used to make an existing file have a zero length, but not delete the file.
X.I filename_to_purge
Xis the name of the file you wish to purge.
X.BR purgefile
Xcan return one of four known error codes in 
X.I error_num:
X.nf
X	FILENOTEXIST       -70
X	FILEACCESSDENIED   -71
X	PURGEFILERROR      -1
X	PURGEFILEOK         0
X.fi
XIn addition to these known return codes others could be returned.  If the code is
Xsomething other than those listed above then the code represents the return code
Xof a stat(2) call on
X.I filename_to_purge.
X.I FILENOTEXIST
Xis returned if the file indicated in
X.I filename_to_purge
Xdoes not exist.
X.I FILEACCESSDENIED
Xis returned if the path and file indicated in
X.I filename_to_purge
Xis inaccessable to the user due to permissions.
X.I PURGEFILEERROR
Xis returned if the truncation procedure failed for some reason.
X.I PURGEFILEOK
Xis returned if the file was properly truncated.
X.LP
X.SH fileseek(int file_descriptor, long offset, int origin) RETURNING int error_num
X.LP
X.BR fileseek
Xis used to move the file position pointer within a file.
X.I file_descriptor
Xis the pointer to the file (as returned by
X.I openfile).
X.I offset
Xis the number of bytes to move the file position pointer within the file.  This number
Xcan be positive or negative.  A positive
X.I offset
Xmoves the file position pointer toward the end of the file while a negative
X.I offset
Xmoves the file position pointer toward the beginning of the file.
X.I origin
Xis a value that indicates where to seek 
X.I offset
Xbytes from.  Possible values are:
X.nf
X	FILE_BEGINNING      0    (SEEK_SET from stdio.h)
X	FILE_CURRENT        1    (SEEK_CUR from stdio.h)
X	FILE_END            2    (SEEK_END from stdio.h)
X.fi
X.LP
X.BR fileseek
Xcan return one of two possible return values:
X.nf
X	FILESEEKERROR       -1
X	FILESEEKOK           0
X.fi
X.I FILESEEKERROR
Xis returned if there was some error during the
X.BR fileseek
Xcall.
X.I FILESEEKOK
Xis returned if the seek was successful.
X.LP
X.BR NOTE:
X.I FILESEEKOK
Xis returned if end of file, or beginning of file is encountered before 
X.I offset
Xnumber of bytes is moved.  If this case, the file position pointer is
Xat either the end of file, of beginning of file.
X.LP
XUsing 
X.BR fileseek
Xyou cannot move the file position pointer past the end of file or before the
Xbeginning of file.
X.LP
XTo move the file position pointer to the beginning of the file use:
X.nf
X.RS
XCALL fileseek(file_descriptor, 0, FILE_BEGINNING) RETURNING ret_code
X.RE
X.fi
XTo move the file position pointer to the end of the file use:
X.nf
X.RS
XCALL fileseek(file_descriptor, 0, FILE_END) RETURNING ret_code
X.RE
X.fi
X.LP
X.SH renamefile(charstr orig_file_name, charstr new_file_name) RETURNING int error_num
X.LP
X.BR renamefile
Xis used to change the name of the file indicated by
X.I orig_file_name
Xto that indicated in
X.I new_file_name.
X.LP
X.BR renamefile
Xcan only rename files within the same UNIX file system.
X.LP
X.BR renamefile
Xcan return one of the two following values in
X.I error_num:
X.nf
X	RENAMEFILEERROR    -1
X	RENAMEFILEOK        0
X.fi
X.I RENAMEFILEERROR
Xindicated that an error occured within the 
X.BR renamefile
Xcall.
X.I RENAMEFILEOK
Xindicates that the file has been renamed successfully.
X.LP
X.SH filetell(int file_descriptor) RETURNING long offset
X.LP
X.BR filetell
Xis used to return the byte 
X.I offset 
Xof the file position pointer for the file indicated by
X.I file_descriptor.
XIf an error occurs then
X.I FILETELLERROR ( -1 )
Xis returned.  If successful then 
X.I offset
Xof the file position pointer is returned.
X.LP
X.SH copyfile(charstr source_file, charstr destination_file) RETURNING int error_num
X.LP
X.BR copyfile
Xis not yet implemented.
X.BR copyfile
Xwill copy the contents of the file indicated by
X.I source_file
Xto the file indicated by
X.I desination_file.
X.LP
X.SH getprocid() RETURNING int pid
X.LP
X.BR getprocid
Xis used to obtain the process ID of the current process.  This value is
Xreturned in
X.I pid.
XNo known error codes can be encountered.
X.LP
X.SH getpprocid() RETURNING int ppid
X.LP
X.BR geptprocid
Xis used to obtain the process ID of the parent process of the current process.  This value is
Xreturned in
X.I ppid.
XNo known error codes can be encountered.
X.LP
X.SH NOTES
X.LP
XTo make use of the "text" version (as opposed to the numeric equivalents) of the options
Xand error codes in your 4GL program you must do the following:
X.LP
XCopy the files
X.I global_defs.4gl
Xand
X.I file_io_setup.4gl
Xto your source area.  In any .4gl file you use one of these "text" equivalents you
Xmust do one of two things:
X.RS
XCopy the contents of global_defs.4gl into the top portion of the file.
X.RS
XOR
X.RE
XInclude the following lines at the top of the file:
X.nf
Xinclude(global_defs.4gl)
X.fi
Xand pre-process the file with the 
X.B m4(1)
Xmacro processor.
X.nf
X
X.fi
X.RE
XYou must include the contents of the file_io_setup.4gl file
Xin ONE of your .4gl file(s).
X.RS
XOR
X.RE
XUse the
X.B m4
Xmacro processor like above.
X.RS
XOR
X.RE
X.BR fglpc 
X.I file_io_setup.4gl 
X(producing file_io_setup.4go) and "link" it in to your .4gi via 
X.BR cat
X.LP 
XAlso, you must call the function
X.I file_io_initialize
Xwith a line like:
X.RS
XCALL file_io_initialize()
X.RE
Xbefore you use any of these "text" equivalents.
X.LP
X.SH EXAMPLES
XHere is some sample code that illustrates the use of some of the file I/O
Xroutines:
X.RS
X.nf
XDATABASE miker
X
X# m4 include
Xinclude(global_defs.4gl)
X
XMAIN
X	DEFINE ret_code INTEGER
X	DEFINE char_read CHAR
X	DEFINE fd INTEGER
X
X	CALL file_io_initialize()
X
X	#
X	# Open a file
X	#
X	CALL openfile("a_test_file", OPENNOMATTERWHAT) RETURNING ret_code
X	IF ret_code != OPENERROR THEN
X		LET fd = ret_code
X		DISPLAY "openfile OK"
X	ELSE
X		DISPLAY "ERROR: openfile failed."
X		EXIT PROGRAM
X	END IF
X
X	#
X	#  Write some chars
X	#
X	CALL writechar(fd, "A") RETURNING ret_code
X	IF ret_code = WRITEOK THEN
X		DISPLAY "Wrote 'A' OK."
X	ELSE
X		DISPLAY "ERROR: Error writing 'A'."
X		EXIT PROGRAM
X	END IF
X
X	CALL writechar(fd, "B") RETURNING ret_code
X	IF ret_code = WRITEOK THEN
X		DISPLAY "Wrote 'B' OK."
X	ELSE
X		DISPLAY "ERROR: Error writing 'B'."
X		EXIT PROGRAM
X	END IF
X
X	CALL writechar(fd, "C") RETURNING ret_code
X	IF ret_code = WRITEOK THEN
X		DISPLAY "Wrote 'C' OK."
X	ELSE
X		DISPLAY "ERROR: Error writing 'C'."
X		EXIT PROGRAM
X	END IF
X
X	#
X	#  Close file
X	#
X	CALL closefile(fd) RETURNING ret_code
X	IF ret_code != CLOSEOK THEN
X		DISPLAY "ERROR: Error in fileclose."
X		EXIT PROGRAM
X	END IF
X
X	#
X	#  Re-open file to test append ability
X	#
X	CALL openfile("a_test_file", OPENAPPEND) RETURNING ret_code
X	IF ret_code != OPENERROR THEN
X		LET fd = ret_code
X		DISPLAY "Open for append OK."
X	ELSE
X		DISPLAY "ERROR: Cannot open for append."
X		EXIT PROGRAM
X	END IF
X
X	#
X	#  Write some more
X	#
X	CALL writechar(fd, "D") RETURNING ret_code
X	IF ret_code = WRITEOK THEN
X		DISPLAY "Wrote 'D' OK."
X	ELSE
X		DISPLAY "ERROR: Error writing 'D'."
X		EXIT PROGRAM
X	END IF
X
X	#
X	#  File seek to Beginning
X	#
X	CALL fileseek(fd, 0, FILE_BEGINNING) RETURNING ret_code
X	IF ret_code != FILESEEKOK THEN
X		DISPLAY "ERROR: Cannot seek to BOF."
X		EXIT PROGRAM
X	END IF
X
X	#
X	#  Read and display until error or enf of file
X	#
X	CALL readchar(fd) RETURNING ret_code, char_read
X	IF ret_code != READOK THEN
X		DISPLAY "ERROR:  Cannot readchar."
X		EXIT PROGRAM
X	END IF
X
X	WHILE ret_code = READOK
X		DISPLAY "We read the following char: ", char_read
X		CALL readchar(fd) RETURNING ret_code, char_read
X	END WHILE
X
X	IF ret_code = READEOF THEN
X		DISPLAY "Reached EOF"
X	ELSE
X		DISPLAY "ERROR:  Error in readchar."
X		EXIT PROGRAM
X	END IF
X
X	CALL closefile(fd) RETURNING ret_code
XEND MAIN
X
X# m4 include
Xinclude(file_io_setup.4gl)
X.fi
X.RE
X.LP
XThe above program was compiled via the following:
X.RS
X.nf
Xm4 t.4gl > t.m4.4gl
Xfglpc t.m4.4gl
Xcat t.m4.4go > t.4gi
X.fi
X.RE
X.SH BUGS
X.LP
X.BR purgefile
Xhas some problems.  It's best not to use this routine.
X.LP
X.BR copyfile
Xis not yet implemented.
X.SH SOURCE
X$SRC/custom_runner
SHAR-EOF
if [ `wc -c <file_io.1` -ne 22978 ]
then echo shar: file_io.1 unpacked with wrong size
fi
# end of overwriting check
fi
#--------------------
if [ -f file_io.c -a "$1" != "-c" ]
then echo shar: file_io.c already exists
else
echo 'x - file_io.c (18137 characters)'
sed -e 's/^X//' >file_io.c <<'SHAR-EOF'
X/***************************************************
X *
X *    Mike's File I/O Routines
X *
X *    Copywrite 1995 by Mike Reetz
X *
X *    Not to be used commercially without this copywrite message.
X *    No claim is made as to the appropriateness of this software.
X *    Use at your own risk.  No waranty is expressed or implied.
X *
X *
X *    ###############################################################
X *
X *
X *    This is a library of file I/O routines modeled after those provided
X *    in most std C environments.  It is suitable for inclusion in compiled
X *    and interpreted 4GL (via a custom runner).
X *    
X *    See the man page file_io.man for more info.
X *    
X *    Here is a list of functions and their args:
X *    
X *    openfile(charstr filename, int file_flags) RETURNING int file_descriptor
X *    closefile(int file_descriptor) RETURNING int error_num
X *    
X *    readchar(int file_descriptor) RETURNING int error_num, char character_read
X *    readline(int file_descriptor) RETURNING int error_num, charstr line_read
X *    
X *    writechar(int file_descriptor, char char_to_write) RETURNING int error_num
X *    writeline(int file_descriptor, charstr line_to_write, int str_length, int add_newline)
X *    	RETURNING int error_num
X *    
X *    tmpfilename(charstr temp_dir_name, charstr tempfile_name_prefix) 
X *    	RETURNING int error_num, charstr temporary_filename
X *    
X *    getprocid() RETURNING int pid
X *    
X *    getpprocid() RETURNING int ppid
X *    
X *    deletefile(charstr filename_to_delete) RETURNING int error_num
X *
X *    statfile(charstr filename_to_stat) 
X *	RETURNING int error_num, 
X *		  charstr owner_name,
X *		  charstr group_name,
X *		  charstr mode_string,			Ex: 664
X *		  long file_size,
X *		  int file_type,			Ex: FT_PLAINFILE, FT_DIRECTORY, etc.
X *		  charstr last_access_time,		Ex: "1994-12-31 23:59:59"
X *		  charstr last_modification_time,	Ex: "1994-12-31 23:59:59"
X *		  charstr last_status_change_time	Ex: "1994-12-31 23:59:59"
X *    
X *    createfile(charstr filename_to_create) RETURNING int error_num
X *
X *    purgefile(charstr filename_to_purge) RETURNING int error_num
X *	(Has a problem....)
X *
X *    fileseek(int file_descriptor, long offset, int origin) RETURNING int error_num
X *
X *    renamefile(charstr orig_file_name, charstr new_file_name) RETURNING int error_num
X *
X *    filetell(int file_descriptor) RETURNING long offset
X *
X *   Mike Reetz (miker) 2/3/94
X *
X *   Rev 1.1
X *	Second version.  All routines done now.
X *
X *   Rev 1.0
X *	Initial version.  Not all routines done.
X *
X ***************************************************/
X
X#include "global_defs.h"
X
X#include <stdio.h>
X#include <fcntl.h>
X#include <sys/mode.h>
X#include <errno.h>
X#include <string.h>
X#include <sys/types.h>
X#include <sys/stat.h>
X#include <pwd.h>		/* Password stuff */
X#include <grp.h>		/* Password stuff */
X
Xextern int errno;
Xextern char *sys_errlist[];
Xextern int sys_nerr;
X
X/***************************************************
X *
X *
X ***************************************************/
Xint openfile(num_args)
Xint num_args;
X	{
X	   /* num_args is the number of args from the
X	    *  4gl program....should be 2 in this case
X	    */
X	   
X	   char filename[1024];
X	   int file_descriptor;
X	   int filename_len;
X	   int filemode;
X	   int fileoflag;
X	   
X	   if (num_args != 2)  {
X    		 retint(WRG_NUMBER_PARMS);
X		 return(1);
X	   }
X	   /* Pop in reverse order */
X	   
X	   /* Pop oflag flags */
X	   popint(&fileoflag);
X	   switch (fileoflag)  {
X		    case OPENNOMATTERWHAT:
X		      fileoflag = (O_CREAT | O_RDWR);
X		      break;
X		    case OPENIFNOTEXISTS:
X		      fileoflag = (O_CREAT | O_EXCL | O_RDWR);
X		      break;
X		    case OPENIFEXISTS:
X		      fileoflag = (O_RDWR);
X		      break;
X		    case OPENTRUNCATE:
X		      fileoflag = (O_TRUNC | O_RDWR);
X		      break;
X		    case OPENAPPEND:
X		      fileoflag = (O_APPEND | O_RDWR);
X		      break;
X		    case OPENREADONLY:
X		      fileoflag = (O_RDONLY);
X		      break;
X		    default:
X		      retint(OPENARGERROR);
X		      return(1);
X	
X	   }
X	   
X	   /* Pop File name */
X	   popquote(filename, 1023);
X
X	   rm_trailing_ws(filename);
X	   
X	   /* Try to open file */
X		 file_descriptor = open(filename, fileoflag, S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
X	   
X	   retint(file_descriptor);
X	   
X	   return(1);
X	}
X
X/***************************************************
X *
X *
X ***************************************************/
Xint readchar(num_args)
Xint num_args;
X	{
X	   /* num_args should be 1 */
X	   
X	   int file_descriptor;
X	   char char_read[2];
X	   int ret_code;
X	   
X	   char_read[0] = NULL;
X	 
X	   if (num_args != 1)  {
X		 retint(WRG_NUMBER_PARMS);
X		 retquote(char_read);
X		 return(2);
X	   }
X	   
X	   /* Pop file descritor */
X	   popint(&file_descriptor);
X	   
X	   /* Read a char */
X	   ret_code = read(file_descriptor, char_read, 1);
X	   
X	   char_read[1] = NULL;        /* NULL terminate char_read */
X	   
X	   /* Push ret_code */
X	   if (ret_code < 0)  {
X		 retint(READERROR);
X	   }
X	   else  {
X		 if (ret_code == 0)  {
X		    retint(READEOF);
X		 }
X		 else  {
X		    retint(READOK);
X		 }
X	   }
X   
X	   /* Push the char we read */
X	   retquote(char_read);
X	   
X	   return(2);
X	}
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint readline(num_args)
Xint num_args;
X	{
X	   int file_descriptor;
X	   char string_read[1024];
X	   int ret_code;
X	   char char_read[2];
X	   int num_chars_read = 0;
X	   
X	   string_read[0] = NULL;
X	   char_read[0] = NULL;
X	   char_read[1] = NULL;
X
X	   /* num_args should be 1 */
X	   if (num_args != 1)  {
X		 retint(WRG_NUMBER_PARMS);
X		 retquote(char_read);
X		 return(1);
X	   }
X	   
X	   /* Pop file descriptor */
X	   popint(&file_descriptor);
X	   
X	   /* Read a char at a time looking for NL */
X	   for (;;)  {
X		 ret_code = read(file_descriptor, char_read, 1);
X		 switch (ret_code)  {
X		    case 1:            /* read OK */
X		       num_chars_read++;
X		       if (num_chars_read > MAXLINELENGTH)  {
X			     retint(MAXLINELENREACHED);
X				retquote(string_read);
X				return(2);
X			  }
X		       if (char_read[0] == '\012')  {
X				/*  Found EOL */
X				retint(READOK);
X				retquote(string_read);
X				return(2);
X			  }
X		       strncat(string_read, char_read, 1);
X		       break;
X		    case 0:             /* EOF */
X		       retint(READEOF);
X		       retquote(string_read);
X		       return(2);
X		       break;
X		    default:            /* Error */
X		       retint(READERROR);
X		       retquote(string_read);
X		       return(2);
X		       break;
X		 }
X	   }
X	}
X
X
X/***************************************************
X *
X *
X ***************************************************/
Xint writechar(num_args)
Xint num_args;
X	{
X	   /* num_args should be 2 */
X	   
X	   char char_to_write[2];
X	   int file_descriptor;
X	   int ret_code;
X	   
X	   if (num_args != 2)  {
X		 retint(WRG_NUMBER_PARMS);
X		 return(1);
X	   }
X	   
X	   /* Pop in reverse order */
X
X	   /* Pop char to write */
X	   popquote(char_to_write, 2);
X	   
X	   /* Pop file descriptor */
X	   popint(&file_descriptor);
X	   
X	   char_to_write[1] = NULL;     /* NULL terminate char_to_write */
X	   
X	   /* Write the char */
X	   ret_code = write(file_descriptor, char_to_write, 1);
X	   
X	   if (ret_code != 1)  {
X		 retint(WRITEERROR);
X	   }
X	   else  {
X		 retint(WRITEOK);
X	   }
X	   
X	   return(1);
X	}
X	   
X		 
X/***************************************************
X *
X *
X ***************************************************/
Xint writeline(num_args)
Xint num_args;
X	{
X	   
X	   int add_nl;
X	   int string_length;
X	   char string_to_write[1024];
X	   int file_descriptor;
X	   int ret_code;
X	   
X	   if (num_args != 4)  {
X		 retint(WRG_NUMBER_PARMS);
X		 return(1);
X	   }
X	   
X	   /* Pop in reverse order */
X	   
X	   /* Pop add_nl */
X	   popint(&add_nl);
X	   
X	   /* Pop string_length */
X	   popint(&string_length);
X	   
X	   if (string_length >= 1024)  {
X		 retint(MAXLINELENREACHED);
X		 return(1);
X	   }
X	   
X	   /* Pop string to write */
X	   popquote(string_to_write, string_length+1);
X
X	   /* Pop file descriptor */
X	   popint(&file_descriptor);
X	   
X	   /* Write the string */
X	   ret_code = write(file_descriptor, string_to_write, strlen(string_to_write));
X	   
X	   if (ret_code != strlen(string_to_write))  {
X		 retint(WRITEERROR);
X		 return(1);
X	   }
X	   
X	   if (add_nl)  {
X		 ret_code = write(file_descriptor, "\012", 1);
X		 if (ret_code != 1)  {
X		    retint(WRITEERROR);
X		    return(1);
X		 }
X	   }
X	   
X	   retint(WRITEOK);
X	   return(1);
X	}
X	  
X		
X		   
X/***************************************************
X *
X *
X ***************************************************/
Xint closefile(num_args)
Xint num_args;
X	{
X	   /* num_args should be 1 */
X	   
X	   int file_descriptor;
X	   int ret_code;
X	   
X	   if (num_args != 1)  {
X		 retint(WRG_NUMBER_PARMS);
X		 return(1);
X	   }
X	   
X	   /* Pop file descriptor */
X	   popint(&file_descriptor);
X	   
X	   /* Close file */
X	   ret_code = close(file_descriptor);
X	   
X	   if (ret_code == 0)  {
X		 retint(CLOSEOK);
X	   }
X	   else  {
X		 retint(CLOSEERROR);
X	   }
X	   
X	   return(1);
X	}
X
X/***************************************************
X *
X *
X ***************************************************/
Xint tmpfilename(num_args)
Xint num_args;
X	{
X	   
X	   char *tmpfilename;
X	   
X	   char tempdir[1024];
X	   char tempfilename_prefix[1024];
X	   
X	   char tmp_string[2];
X	   tmp_string[0] = NULL;
X	   tmp_string[1] = NULL;
X	   
X	   /* num_args should be 2 */
X	   if (num_args != 2)  {
X		 retint(WRG_NUMBER_PARMS);
X		 retquote(tmp_string);
X		 return(2);
X	   }
X	   
X	   /* Pop prefix */
X	   popquote(tempfilename_prefix, 1023);
X
X	   rm_trailing_ws(tempfilename_prefix);
X	   
X	   /* Pop dir */
X	   popquote(tempdir, 1023);
X
X	   rm_trailing_ws(tempdir);
X	   
X	   tmpfilename = tempnam(tempdir, tempfilename_prefix);
X	   
X	   if (tmpfilename)  {
X		 retint(TMPFILENAMEOK);
X		 retquote(tmpfilename);
X		 return(2);
X	   }
X	   else  {
X		 retint(TMPFILENAMEERROR);
X		 retquote(tmp_string);
X		 return(2);
X	   }
X	}
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint getprocid()
X	{
X	   
X	   int pid;
X	   
X	   pid=getpid();
X	   
X	   retint(pid);
X	   return(1);
X	   
X	}
X/***************************************************
X *
X *
X ***************************************************/
Xint getpprocid()
X	{
X	   int ppid;
X	   
X	   ppid=getppid();
X	   
X	   retint(ppid);
X	   return(1);
X	}
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint statfile(num_args)
Xint num_args;
X    {
X
X	char filename[1024];
X	struct stat *sbuf;
X	int ret_code;
X
X	int filetype;
X	long filesize;
X	char filemode[11];
X	char gid[25];
X	char uid[25];
X	char lastaccesstime[20];
X	char lastmodificationtime[20];
X	char laststatuschange[20];
X
X	struct passwd *pw;
X	struct group *gr;
X
X	if (num_args != 1) {
X		retint(WRG_NUMBER_PARMS);
X		return(1);
X	}
X
X	/* Pop in reverse order */
X
X	/* Pop filename to delete */
X	popquote(filename, 1023);
X
X	rm_trailing_ws(filename);
X
X	/* Get status */
X	if (stat(filename, sbuf) == -1) {
X		/* either stat gave an error or it doesn't exist */
X		switch (errno) {
X			case ENOENT:	/* file/path doesn't exist */
X				retint(FILENOTEXIST);
X				break;
X			case EACCES:	/* access denied to file/path */
X				retint(FILEACCESSDENIED);
X				break;
X			default:
X				retint(STATFILEERROR);
X				break;
X		}
X		/* Other args */
X		retquote("");
X		retquote("");
X		retquote("");
X		retlong((long)0);
X		retint(FT_UNKNOWN);
X		retquote("");
X		retquote("");
X		retquote("");
X		return(9);
X	}
X
X	/*  Filetype  */
X	switch (sbuf->st_mode & S_IFMT)  {
X		case S_IFDIR:
X			filetype = FT_DIRECTORY;
X			break;
X		case S_IFBLK:
X			filetype = FT_BLOCKSPECIAL;
X			break;
X		case S_IFCHR:
X			filetype = FT_CHARSPECIAL;
X			break;
X		case S_IFREG:
X			filetype = FT_PLAINFILE;
X			break;
X		case S_IFIFO:
X			filetype = FT_FIFO;
X			break;
X		case S_IFLNK:
X			filetype = FT_SYMLINK;
X			break;
X		default:
X			filetype = FT_UNKNOWN;
X			break;
X	}
X
X	/* File size */
X	filesize = sbuf->st_size;
X
X	/* File Mode */
X	sprintf(filemode, "%o", sbuf->st_mode & 0777);
X
X	/* Group ID */
X	if ((gr = getgrgid(sbuf->st_gid)) == NULL)
X		sprintf(gid, "unknown");
X	else
X		sprintf(gid, "%s", gr->gr_name);
X
X	/* Owner ID */
X	if ((pw = getpwuid(sbuf->st_uid)) == NULL)
X		sprintf(uid, "unknown");
X	else
X		sprintf(uid, "%s", pw->pw_name);
X
X	/* File time stamps */
X	strftime(lastaccesstime, 20, "%Y-%m-%d %H:%M:%S", localtime(&sbuf->st_atime));
X	strftime(lastmodificationtime, 20, "%Y-%m-%d %H:%M:%S", localtime(&sbuf->st_mtime));
X	strftime(laststatuschange, 20, "%Y-%m-%d %H:%M:%S", localtime(&sbuf->st_ctime));
X
X
X	/* Push in RETURNING order */
X	retint(STATFILEOK);
X	retquote(uid);
X	retquote(gid);
X	retquote(filemode);
X	retlong(filesize);
X	retint(filetype);
X	retquote(lastaccesstime);
X	retquote(lastmodificationtime);
X	retquote(laststatuschange);
X	return(9);
X	   
X    }
X	   
X
X/***************************************************
X *
X *
X ***************************************************/
Xint deletefile(num_args)
Xint num_args;
X    {
X
X	char filename[1024];
X	int ret_code;
X
X	if (num_args != 1) {
X		retint(WRG_NUMBER_PARMS);
X		return(1);
X	}
X
X	/* Pop in reverse order */
X
X	/* Pop filename to delete */
X	popquote(filename, 1023);
X
X	rm_trailing_ws(filename);
X
X	/* Try to delete */
X	ret_code = remove(filename);
X
X	if (ret_code == 0) {
X		retint(DELETEFILEOK);
X		return(1);
X	}
X	else {
X		retint(DELETEFILEERROR);
X		return(1);
X	}
X	   
X    }  /* End deletefile */
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint createfile(num_args)
Xint num_args;
X    {
X
X	char filename[1024];
X	int file_descriptor;
X	int ret_code;
X
X	if (num_args != 1) {
X		retint(WRG_NUMBER_PARMS);
X		return(1);
X	}
X
X	/* Pop in reverse order */
X
X	/* Pop filename to create */
X	popquote(filename, 1023);
X
X	rm_trailing_ws(filename);
X
X	/* Try to open file */
X	file_descriptor = open(filename, O_CREAT | O_TRUNC | O_RDWR, S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
X
X	if (file_descriptor < 0) {		/* Error on open, error */
X		retint(CREATEFILEERROR);
X		return(1);
X	}
X
X	/* Close file now */
X	ret_code = close(file_descriptor);
X	   
X	if (ret_code == 0)  {
X		retint(CREATEFILEOK);
X	}
X	else  {
X		retint(CREATEFILEERROR);
X	}
X	   
X	return(1);
X	   
X    }
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint purgefile(num_args)
Xint num_args;
X	{
X
X	char filename[1024];
X	int file_descriptor;
X	int ret_code;
X	struct stat *sbuf;
X	FILE *errfile;
X
X/* errfile = fopen("error.out", "a"); */
X/* fprintf(errfile, "Entering purgefile...\n"); */
X
X	if (num_args != 1) {
X		retint(WRG_NUMBER_PARMS);
X		return(1);
X	}
X
X	/* Pop in reverse order */
X
X	/* Pop filename to pruge */
X	popquote(filename, 1023);
X/* fprintf(errfile, "  filename before ws strip = %s\n", filename); */
X
X	rm_trailing_ws(filename);
X/* fprintf(errfile, "  filename after ws strip = %s\n", filename); */
X
X	/* See if file exists */
X	if (stat(filename, sbuf) == -1) {
X		/* either stat gave an error or it doesn't exist */
X		switch (errno) {
X			case ENOENT:	/* file/path doesn't exist */
X				retint(FILENOTEXIST);
X				break;
X			case EACCES:	/* access denied to file/path */
X				retint(FILEACCESSDENIED);
X				break;
X			default:
X				retint(errno);
X				break;
X		}
X/* fclose(errfile); */
X		return(1);
X	}
X/* fprintf(errfile, "in purgefile...stat OK\n"); fflush(stderr); */
X
X	/* File must exist */
X	/* Try to open file */
X	file_descriptor = open(filename, O_TRUNC | O_RDWR, S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
X
X	if (file_descriptor < 0) {		/* Error on open, error */
X		/* retint(PURGEFILEERROR); */
X		retint(-9999);
X/* fclose(errfile); */
X		return(1);
X	}
X/* fprintf(errfile, "in purgefile...open OK\n"); fflush(stderr); */
X
X	/* Close file now */
X	ret_code = close(file_descriptor);
X	   
X	if (ret_code == 0)  {
X		retint(PURGEFILEOK);
X	}
X	else  {
X		/* retint(PURGEFILEERROR); */
X		retint(-99999);
X	}
X	   
X/* fclose(errfile); */
X	return(1);
X	   
X    }
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint fileseek(num_args)
Xint num_args;
X    {
X
X	int origin;
X	long offset;
X	int file_descriptor;
X
X	/* num_args should be 3 */
X	if (num_args != 3) {
X		retint(WRG_NUMBER_PARMS);
X		return(1);
X	}
X
X	/* Pop in reverse order */
X	/* Pop origin */
X	popint(&origin);
X
X	/* Pop offset */
X	poplong(&offset);
X
X	/* Pop file_descriptor */
X	popint(&file_descriptor);
X
X	if (lseek(file_descriptor, (long)offset, origin) == -1L) {
X		retint(FILESEEKERROR);
X	}
X	else {
X		retint(FILESEEKOK);
X	}
X
X	return(1);
X	   
X    }
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint renamefile(num_args)
Xint num_args;
X    {
X
X	char orig_filename[1024];
X	char new_filename[1024];
X
X
X	/* num_args should be 2 */
X	if (num_args != 2) {
X		retint(WRG_NUMBER_PARMS);
X		return(1);
X	}
X
X	/* Pop in reverse order */
X	/* Pop new file name */
X	popquote(new_filename, 1023);
X
X	rm_trailing_ws(new_filename);
X
X	/* Pop original file name */
X	popquote(orig_filename, 1023);
X
X	rm_trailing_ws(orig_filename);
X
X	if (rename(orig_filename, new_filename) != 0) {
X		retint(RENAMEFILEERROR);
X	}
X	else {
X		retint(RENAMEFILEOK);
X	}
X
X	return(1);
X	   
X    }
X	   
X/***************************************************
X *
X *
X ***************************************************/
Xint filetell(num_args)
Xint num_args;
X    {
X
X	int file_descriptor;
X	long offset;
X
X
X    	/* num_args should be 1 */
X    	if (num_args != 1) {
X    		retlong(WRG_PARMS_LONG);
X    		return(1);
X    	}
X
X    	/* Pop arg */
X    	popint(&file_descriptor);
X
X
X    	offset = tell(file_descriptor);
X    	if (offset == -1L) {
X    		retlong(FILETELLERROR);
X    	}
X    	else {
X    		retlong(offset);
X    	}
X
X    	return(1);
X
X    }
X
X
X
X/***************************************************
X *
X *
X ***************************************************/
Xint rm_trailing_ws(tmpptr)
Xchar *tmpptr;
X	{
X
X	int x;
X	int ret_val;
X
X	/* Point x to EOS */
X	x = strlen(tmpptr) - 1;
X
X	while (tmpptr[x] == 32 && x >= 0) {
X		x--;
X	}
X
X	x++;
X
X	tmpptr[x] = NULL;
X}
SHAR-EOF
if [ `wc -c <file_io.c` -ne 18137 ]
then echo shar: file_io.c unpacked with wrong size
fi
# end of overwriting check
fi
#--------------------
if [ -f file_io_setup.4gl -a "$1" != "-c" ]
then echo shar: file_io_setup.4gl already exists
else
echo 'x - file_io_setup.4gl (1387 characters)'
sed -e 's/^X//' >file_io_setup.4gl <<'SHAR-EOF'
X
XFUNCTION file_io_initialize()
X
X
X	# Used by all functions
X	LET WRG_NUMBER_PARMS = -10
X
X	LET FILENOTEXIST = -70
X	LET FILEACCESSDENIED = -71
X
X	# openfile
X	LET OPENERROR = -1
X	LET OPENARGERROR = -2
X	LET OPENREAD = 0
X	LET OPENWRITE = 1
X	LET OPENREADWRITE = 2
X	LET OPENNOMATTERWHAT = 50
X	LET OPENIFEXISTS = 51 
X	LET OPENIFNOTEXISTS = 52 
X	LET OPENTRUNCATE = 53
X	LET OPENAPPEND = 54
X	LET OPENREADONLY = 55
X
X	LET MAXLINELENGTH = 1024
X	LET MAXLINELENREACHED = -50
X
X	# readchar, readline
X	LET READERROR = -1
X	LET READEOF = 0
X	LET READOK = 1
X
X	# writechar, writeline
X	LET WRITEERROR = -1
X	LET WRITEOK = 1
X
X	# closefile
X	LET CLOSEERROR = -1
X	LET CLOSEOK = 0
X
X	# tmpfilename
X	LET TMPFILENAMEERROR = -1
X	LET TMPFILENAMEOK = 0
X
X	# deletefile
X	LET DELETEFILEERROR = -1
X	LET DELETEFILEOK = 0
X
X	# statfile
X	LET STATFILEERROR = -1
X	LET STATFILEOK = 0
X	LET FT_PLAINFILE = 110
X	LET FT_DIRECTORY = 111
X	LET FT_BLOCKSPECIAL = 112
X	LET FT_CHARSPECIAL = 113
X	LET FT_FIFO = 114
X	LET FT_SYMLINK = 115
X	LET FT_UNKNOWN = 150
X
X	# createfile
X	LET CREATEFILEERROR = -1
X	LET CREATEFILEOK = 0
X
X	# purgefile
X	LET PURGEFILEERROR = -1
X	LET PURGEFILEOK = 0
X
X	# fileseek
X	LET FILESEEKERROR = -1
X	LET FILESEEKOK = 0
X	LET FILE_BEGINNING = 0
X	LET FILE_CURRENT = 1
X	LET FILE_END = 2
X
X	# renamefile
X	LET RENAMEFILEERROR = -1
X	LET RENAMEFILEOK = 0
X
X	# filetell
X	LET FILETELLERROR = -1
X
XEND FUNCTION  # function file_io_initialize
X
SHAR-EOF
if [ `wc -c <file_io_setup.4gl` -ne 1387 ]
then echo shar: file_io_setup.4gl unpacked with wrong size
fi
# end of overwriting check
fi
#--------------------
if [ -f global_defs.4gl -a "$1" != "-c" ]
then echo shar: global_defs.4gl already exists
else
echo 'x - global_defs.4gl (1649 characters)'
sed -e 's/^X//' >global_defs.4gl <<'SHAR-EOF'
X
X#  Has defines for all stuff used in the custom runner.
X#  This file must be maintained to match what is in
X#    the 'C' equivalent of this file to set these
X#    values so they can be used an evaluated on the
X#    'C' side
X
XGLOBALS
X
X	DEFINE WRG_NUMBER_PARMS INTEGER
X
X	DEFINE FILENOTEXIST INTEGER
X	DEFINE FILEACCESSDENIED INTEGER
X
X	DEFINE OPENERROR INTEGER
X	DEFINE OPENARGERROR INTEGER
X	DEFINE OPENREAD INTEGER 
X	DEFINE OPENWRITE INTEGER
X	DEFINE OPENREADWRITE INTEGER
X	DEFINE OPENNOMATTERWHAT INTEGER
X	DEFINE OPENIFEXISTS INTEGER 
X	DEFINE OPENIFNOTEXISTS INTEGER 
X	DEFINE OPENTRUNCATE INTEGER
X	DEFINE OPENAPPEND INTEGER
X	DEFINE OPENREADONLY INTEGER
X
X	DEFINE MAXLINELENGTH INTEGER
X	DEFINE MAXLINELENREACHED INTEGER
X
X	DEFINE READERROR INTEGER
X	DEFINE READEOF INTEGER
X	DEFINE READOK INTEGER
X
X	DEFINE WRITEERROR INTEGER
X	DEFINE WRITEOK INTEGER
X
X	DEFINE CLOSEERROR INTEGER
X	DEFINE CLOSEOK INTEGER
X
X	DEFINE TMPFILENAMEERROR INTEGER
X	DEFINE TMPFILENAMEOK INTEGER
X
X	DEFINE DELETEFILEERROR INTEGER
X	DEFINE DELETEFILEOK INTEGER
X
X	DEFINE STATFILEERROR INTEGER
X	DEFINE STATFILEOK INTEGER
X	DEFINE FT_PLAINFILE INTEGER
X	DEFINE FT_DIRECTORY INTEGER
X	DEFINE FT_BLOCKSPECIAL INTEGER
X	DEFINE FT_CHARSPECIAL INTEGER
X	DEFINE FT_FIFO INTEGER
X	DEFINE FT_SYMLINK INTEGER
X	DEFINE FT_UNKNOWN INTEGER
X
X	DEFINE CREATEFILEERROR INTEGER
X	DEFINE CREATEFILEOK INTEGER
X
X	DEFINE PURGEFILEERROR INTEGER
X	DEFINE PURGEFILEOK INTEGER
X
X	DEFINE FILESEEKERROR INTEGER
X	DEFINE FILESEEKOK INTEGER
X	DEFINE FILE_BEGINNING INTEGER
X	DEFINE FILE_CURRENT INTEGER
X	DEFINE FILE_END INTEGER
X
X	DEFINE RENAMEFILEERROR INTEGER
X	DEFINE RENAMEFILEOK INTEGER
X
X	DEFINE FILETELLERROR INTEGER
X
XEND GLOBALS
X
X
SHAR-EOF
if [ `wc -c <global_defs.4gl` -ne 1649 ]
then echo shar: global_defs.4gl unpacked with wrong size
fi
# end of overwriting check
fi
#--------------------
if [ -f global_defs.h -a "$1" != "-c" ]
then echo shar: global_defs.h already exists
else
echo 'x - global_defs.h (1653 characters)'
sed -e 's/^X//' >global_defs.h <<'SHAR-EOF'
X
X/*  Has defines for all stuff used in the custom runner.
X *  This file must be maintained to match what is in
X *    the 4GL equivalent of this file to set these
X *    values so they can be used an evaluated on the
X *    4GL side
X */
X
X
X#define WRG_NUMBER_PARMS -10
X#define WRG_PARMS_LONG -10L
X
X#define FILENOTEXIST -70
X#define FILEACCESSDENIED -71
X
X/* openfile */
X#define OPENERROR -1
X#define OPENARGERROR -2
X#define OPENREAD 0
X#define OPENWRITE 1
X#define OPENREADWRITE 2
X#define OPENNOMATTERWHAT 50
X#define OPENIFEXISTS 51 
X#define OPENIFNOTEXISTS 52 
X#define OPENTRUNCATE 53
X#define OPENAPPEND 54
X#define OPENREADONLY 55
X
X#define MAXLINELENGTH 1024
X#define MAXLINELENREACHED -50
X
X/* readchar, readline */
X#define READERROR -1
X#define READEOF 0
X#define READOK 1
X
X/* writechar, writeline */
X#define WRITEERROR -1
X#define WRITEOK 1
X
X/* closefile */
X#define CLOSEERROR -1
X#define CLOSEOK 0
X
X/* tmpfilename */
X#define TMPFILENAMEERROR -1
X#define TMPFILENAMEOK 0
X
X/* deletefile */
X#define DELETEFILEOK 0
X#define DELETEFILEERROR -1
X
X/* statfile */
X#define STATFILEERROR -1
X#define STATFILEOK 0
X#define FT_PLAINFILE 110
X#define FT_DIRECTORY 111
X#define FT_BLOCKSPECIAL 112
X#define FT_CHARSPECIAL 113
X#define FT_FIFO 114
X#define FT_SYMLINK 115
X#define FT_UNKNOWN 150
X
X/* createfile */
X#define CREATEFILEOK 0
X#define CREATEFILEERROR -1
X
X/* purgefile */
X#define PURGEFILEOK 0
X#define PURGEFILEERROR -1
X
X/* fileseek */
X#define FILESEEKERROR -1
X#define FILESEEKOK 0
X#define FILE_BEGINNING SEEK_SET
X#define FILE_CURRENT SEEK_CUR
X#define FILE_END SEEK_END
X
X/* renamefile */
X#define RENAMEFILEERROR -1
X#define RENAMEFILEOK 0
X
X/* filetell */
X#define FILETELLERROR -1L
SHAR-EOF
if [ `wc -c <global_defs.h` -ne 1653 ]
then echo shar: global_defs.h unpacked with wrong size
fi
# end of overwriting check
fi
echo All files extracted
exit 0

-- 
----------------------------------------------------------------------------
Mike Reetz                   reetz@ncar.ucar.edu           3450 Mitchell Ln
UNIX(tm) Operations Manager  (303)497-8881(V) 497-8501(F)  Building 1
UCAR - University Corporation For Atmospheric Research     Boulder, CO 80301
