Click above to get retro games delivered to your door ever month!

   * PROGRAM...: CFTS5.PRG
   * AUTHOR....: John A. Reesman
   * ..........: Index Applications Incorporated
   * ..........: 8546 Broadway, Suite 208
   * ..........: San Antonio, TX  78217 USA
   * ..........: (210) 822-4818
   * DATE......: 12/18/88
   * MODIFIED..: 09/06/93
   * NOTICE....: Copyright (c) 1989-1993 Index Applications Incorporated
   * NOTES.....: UDFs for implementing low level CFTS routines.


   #include "Set.ch"                /*  include std "set" commands */
   #include "cftserr.ch"            /*  include CFTS error defines */

   #define DEF_IASIZE   2           /* default index record size */


   /*
   * CFTS_ADD adds a new record to a CFTS index. Parameters received
   * are a valid CFTS handle and the name of a UDF that returns a
   * string to be indexed.
   */

   function cfts_add ( handle, iafunc )

   local instring, rec

   instring := eval( iafunc )   /* evaluate the .ia string function */

   rec := cftsadd( handle, instring )

   if rec < 1

      cfts_err( procname(), ( procline() - 3 ), rec )

   endif

   return( 0 )
   /* eof cfts_add() */


   /*
   * CFTS_CLOSE closes an existing CFTS index. Receives the file's handle.
   */

   function cfts_close ( handle )

   local err

   err := cftsclose( handle )

   if err < 0

      cfts_err( procname(), ( procline() - 3 ), err )

   endif

   return( 0 )
   /* eof cfts_close() */


   /*
   * CFTS_DEL marks a record in a CFTS index as deleted.
   * Parameters received are CFTS file handle and record
   * number to delete.
   */

   function cfts_del ( handle, recnum )

   local err

   err := cftsdelete( handle, recnum )

   if err < 1 .and. err != -8

      cfts_err( procname(), ( procline() - 3 ), err )

   endif

   return( 0 )
   /* eof cfts_del() */


   /*
   * CFTS_ERR prints decoded error return from a CFTS function and
   * then terminates the program.
   */

   function cfts_err ( pname, pline, perr )

   local err_desc

   /*
   * Error message text. Modify the text to suit your taste
   * and requirements. This array could be filled with
   * text stored in a file.
   *
   * Note that elements 12 and 14 are defined as 'Undefined' to
   * permit a one-to-one mapping between the FTS error codes
   * and the corresponding text in the ErrorText[] array.
   */

   static ErrorText := {'CREATEFAIL: file creation error',  ;
        'MEMERR: memory allocation error',                  ;
        'NULLPTR: internal function call with NULL pointer',;
        'BADSEEK: illegal seek',                            ;
        'BADREAD: read error',                              ;
        'BADWRITE: write error',                            ;
        'RECBOUND: record number out of bounds',            ;
        'ISDELETED: record already deleted',                ;
        'NOTDELETED: rec not deleted',                      ;
        'OPENERR: unable to open CFTS file',                ;
        'INTERR: internal error',                           ;
        'Undefined',                                        ;
        'NORECS: CFTSset called with empty file',           ;
        'Undefined',                                        ;
        'ILLEVEL: bad "level" parameter to CFTSfind',       ;
        'BADPARMS: illegal number or type of parameters',   ;
        'NOMOREHANDLES: out of handles for CFTS',           ;
        'BADHANDLE: invalid handle',                        ;
        'BADIHANDLE: invalid internal handle',              ;
        'LOCKFAILED: unable to lock file',                  ;
        'NOMORELOCKS: lock table exhausted',                ;
        'CANNOTUNLOCK: unable to unlock file',              ;
        'BADCOMMIT: unable to commit the file while during update'}


   if( perr >= BADCOMMIT .and. perr <=CREATEFAIL) /* handle valid ranges */

      err_desc := ErrorText[ abs( perr ) ]

   else

      err_desc := "Undefined"

   endif

   @ 0, 0 say 'Proc ' + pname + ' line ' + ltrim( str( pline ) ) +;
           ', ' + err_desc
   quit

   return( 0 )
   /* eof cfts_err() */


   /*
   * CFTS_INDEX creates a new CFTS index. Parameters received are:
   * 1) the name of the CFTS index file (including path, if desired)
   * you want to create, 2) the size of the CFTS buffer in kilobytes;
   * i.e, 10 -> 10K, and 3) the name of a UDF that returns a string to
   * be indexed, 4) the mode in which the CFTS index file is opened,
   * and 5) the size of the index record to build. The index size
   * parameter is optional. If it is not specified, the value of
   * DEF_IASIZE is used.
   */

   function cfts_index ( fspec, iabuff, iafunc, fmode, iasize )

   local handle, oldrec, instring, rec, ndx_ord, delete_on

   /*
   * flush any existing .ia file by recreating it
   * be sure to close it first
   */

   delete_on := .f.     /* flag incase we need to turn */
                        /* SET DELETE ON later */

   iasize := if( iasize == NIL, DEF_IASIZE, iasize )

   handle := cftscrea( fspec, iabuff, iasize, .t. ,1 )

   if handle < 0

      cfts_err( procname(), ( procline() - 3 ), handle )

   endif

   ndx_ord := indexord()    /* save current index order */
   oldrec := recno()        /* save rec number of .dbf */

   if set( _SET_DELETED )   /* set deleted off, if its on */

      set deleted off
      delete_on := .t.

   endif

   set order to 0

   goto top

   do while ! eof()

      instring := eval( iafunc )  /* evaluate the .ia string function */

      rec := cftsadd( handle, instring )

      if rec < 1

         cfts_err( procname(), ( procline() - 3 ), rec )

      endif

      skip

   enddo

   if delete_on

      set delete on

   endif

   cfts_close( handle )    /* play safe and flush IA buffers */

   handle := cfts_open( fspec, iabuff, fmode )

   goto oldrec             /* restore position in .dbf */
   set order to ndx_ord    /* restore .ntx file        */
   return( handle )        /* return new file handle   */
   /* eof cftsindex() */


   /*
   * CFTS_IFDEL returns .T. if index record is deleted, else .F.
   * Parameters received are CFTS handle and number of record to test.
   */

   function cfts_ifdel ( handle, recnum )

   local err

   err := cftsifdel( handle, recnum )

   if err < 0

      cfts_err( procname(), ( procline() - 3 ), err )

   else

      err := if( err = 0, .f., .t. )

   endif

   return( err )
   /* eof cfts_ifdel() */


   /*
   * CFTS_NEXT returns the number of the next CFTS index record that
   * matches the search criteria established by CFTS_SET. Returns 0
   * when the search is exhausted. Use CFTS_VERI to verifiy the 
   * record pointed to by CFTS_NEXT against the original search 
   * criteria. Parameter received: a CFTS file handle. 
   * Note: User's may supply their own verify function.
   */

   function cfts_next ( handle )

   local rec

   rec := cftsnext( handle )

   if rec < 0

      cfts_err( procname(), ( procline() - 3 ), rec )

   endif

   return( rec )
   /* eof cfts_next() */

   /*
   * CFTS_OPEN opens an existing CFTS index. Parameters received 
   * are:1) the name of the CFTS index file (including path, if
   * desired) you want to create, 2) the size of the CFTS buffer
   * in kilobytes;i.e, 12 -> 12K, and 3) the mode in which the 
   * CFTS index file is opened.
   */

   function cfts_open ( fspec, iabuff, fmode  )

   local handle

   handle := cftsopen( fspec, iabuff, fmode )

   if handle < 0

      cfts_err( procname(), ( procline() - 3 ), handle )

   endif

   return( handle )
   /* eof cfts_open() */


   /*
   * CFTS_RECN returns the number of records in the CFTS index.
   */

   function cfts_recn ( handle )

   local recs

   recs := cftsrecn( handle )

   if recs < 1

      cfts_err( procname(), ( procline() - 3 ), recs )

   endif

   return( recs )
   /* eof cfts_recn() */

   /*
   * CFTS_REPL replace an existing CFTS index record with a new 
   * record.Parameters received are: 1) CFTS handle, 2) UDF 
   * returning the string to be indexed, and 3) the index 
   * record number to be replaced.
   */

   function cfts_repl ( handle, iafunc, recnum )

   local err, instring

   instring := eval( iafunc )  /* evaluate the .ia string function */

   err := cftsreplac( handle, instring, recnum )

   if err < 1

      cfts_err( procname(), ( procline() - 3 ), err )

   endif

   return( 0 )
   /* eof cfts_repl() */


   /*

   * CFTS_SET prepares the CFTS index for searching. The actual 
   * searching is performed by CftsNext(). Parameters received 
   * are the CFTS handle and the string containing the search criteria.
   */

   function cfts_set ( handle, instring )

   local err

   err := cftsset( handle, instring )

   if err < 1

      cfts_err( procname(), ( procline() - 3 ), err )

   endif

   return( 0 )
   /* eof cfts_set() */


   /*
   * CFTS_UNDEL 'undeletes' a CFTS index record that has been marked
   * as deleted. Parameters received are CFTS handle and the record number.
   */

   function cfts_undel ( handle, recnum )

   local err

   err := cftsundel( handle, recnum )

   if err < 1 .and. err != -9

      cfts_err( procname(), ( procline() - 3 ), err )

   endif

   return( 0 )
   /* eof cfts_undel() */


   /*
   * CFTS_VERI verifies the search criteria "target" against 
   * the record(s) pointed to by CFTS_NEXT, "source". Parameters 
   * received are: 1) CFTS handle, 2) the "source" (.dbf) string,
   * 3) the "target" (search criteria) string, and 4) the 
   * verification type; i.e., 1, (beginning of string), 
   * 2, (end of string), 3, ( "AND") or 4, ("PHRASE").
   */

   function cfts_veri ( handle, source, target, vtype )

   local err

   err := cftsveri( handle, source, target, vtype )

   if err < 0

      cfts_err( procname(), ( procline() - 3 ), err )

   endif

   return( err )
   /* eof cfts_veri() */