Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : CONINDEX.ZIP
Filename : CONDINDX.PRG

/* -------------------------------------------------------------------------

Function: CONINDEX()

Author: Darren J. Forcier,
Forcier Computer Services
253 Main Street
Cherry Valley, Ma. 01611 Tel No 508-892-3351

CIS ID 72117,1632


Conditional Indexing Function. What this function basically
does is builds an index based upon a passed filter string.
Each record is tested against the filter criteria, and if
it meets the filter criteria, the hard coded key value is
returned. If not, spaces are returned. UNIQUE is set ON,
so that duplicate space keys will be filtered out of the
index. The str(RECNO()) is tacked onto each valid key to
ensure that it is unique. Since there will be at least one
"spaced out" key, we set a filter to !&querycond, to filter
that one key out. This doesn't seem to degrade the performance.

Clipper 5.01 Notes: This is basically a rewrite of my original
CONINDEX() function, enhanced and modified for Clipper 5.01.
Gone forever are those bloody macros! (well, almost..)
Code blocks are now used to process the index queries wherever
possible. I have also naturally used locals and statics where
applicable.

With the advent of the preprocessor I can now start doing what
I have been doing in C for years, including a stub of test
code with each function, to make for easy testing of my code
when I make minor changes. All it takes is a simple flip of
the switch to turn off the test code when it is no longer needed.


The preprocessor has also allowed me to do some pretty elegant
things with the CONINDEX UDC, like position independent parameters,
conditional processing of totalling/counting, etc. MAKEBLOCK is
pretty convenient to. How did we ever get by without one in
Summer '87???



--- NOTICE OF COPYRIGHT ---

This program is hereby donated to the public domain on an as-is
basis. No warranty either express or implied exists. You are
free to use this in any programming endeavor except in a third
party library you intend to distribute for profit. No fee or
charge may be obtained for distribution of this function, except
for reasonable materials cost for diskettes, etc.


------------------------------------------------------------------------ */

#include "fileio.ch" // Standard Nantucket Low Level File I/O #defines
#include "condindx.ch" // My own conditional indexing stuff....


#ifdef TESTMAIN

// implementation specific defines...

#define PRICES 1
#define ISSUES 2

// Switch so we can see what is happening during indexing. May make that
// An optional code block or something later...

// #define DEBUG



/* -----------------------------------------------------------
MAIN() -

Test stub program to give Conindex() a workout.
Use CLIPPER /DTESTMAIN when you compile, along with your
other compile line options, of course.

----------------------------------------------------------*/


FUNCTION main()

FIELD pub_code
FIELD issue_num
FIELD pur_price

LOCAL time1:=0,time2:=0 // Get our benchmark timings
LOCAL counter:=0 // Use this to get our count
LOCAL _totarr := {} // Also gain other valuable statistics



/*
--- Totalling/Summing "Object" ---

Totalling will be done via some pseudo object oriented techniques
here. Basically I will pass a nested array that will contain both
holding buckets for totals, and the methods (code blocks, of course)
by which we will fill those buckets. Note that I have not done
any kind of preprocessor tricks to simulate OOPS yet. There is so
much stuff coming out in the form of OOPS libs that I want to wait
and see what shakes out before I start defining the universe!


*/


aadd(_totarr,{NIL,NIL}) // Allocate 2 rows of 2 columns
aadd(_totarr,{NIL,NIL}) // Allocate 2 rows of 2 columns

// ---- Totalling 'Instance Vars' ----

// Initialize the holding buckets for the totals/sums

_totarr[PRICES][BUCKET] :=0;

_totarr[ISSUES][BUCKET] :=0;

// ---- Totalling 'Methods' ----

// Code block to sum up purchase prices for passed query

_totarr[PRICES][BLOCK] := { || _totarr[PRICES][BUCKET] += pur_price }

// Code block to total up # of issues having issue # < 50 for passed query

_totarr[ISSUES][BLOCK] := { || _totarr[ISSUES][BUCKET] += iif(issue_num < 50, 1, 0) }



CLS

use issues new

time1 := seconds()


#ifdef FOXPRO_WEENIE

// Foxpro Weenie Emulation...

