2
* Copyright 1998-2002 Stephen C. Grubb (ploticus.sourceforge.net) .
3
* This code is covered under the GNU General Public License (GPL);
4
* see the file ./Copyright for details. */
13
extern char *TDH_dat, *TDH_recid;
14
#define err(a,b,c) TDH_err(a,b,c)
16
/* the following is used by $tmpfilename.. */
17
extern char TDH_tmpdir[];
18
extern char TDH_scriptdir[];
20
extern char DB_datapath[];
24
static char Sep[5] = ","; /* for args that are commalists */
25
static int eval_function();
29
/* =============================================== */
30
/* FUNCTION_CALL - parse function name, and any arguments, then call
31
function evaluator. V is returned with the result value. */
33
TDH_function_call( v, typ, eval )
35
int *typ; /* sent back.. describes basic type of result.. either NUMBER or ALPHA */
36
int eval; /* 1 if unevaluated @variables possible, 0 otherwise */
38
int i, ix, len, status;
48
/* get function name */
51
GL_getchunk( name, v, &ix, " (" );
52
if( name[0] == '\0' ) {
53
err( 1601, "$function expected, nothing found", "" );
56
/* get function parameters, parsing them into arg pointer array */
58
for( i = 0; i < MAXARGS; i++ ) {
59
if( ix >= len ) break;
60
GL_getchunk( tok, v, &ix, " ,()" );
61
arg[i] = &argbuf[ alen ];
62
if( evalflag ) TDH_value_subst( &argbuf[ alen ], tok, TDH_dat, TDH_recid, 0, 0 );
63
else strcpy( &argbuf[ alen ], tok );
64
alen += strlen( &argbuf[ alen ] ) + 1;
68
nargs--; /* above parsing always picks up an extra arg for closing paren */
70
status = eval_function( name, arg, nargs, v, typ );
74
/* ======================================== */
75
/* EVAL_FUNCTION - implement general purpose condex functions.
77
Return 0 if ok, 1 if named function doesn't exist or some other error.
78
Functions which produce a result which should always be taken as
79
alpha rather than number should append a space to the end of the result.
82
eval_function( name, arg, nargs, result, typ )
83
char *name; /* function name */
84
char *arg[]; /* arg list */
85
int nargs; /* number of args */
86
char *result; /* the result value gets copied into this string */
87
int *typ; /* basic type of result */
96
int hash, externalcall;
98
/* divert custom functions.. */
99
if( name[0] == '$' && name[1] == '$' ) goto CUSTOM;
101
/* generate a hash key by adding up chars in name. (skip leading $) */
104
for( i = 1; s[i] != '\0'; i++ ) hash += ( i * (s[i] - 80) );
108
/* use the following to check new custom functions.. */
109
/* fprintf( stderr, "function: %s hash: %d\n", s, hash ); */
111
*typ = ALPHA; /* fallback */
116
if( hash == 165 ) { /* $def( varname ) - return 1 if variable has been defined, 0 if not */
117
if( TDH_getvalue( result, arg[0], TDH_dat, TDH_recid ) == 0 ) sprintf( result, "1" );
118
else sprintf( result, "0" );
122
if( hash == 179 ) { /* $ref( varname ) - return the contents of variable varname */
123
TDH_getvalue( result, arg[0], TDH_dat, TDH_recid );
127
if( hash == 189 ) { /* $len( s ) - return string length of s */
129
sprintf( result, "%d", strlen( arg[0] ) );
135
else if( hash < 300 ) {
136
if( hash == 203 ) { /* $inr(n,low,hi) - see if n is in range low to high */
138
if( !GL_goodnum( arg[0], &i ) ) strcpy( result, "0" );
139
else if( atof( arg[0] ) >= atof( arg[1] ) && atof( arg[0] ) <= atof( arg[2] ) ) strcpy( result, "1" );
140
else strcpy( result, "0" );
145
if( hash == 259 ) { /* $char(n,s) - get the nth character of string s */
148
if( n < 1 || n > (strlen( arg[1] )-1) ) return( -1 );
149
sprintf( result, "%c", arg[1][ n-1 ] );
153
if( hash == 270 ) { /* $math(what,f) - return math function of f */
154
double fabs(), sqrt(), fmod();
155
if( strcmp( arg[0], "abs" )==0 ) sprintf( result, "%g", fabs( atof( arg[1] ) ) );
156
else if( strcmp( arg[0], "mod" )==0 ) sprintf( result, "%g", fmod( atof( arg[1] ), atof( arg[2] ) ) );
157
/* else if( strcmp( arg[0], "sqrt" )==0 ) sprintf( result, "%g", sqrt( atof( arg[1] ) ) ); */
158
/* others may be added here... */
162
if( hash == 262 ) goto EXT_TIME; /* $time() */
164
else if( hash < 500 ) {
165
if( hash == 385 ) { /* $arith() and $arithl() - L to R arithmetic expression evaluator */
171
s[ strlen( s ) + 1 ] = '\0'; /* add extra null so loop terminates correctly */
172
if( s[0] == '-' ) tok[0] = '-'; /* check for unary minus on first arg */
175
GL_getchunk( &tok[1], s, &i, "+-/*%" ); /* tok[1] because sign is always in tok[0] */
176
if( strlen( &tok[1] ) < 1 ) break;
177
if( ! GL_goodnum( tok, &stat ) && name[6] != 'l' )
178
{ err( 1603, "arith: bad value", tok ); return( 1 ); }
179
if( curop == '+' ) accum = accum + atof( tok );
180
else if( curop == '-' ) accum = accum - atof( tok );
181
else if( curop == '/' ) {
182
if( atof( tok ) == 0.0 ) { /* added scg 8/4/01 */
183
err( 1605, "arith: divide by zero", "" );
186
accum = accum / atof( tok );
188
else if( curop == '*' ) accum = accum * atof( tok );
189
else if( curop == '%' ) accum = (int)(accum) % (int)(atof( tok ));
190
else { err( 1604, "arith:bad operator", "" ); return( 1 ); }
192
if( s[i+1] == '-' ) tok[0] = '-'; /* check for unary minus on next operand */
196
sprintf( result, "%g", accum );
201
if( hash == 400 ) goto EXT_TIME; /* $tomin() */
202
if( hash == 402 ) goto EXT_DATE; /* $today() */
204
if( hash == 438 ) { /* $count(str,list) - count the number of times 'str' appears in 'list'. */
205
/* if str is '*', result is the number of members in list */
208
for( j = 1; j < nargs; j++ ) { /* allow comma lists in several args.. */
213
GL_getseg( tok, s, &i, Sep ); /* parse list */
214
/* if( strlen( tok ) < 1 ) break; */
215
if( strcmp( arg[0], "*" )==0 ) n++;
216
else if( strcmp( tok, arg[0] )==0 ) n++;
219
sprintf( result, "%d", n );
224
if( hash == 444 ) { /* $change(s1,s2,line) - in line, substitute every occurance of s1 with s2. */
225
stat = GL_substitute( arg[0], arg[1], arg[2] ); /* modifies argbuf */
226
sprintf( result, "%s", arg[2] );
230
if( hash == 476 ) { /* $expand(s) - expand all vars embedded in s */
231
TDH_value_subst( result, arg[ 0 ], TDH_dat, TDH_recid, 0, 0 );
235
if( hash == 492 ) goto EXT_DATE; /* julian() */
239
else if( hash < 600 ) {
241
if( hash == 503 ) { /* $isleep() */
242
sleep( atoi( arg[0] ) );
243
strcpy( result, "" );
247
if( hash == 507 ) { /* $upperc(string) - result is the lower-case equivalent of string */
249
strcpy( result, arg[0] );
250
for( i = 0, slen = strlen( result ); i < slen; i++ ) result[i] = toupper( result[i] );
254
if( hash == 511 ) { /* $lowerc(string) - result is the lower-case equivalent of string */
256
strcpy( result, arg[0] );
257
for( i = 0, slen = strlen( result ); i < slen; i++ ) result[i] = tolower( result[i] );
261
if( hash == 520 ) { /* $random() - return a random number between 0 and 1 */
263
sprintf( result, "%g", GL_rand() );
268
if( hash == 523 ) { /* $ntoken( n, s ) - return the nth whitespace-delimited token in s */
272
for( i = 0; i < n; i++ ) strcpy( result, GL_getok( arg[1], &ix ) );
276
if( hash == 524 ) { /* $strcat(s,t) - concatenate s and t */
277
sprintf( result, "%s%s", arg[0], arg[1] );
281
if( hash == 525 ) goto ARITH; /* $arithl() */
282
if( hash == 537 ) goto LEN; /* $strlen() - same as $len() */
283
if( hash == 540 ) goto EXT_DATE; /* $dateadd() */
285
if( hash == 569 ) { /* $getenv(envvarname) - get the contents of shell environment variable */
288
s = getenv( arg[0] );
289
if( s == NULL ) strcpy( result, "" );
291
strncpy( result, s, 255 );
292
result[ 255 ] = '\0';
299
else if( hash < 800 ) {
301
if( hash == 621 ) goto EXT_TIME; /* $timesec() */
302
if( hash == 625 ) goto EXT_SQL; /* $sqlrow() */
304
if( hash == 649 ) { /* $nmember(n,list) - return nth member of commalist. */
311
GL_getseg( tok, s, &i, Sep ); /* parse list */
312
if( tok[0] == '\0' ) { strcpy( result, "" ); break; }
313
else if( j == n ) { sprintf( result, "%s", tok ); break; }
318
if( hash == 665 ) goto EXT_DATE; /* $datecmp() */
319
if( hash == 706 ) goto EXT_TIME; /* $frommin() */
320
if( hash == 753 ) goto EXT_TIME; /* $timediff() */
321
if( hash == 795 ) goto EXT_DATE; /* $daysdiff() */
325
else if( hash < 1000 ) {
327
if( hash == 881 ) { /* $isnumber(s) - result is 1 if argument is a valid number, 0 if not. */
328
if( name[1] == 'y' ) goto EXT_DATE; /* $yearsold() */
329
if( arg[0][0] == '\0' ) { sprintf( result, "0" ) ; return( 0 ); }
330
stat = GL_goodnum( arg[0], &i );
331
sprintf( result, "%d", stat );
336
if( hash == 881 ) goto EXT_DATE; /* $yearsold() */
338
if( hash == 916 ) { /* $contains(clist,s) - if string s contains any of chars in clist, result is position
339
* (first=1) of first occurance. Result is 0 if none found. */
340
sprintf( result, "%d", GL_contains( arg[0], arg[1] ) );
345
if( hash == 942 ) { /* $makelist( s ) - convert white-space separated list to commalist */
347
strcpy( result, "" );
350
strcpy( tok, GL_getok( arg[0], &ix ) );
351
if( tok[0] == '\0' ) break;
352
if( tok[ strlen( tok ) - 1 ] == ',' ) tok[ strlen( tok ) - 1 ] = '\0';
353
GL_addmember( tok, result );
358
if( hash == 992 ) goto EXT_DATE; /* $datevalid() */
365
if( hash == 1000 ) { /* $addmember(newmem,list) - append newmem to the end of comma-delimited list. */
366
strcpy( result, arg[1] );
367
GL_addmember( arg[0], result );
371
if( hash == 1002 ) goto EXT_TIME; /* $timevalid() */
373
if( hash == 1006 ) goto EXT_SH; /* $shellrow() */
375
if( hash == 1011 ) { /* $numgroup( f, h, mode ) truncate f to the nearest multiple of h that is less than f.
376
* mode may be either low, middle, or high. For example, if f is 73 and h is 10, function
377
* returns 70, 75, or 80 for modes low, middle, high respectively */
379
double ofs, f, h, modf;
383
if( arg[2][0] == 'm' ) ofs = h / 2.0;
384
else if( arg[2][0] == 'h' ) ofs = h;
386
sprintf( result, "%g", (f - modf) + ofs );
391
if( hash == 1053 ) goto EXT_DATE; /* $jultodate() */
393
if( hash == 1151 ) { /* $substring(s,from,nchar) - result is a substring, e.g. $substring(abcde,3,99) --> cde */
394
GL_substring( result, arg[0], atoi( arg[1] ), atoi( arg[2] ) );
398
if( hash == 1168 ) goto EXT_SQL; /* $sqlprefix() */
400
if( hash == 1182 ) { /* $autoround(val,d) - round val to reasonable precision */
401
strcpy( result, arg[0] );
402
GL_autoround( result, atoi( arg[1] ) );
409
else if( hash < 1400 ) {
411
if( hash == 1205 ) { /* $htmlquote( v1, .. vN ) - convert embedded quotes (") to " for all variables given */
412
for( i = 0; i < nargs; i++ ) {
413
stat = TDH_getvalue( tok, arg[i], TDH_dat, TDH_recid );
414
GL_substitute( "\"", """, tok );
415
stat = TDH_setvalue( arg[i], tok, TDH_dat, TDH_recid );
417
sprintf( result, "0" );
421
if( hash == 1215 ) goto EXT_DATE; /* $dategroup() */
422
if( hash == 1252 ) goto EXT_DATE; /* $formatdate() */
424
if( hash == 1269 ) { /* $uniquename() - result is a unique name based on date, time, and pid() */
425
GL_make_unique_string( result, 0 );
429
if( hash == 1293 ) goto EXT_DATE; /* $todaysdate() */
430
if( hash == 1348 ) goto EXT_TIME; /* $formattime() */
431
if( hash == 1352 ) goto EXT_DATE; /* $setdatefmt() */
433
if( hash == 1380 ) { /* $fuzzymatch(s,t,tightness) */
434
stat = GL_fuzzymatch( arg[0], arg[1], strlen(arg[1]), atoi( arg[2] ) );
435
sprintf( result, "%d", stat );
440
if( hash == 1397 ) goto EXT_TIME; /* $settimefmt() */
444
else if( hash < 1600 ) {
446
if( hash == 1461 ) { /* $extractnum( s ) - extract the first numeric entity embedded anywhere in s */
448
for( i = 0, len = strlen( arg[0] ); i < len; i++ ) if( isdigit( arg[0][i] ) ) break;
449
if( i == len ) strcpy( result, "" );
450
else sprintf( result, "%g", atof( &arg[0][i] ) );
454
if( hash == 1458 ) { /* $tmpfilename(tag) - return a tmp file name using tmpdir from config file */
455
GL_make_unique_string( tok, 0 );
456
if( arg[0][0] != '\0' ) strcat( arg[0], "." );
457
sprintf( result, "%s%c%s%s", TDH_tmpdir, PATH_SLASH, arg[0], tok );
462
if( hash == 1518 ) { /* $changechars(clist,s,newchar) - if string s contains any of chars in clist,
463
* change that character to newchar */
464
strcpy( tok, arg[1] );
465
GL_changechars( arg[0], tok, arg[2] );
466
sprintf( result, "%s", tok );
470
if( hash == 1528 ) { /* $fileexists( dir, name ) - return 1 if the requested file can be opened, 0 if not.
471
* dir is a symbol indicating what directory name is relative to (see docs) */
473
if( strcmp( arg[0], "/" )==0 ) sprintf( tok, "%s", arg[1] );
474
else if( strcmp( arg[0], "scriptdir" )==0 ) sprintf( tok, "%s%c%s", TDH_scriptdir, PATH_SLASH, arg[1] );
476
else if( strcmp( arg[0], "datadir" )==0 ) sprintf( tok, "%s%c%s", DB_datapath, PATH_SLASH, arg[1] );
478
else if( strcmp( arg[0], "tmpdir" )==0 ) sprintf( tok, "%s%c%s", TDH_tmpdir, PATH_SLASH, arg[1] );
479
testfp = fopen( tok, "r" );
480
if( testfp == NULL ) strcpy( result, "0" );
482
strcpy( result, "1" );
489
if( hash == 1563 ) { /* $deletechars(clist,s) - if string s contains any of chars in clist,
490
* delete that character */
491
strcpy( tok, arg[1] );
492
GL_deletechars( arg[0], tok );
493
sprintf( result, "%s", tok );
498
else if( hash < 2000 ) {
500
if( hash == 1607 ) goto EXT_SQL; /* $sqlgetnames */
502
if( hash == 1625 ) { /* $formatfloat(n,format) */
503
sprintf( result, arg[1], atof( arg[0] ) );
507
if( hash == 1708 ) { /* $htmldisplay( var1, .. varN ) - convert embedded HTML problem chars (<,>,&)
508
* to their html esc sequences for all variables given */
510
for( i = 0; i < nargs; i++ ) {
511
stat = TDH_getvalue( tok, arg[i], TDH_dat, TDH_recid );
512
if( strchr( tok, '&' ) != NULL ) GL_substitute( "&", "&", tok );
513
if( strchr( tok, '<' ) != NULL ) GL_substitute( "<", "<", tok );
514
if( strchr( tok, '>' ) != NULL ) GL_substitute( ">", ">", tok );
515
stat = TDH_setvalue( arg[i], tok, TDH_dat, TDH_recid );
517
sprintf( result, "0" );
521
if( hash == 1741 ) { /* $homogeneous( s ) - if all members of s are same, return 1 */
526
GL_getseg( firsttok, arg[0], &ix, Sep ); /* parse list */
527
if( firsttok[0] == '\0' ) { sprintf( result, "0" ); return( 0 ); }
529
GL_getseg( tok, arg[0], &ix, Sep ); /* parse list */
530
if( tok[0] == '\0' ) break;
531
if( strcmp( tok, firsttok )!=0 ) { sprintf( result, "0" ); return( 0 ); }
533
sprintf( result, "1" );
537
if( hash == 1882 ) goto EXT_SQL; /* $sqlrowcount() */
539
if( hash == 1983 ) goto EXT_DATE; /* $setdateparms() */
543
if( hash == 2155 ) goto EXT_CHKSUM; /* $checksumnext() */
544
if( hash == 2182 ) goto EXT_CHKSUM; /* $checksumvalid() */
546
if( hash == 2268 ) { /* $commonmembers( list1, list2 ) - return # of members in common between 2 lists */
548
if( strcmp( arg[2], "count" )==0 ) mode = 0;
550
sprintf( result, "%d", GL_commonmembers( arg[0], arg[1], mode ) );
555
if( hash == 2412 ) goto EXT_CHKSUM; /* $checksumencode() */
556
if( hash == 2554 ) goto EXT_SH; /* $shellreadheader() */
557
if( hash == 2569 ) goto EXT_SH; /* $shellrowcount() */
558
if( hash == 2686 ) goto EXT_SH; /* $shellfielddelim() */
560
if( hash == 2831 ) goto EXT_SQL; /* $sqlstripprefix() */
561
if( hash == 3084 ) goto EXT_SH; /* $shellstripchars() */
566
/* if we reach here, we have a custom function.. */
568
if( name[1] == '$' ) stat = custom_function( &name[2], arg, nargs, result, typ );
569
else stat = custom_function( &name[1], arg, nargs, result, typ );
570
if( stat != 0 ) err( 1602, "unrecognized function", name );
577
return( DT_datefunctions( hash, name, arg, nargs, result, typ ) );
580
return( DT_timefunctions( hash, name, arg, nargs, result, typ ) );
584
return( TDH_dbfunctions( hash, name, arg, nargs, result, typ, TDH_dat, TDH_recid ) );
588
return( TDH_shfunctions( hash, name, arg, nargs, result, typ, TDH_dat, TDH_recid ) );
591
return( GL_checksum_functions( hash, name, arg, nargs, result, typ ) );
596
/* ==================== */
597
TDH_function_listsep( sepchar )
added
removed
src/functions.c