INDEX on tit_code for pub_code = 'MARVL'.and.issue_num <10 to issues ;
TOTAL _totarr COUNTER counter display {||setpos(24,0),;
dispout("Record "+str(recno(),8)+" of "+ str( reccount(),8) ) }
#else

CONDINDEX "issues.ntx" ;
QUERY pub_code='MARVL'.and.issue_num <10 ;
KEY tit_code ;
TOTAL _totarr ;
COUNTER counter ;
DISPLAY {|| setpos(24,0),;
dispout("Record "+str(recno(),8)+" of "+ str( reccount(),8) ) }
#endif


time2 := seconds()

browse(0,0,20,79) // just scroll around in this sh*t for a while...


// Close off index so I can test my new and greatest feature, the
// SET INDEX TO FILTERED BY ...

set index to issues FILTERED BY pub_code='MARVL'.and.issue_num < 10

browse(0,0,20,79) // just scroll around in this sh*t for a while...

use

CLS

@ 10,10 say "Time to run was:"
@ 10,60 say time2-time1 picture '99999.99 Seconds'
@ 11,10 say "Conditional indexing matched up:"
@ 11,60 say counter picture '99999999 Issues'
@ 12,10 say "Total $ spent on those issues:"
@ 12,60 say _totarr[PRICES][BUCKET] picture "$99999.99"
@ 13,10 say "Total issues < #50:"
@ 13,60 say _totarr[ISSUES][BUCKET] picture "99999999"

RETURN ( NIL )


#endif




/*----------------------------------------------------------------

Function: CONINDEX() - Creates the conditional index

---------------------------------------------------------------- */


FUNCTION ConIndex(fyle, query, key_expr, tot_arr, counter,bDispBlock)

LOCAL bquery, bkey, OldUniq

OldUniq := set(_SET_UNIQUE,TRUE)

bquery := MACROBLOCK(query)
bkey := MACROBLOCK(key_expr)

index on indexer(bquery,bkey, tot_arr,@counter,bDispBlock) to (fyle)
commit
set index to

//-----------------------------------------------------------------
// Now patch up the index file by writing the key directly to the
// header! Scary but effective. Thanks Greg for teaching me about
// this technique in INDEXBAR...
//-----------------------------------------------------------------

indexpatch(fyle,key_expr+UNIQUE_KEY)

set index to (fyle)

set filter to eval(bquery)
go top

set(_SET_UNIQUE,OldUniq)

RETURN( NIL )




/*-------------------------------------------------------------------------

Function: INDEXER()

Actual Conditional Indexing Function...

------------------------------------------------------------------------*/



FUNCTION indexer(query,key_expr,tot_arr,counter,bDispBlock)

LOCAL i

if eval(query)

if valtype(tot_arr) == 'A'

/*

Sorry about the whitespace, folks. I'm experimenting with ways
to make code blocks more readable...

*/

aeval(tot_arr, { ;
|ele,n| ele[BUCKET] := eval( ele[BLOCK]) ;
} ;
)

endif

/*

if valid Display codeblock was passed, execute it.

*/

if valtype(bDispBlock) == 'B'
eval(bDispBlock)
endif

counter++
return( eval(key_expr)+str(recno(),8)) // Note that key expression must be char!
else
return( space ( len(eval(key_expr))+8 )) // Return spaces which will be filtered out
endif

END FUNCTION


/* -----------------------------------------------------------------------

IndexPatch(fyle,key_expr) -- Stomp over the key expression in the
index and rewrite it with the passed key
expression, making sure to pad with the
proper amount of Chr(0)'s.

Original idea/implementation by Greg Lief
in Grumpfish Library.

-----------------------------------------------------------------------*/


STATIC FUNCTION IndexPatch(fyle,key_expr)

LOCAL handle,buffer
LOCAL ret_val := FALSE

handle := fopen(fyle, FO_READWRITE)
if ferror() == 0
fseek(handle, 22) // .NTX header begins after offset 22
buffer := key_expr + replicate(chr(0), 254 - len(key_expr))
if fwrite(handle, buffer) = 254
ret_val := TRUE
endif
fclose(handle)
endif

RETURN(ret_val)