From: glyn <glyn@8kb.co.uk>
Date: Mon, 5 Oct 2015 15:26:46 +0000 (+0100)
Subject: Amend functionality of antiquated matrix methods and minor changes to matrix parsing...
X-Git-Url: https://git.8kb.co.uk/?a=commitdiff_plain;h=67d1bf8be782956ec104758872a300e934b80895;p=dataflex%2Fdf32func
Amend functionality of antiquated matrix methods and minor changes to matrix parsing functions.
---
diff --git a/src/c/gnuregex.c b/src/c/gnuregex.c
index f0f2dea..f5cce37 100644
--- a/src/c/gnuregex.c
+++ b/src/c/gnuregex.c
@@ -31,7 +31,7 @@ static char * quote_output(char *str) {
/* Check for characters that need quoting */
for (ptr = str; *ptr; ptr++) {
char ch = *ptr;
- if (ch == '\"' || ch =='\\' || ch == '\{' || ch == ',') {
+ if (ch == '"' || ch =='\\' || ch == '{' || ch == ',') {
do_quote = 1;
break;
}
@@ -118,11 +118,11 @@ static int compile_regex(regex_t *re, const char *pattern, const char *flags, in
status = regcomp(re, pattern, cflags);
if (status != REG_NOERROR) {
- if (errors == 1) {
- char error_message[MAX_ERROR_MSG];
- regerror (status, re, error_message, MAX_ERROR_MSG);
- fprintf (stderr, "Regex error compiling '%s': %s\n", pattern, error_message);
- }
+ if (errors == 1) {
+ char error_message[MAX_ERROR_MSG];
+ regerror (status, re, error_message, MAX_ERROR_MSG);
+ fprintf (stderr, "Regex error compiling '%s': %s\n", pattern, error_message);
+ }
}
return status;
}
@@ -300,7 +300,7 @@ int regexp_match(const char *str, const char *pattern, const char *flags, int er
if (!result) /* match */
return 1;
else /* no match */
- return 0;
+ return 0;
}
else /* error condition, but still: no match */
return 0;
diff --git a/src/df32/data.inc b/src/df32/data.inc
index 14eafd7..5f80d00 100644
--- a/src/df32/data.inc
+++ b/src/df32/data.inc
@@ -790,7 +790,10 @@ end_class
//
// Send message methods:
// delete_data - Clear the matrix
-// matrix_sort - Y pos to sort on
+// [obsolete] matrix_sort - Y pos to sort on, ASC OR DESC
+// sort_items - Y pos to sort on, ASC OR DESC (auto detects)
+// sort_items_ascii - Y pos to sort on, ASC OR DESC (ascii)
+// sort_items_num - Y pos to sort on, ASC OR DESC (numeric)
// matrix_delete - X and Y pos to delete
// delete_item - X position to delete (this reshuffles the matrix; avoid using)
// hash_on_column_algorithm - Hash algorithm to use
@@ -799,8 +802,10 @@ end_class
// hash_is_unique - Add a unique constraint on the hash
// remove_hash_is_unique - Remove a unique constraint from the hash
// matrix_index_lookup_clear - Clear the lookup buffer
-// matrix_append_csv - Append some data in CSV format to the array E.g. ('My Name,"My,\"address\""')
-// matrix_copy_csv - Copy csv data from sprecified file into matrix
+// matrix_append_csv - Append some data in CSV format to the array E.g. ('My Name,"My,\"address\""')
+// matrix_copy_csv_in - Copy csv data from specified file into matrix
+// matrix_copy_csv_in_header - Copy csv data with header from specified file into matrix
+// matrix_copy_csv_out - Copy csv data from matrix into specified file
//
// Set methods:
// matrix_value - Set a value at X, Y
@@ -817,8 +822,8 @@ end_class
// matrix_index_lookup_clear - Clear the buffer for an indexed lookup
// matrix_index_count_from_value - Get a count of rows with a particular value
// matrix_index_from_value - Get the next X pos (row) with indexed value. Returns -1 when nothing left to find.
-// item_count - Get count of rows in matrix
-// item_width - Get count of columns in matrix
+// item_count - Get count of rows in matrix
+// item_width - Get count of columns in matrix
//
// Example usage:
//
@@ -828,8 +833,11 @@ end_class
// set matrix_value of (test(current_object)) item 0 item 1 to "1" - x then y pos to Value
// get matrix_value of (test(current_object)) item 0 item 1 to tmpStr - x then y pos to Value
// send matrix_append_csv to test ('My Name,"My,\"address\""') - Append CSV data to the end of the matrix
-// send matrix_copy_csv to (test(current_object)) "f:\data.csv" - Copy data from csv file into matrix
-// send matrix_sort to (test(current_object)) 1 - x then y pos to sort by
+// send matrix_copy_csv_in to (test(current_object)) "f:\data.csv" - Copy data from csv file into matrix
+// [obsolete] send matrix_sort to (test(current_object)) 1 ASC - y pos to sort by, ASCENDING/DESCENDING
+// send sort_items to (test(current_object)) 1 - y pos to sort by, ASCENDING/DESCENDING (auto)
+// send sort_items_ascii to (test(current_object)) 1 - y pos to sort by, ASCENDING/DESCENDING (ascii)
+// send sort_items_num to (test(current_object)) 1 - y pos to sort by, ASCENDING/DESCENDING (numeric)
// send matrix_delete to (test(current_object)) 1 1 - x then y pos to delete
// send matrix_delete_row to (test(current_object)) 1 - x essentially blanks record out, no reshuffle
// send delete_item to (test(current_object)) 1 - x pos (not v efficient), reshuffles
@@ -846,7 +854,7 @@ end_class
// get matrix_index_from_value of (test(current_object)) item "1" to x_pos
// get matrix_indextable_from_value of (test(current_object)) item "1" to tmpStr
// get matrix_hash_from_value of (test(current_object)) item "1" to tmpInt
-// get item_count of (test(current_object) to tmpInt
+// get item_count of (test(current_object) to tmpInt
// get item_width of (test(current_object) to tmpInt
class matrix is an array
@@ -869,7 +877,22 @@ class matrix is an array
set c_iLastIndexTableHash to -1
set c_iLastIndexTablePos to -1
set c_iEnforceUnique to 0
- end_procedure
+ end_procedure
+
+ // Pull the value of a column from the string representation
+ function column_value integer itemy string row
+ local string l_sResult
+ local integer l_i
+
+ move row to l_sResult
+
+ for l_i from 0 to (itemy-1)
+ move (right(l_sResult,length(l_sResult)-pos(character(1),l_sResult))) to l_sResult
+ loop
+ move (left(l_sResult,pos(character(1),l_sResult)-1)) to l_sResult
+
+ function_return l_sResult
+ end_function
procedure hash_on_column_algorithm string hashalg
if ((hashalg = "hash_reduced_djb2") or (hashalg = "hash_reduced_sdbm") or (hashalg = "hash_reduced_lazy") or (hashalg = "hash_for_df_arrays") or (hashalg = "")) begin
@@ -914,10 +937,9 @@ class matrix is an array
for l_i from 0 to l_iMax
forward get array_value item l_i to l_sBuf
-
- send delete_data to (mTokens(current_object))
- send set_string to (mTokens(current_object)) l_sBuf (character(1))
- get token_value of (mTokens(current_object)) item l_iColumn to l_sTmp
+
+ get column_value item l_iColumn item l_sBuf to l_sTmp
+
get insert_hash of (mHash_table(current_object)) item l_sTmp to l_iHash
get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp
@@ -951,6 +973,8 @@ class matrix is an array
if (l_iHashOn <> -1) begin
set c_iHashOn to -1
+ set c_iLastIndexTableHash to -1
+ set c_iLastIndexTablePos to -1
send destroy_object to (mHash_array(current_object))
send destroy_object to (mHash_table(current_object))
end
@@ -1034,102 +1058,139 @@ class matrix is an array
end_procedure
procedure matrix_append_csv string row
- local integer l_iMax l_iValues l_i
+ local integer l_iMax l_iValues l_i l_iHashOn l_iWidth l_iCount
local string l_sBuf
+ get c_iHashOn to l_iHashOn
forward get item_count to l_iMax
-
- send delete_data to (mTokens2(current_object))
- send set_string_csv to (mTokens2(current_object)) row
- get token_count of (mTokens2(current_object)) to l_iValues
-
- for l_i from 0 to l_iValues
- get token_value of (mTokens2(current_object)) item l_i to l_sBuf
- indicate err false
- set matrix_value item l_iMax item l_i to l_sBuf
- if (err) forward send delete_item l_iMax
- if (err) break
- loop
+
+ if ((l_iHashOn <> -1) or (row contains '"')) begin
+ send delete_data to (mTokens2(current_object))
+ send set_string_csv to (mTokens2(current_object)) row
+ get token_count of (mTokens2(current_object)) to l_iValues
+
+ for l_i from 0 to l_iValues
+ get token_value of (mTokens2(current_object)) item l_i to l_sBuf
+ indicate err false
+ set matrix_value item l_iMax item l_i to l_sBuf
+ if (err) forward send delete_item l_iMax
+ if (err) break
+ loop
+ end
+ else begin
+ get c_iWidth to l_iWidth
+ move 0 to l_iCount
+ forward set array_value item l_iMax to (replaces(',', row, character(1)))
+ for l_i from (pos(',', row)) to (length(row))
+ if (mid(row,1,l_i) = ',') increment l_iCount
+ loop
+ if (l_iCount > l_iWidth) set c_iWidth to l_iCount
+ end
end_procedure
+
+ procedure matrix_copy_csv_worker string fname integer offset
+ local string l_sBuf
+ local integer l_i
+
+ move 0 to l_i
+ if (does_exist(fname)) begin
+ direct_input channel DEFAULT_FILE_CHANNEL fname
+ while not (seqeof)
+ readln channel DEFAULT_FILE_CHANNEL l_sBuf
+ increment l_i
+ if (l_i <= offset) break begin
+ if (seqeof) break
+ if (trim(l_sBuf) <> "") begin
+ send matrix_append_csv l_sBuf
+ end
+ loop
+ close_input channel DEFAULT_FILE_CHANNEL
+ end
+ else;
+ custom_error ERROR_CODE_FILE_NOT_FOUND$ ERROR_MSG_FILE_NOT_FOUND ERROR_DETAIL_FILE_NOT_FOUND fname
+
+ end_procedure
- procedure matrix_copy_csv string fname
- local string l_sBuf
-
- if (does_exist(fname)) begin
- direct_input channel DEFAULT_FILE_CHANNEL fname
- while not (seqeof)
- readln channel DEFAULT_FILE_CHANNEL l_sBuf
- if (seqeof) break
- if (trim(l_sBuf) <> "") begin
- send matrix_append_csv l_sBuf
- end
- loop
- close_input channel DEFAULT_FILE_CHANNEL
- end
- else;
- custom_error ERROR_CODE_FILE_NOT_FOUND$ ERROR_MSG_FILE_NOT_FOUND ERROR_DETAIL_FILE_NOT_FOUND fname
- end_procedure
-
- function matrix_string integer itemx integer itemy returns string
- local string l_sBuf l_sTmp
+ procedure matrix_copy_csv_in string fname
+ send matrix_copy_csv_worker fname 0
+ end_procedure
- forward get array_value item itemx to l_sBuf
+ procedure matrix_copy_csv_in_header string fname
+ send matrix_copy_csv_worker fname 1
+ end_procedure
- send delete_data to (mTokens(current_object))
- send set_string to (mTokens(current_object)) l_sBuf (character(1))
- get token_value of (mTokens(current_object)) item itemy to l_sTmp
+ procedure matrix_copy_csv_out string fname
+ local integer l_iMax l_i l_j l_iValues
+ local string l_sBuf
- function_return l_sTmp
- end_function
+ forward get item_count to l_iMax
+
+ direct_output channel DEFAULT_FILE_CHANNEL fname
+ for l_i from 0 to l_iMax
+ forward get string_value item l_i to l_sBuf
+ if (l_sBuf <> "") begin
+ if ((l_sBuf contains '"') or (l_sBuf contains ',')) begin
+ send delete_data to (mTokens2(current_object))
+ send set_string to (mTokens2(current_object)) l_sBuf (character(1))
+ get token_count of (mTokens2(current_object)) to l_iValues
+
+ for l_j from 0 to l_iValues
+ get token_value of (mTokens2(current_object)) item l_j to l_sBuf
+ if (l_j <> 0);
+ write channel DEFAULT_FILE_CHANNEL ','
+ if (l_sBuf contains '"');
+ write channel DEFAULT_FILE_CHANNEL ('"'+(replaces('"', l_sBuf, '\"'))+'"')
+ else;
+ write channel DEFAULT_FILE_CHANNEL l_sBuf
+ loop
+ writeln channel DEFAULT_FILE_CHANNEL ""
+ end
+ else;
+ writeln channel DEFAULT_FILE_CHANNEL (replaces(character(1), l_sBuf, ','))
+ end
+ loop
+ close_output channel DEFAULT_FILE_CHANNEL
+ end_procedure
+
function matrix_value integer itemx integer itemy returns string
local string l_sBuf l_sTmp
forward get array_value item itemx to l_sBuf
+ get column_value item itemy item l_sBuf to l_sTmp
- send delete_data to (mTokens(current_object))
- send set_string to (mTokens(current_object)) l_sBuf (character(1))
- get token_value of (mTokens(current_object)) item itemy to l_sTmp
+ function_return l_sTmp
+ end_function
+
+ function matrix_string integer itemx integer itemy returns string
+ local string l_sTmp
+
+ get matrix_value item itemx item itemy to l_sTmp
function_return l_sTmp
end_function
function matrix_integer integer itemx integer itemy returns integer
- local string l_sBuf
local integer l_iTmp
-
- forward get array_value item itemx to l_sBuf
- send delete_data to (mTokens(current_object))
- send set_string to (mTokens(current_object)) l_sBuf (character(1))
- get token_value of (mTokens(current_object)) item itemy to l_iTmp
+ get matrix_value item itemx item itemy to l_iTmp
function_return l_iTmp
end_function
function matrix_number integer itemx integer itemy returns number
- local string l_sBuf
local number l_nTmp
- forward get array_value item itemx to l_sBuf
-
- send delete_data to (mTokens(current_object))
- send set_string to (mTokens(current_object)) l_sBuf (character(1))
- get token_value of (mTokens(current_object)) item itemy to l_nTmp
+ get matrix_value item itemx item itemy to l_nTmp
function_return l_nTmp
end_function
function matrix_real integer itemx integer itemy returns real
- local string l_sBuf
local real l_rTmp
- forward get array_value item itemx to l_sBuf
-
- send delete_data to (mTokens(current_object))
- send set_string to (mTokens(current_object)) l_sBuf (character(1))
- get token_value of (mTokens(current_object)) item itemy to l_rTmp
+ get matrix_value item itemx item itemy to l_rTmp
function_return l_rTmp
end_function
@@ -1177,6 +1238,7 @@ class matrix is an array
get c_iHashOn to l_iHashOn
move -1 to l_iIndex
+ move 0 to l_iLastIndexTablePos
if (l_iHashOn <> -1) begin
get find_hash of (mHash_table(current_object)) item val to l_iHash
@@ -1208,7 +1270,7 @@ class matrix is an array
end_function
function matrix_index_count_from_value string val returns integer
- local integer l_iHashOn l_iHash l_iIndexValues
+ local integer l_iHashOn l_iHash l_iIndexValues l_i
local string l_sIndexTable
get c_iHashOn to l_iHashOn
@@ -1217,12 +1279,14 @@ class matrix is an array
get find_hash of (mHash_table(current_object)) item val to l_iHash
get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable
- send delete_data to (mTokens(current_object))
- send set_string to (mTokens(current_object)) l_sIndexTable "|"
- get token_count of (mTokens(current_object)) to l_iIndexValues
+ move 0 to l_iIndexValues
+ for l_i from 1 to (length(l_sIndexTable))
+ if (mid(l_sIndexTable,1,l_i) = '|');
+ increment l_iIndexValues
+ loop
end
- function_return l_iIndexValues
+ function_return (l_iIndexValues-1)
end_function
procedure set item_count integer newVal
@@ -1230,9 +1294,9 @@ class matrix is an array
end_procedure
function item_width returns integer
- local integer l_iWidth
- get c_iWidth to l_iWidth
- function_return l_iWidth
+ local integer l_iWidth
+ get c_iWidth to l_iWidth
+ function_return l_iWidth
end_function
procedure matrix_delete integer itemx integer itemy
@@ -1343,12 +1407,17 @@ class matrix is an array
forward send delete_item to current_object itemx
end_procedure
- procedure matrix_sort integer itemy string order
+ // The routine below relies on the internal dataflex sort, doing
+ // what is essentially a nested loop join on the result and rebuilding
+ // the original matrix. It's pretty awful and is only left here for
+ // reference. Behaviour isn't quite quadratic, a feeble guess is
+ // something like O( (2N + Nlog(n) + N^1.8) :-(
+ procedure matrix_sort integer itemy string order
local string l_sBuf l_sTmp l_sTmp2 l_sHash
local integer l_iX l_i l_j l_iMax l_iPoolMax l_iWidth l_iThrow l_iNumCount l_iHashOn l_iHash
move (trim(uppercase(order))) to order
- if ((order <> "ASCENDING") and (order <> "DESCENDING")) move "ASCENDING" to order
+ if ((left(order,3) <> "ASC") and (left(order,4) <> "DESC")) move "ASCENDING" to order
object mSort_array is an array
end_object
@@ -1363,6 +1432,7 @@ class matrix is an array
send delete_data to (mClone_array(current_object))
if (l_iHashOn <> -1) begin
+ //Zero the hash
send delete_data to (mHash_array(current_object))
end
@@ -1377,9 +1447,8 @@ class matrix is an array
move 0 to l_iNumCount
for l_j from 1 to (length(l_sTmp))
- if (((ascii(mid(l_sTmp,1,l_j))) >= 48) and ((ascii(mid(l_sTmp,1,l_j))) <= 57) or ((ascii(mid(l_sTmp,1,l_j))) = 46)) begin
- increment l_iNumCount
- end
+ if not (((ascii(mid(l_sTmp,1,l_j))) >= 48) and ((ascii(mid(l_sTmp,1,l_j))) <= 57) or ((ascii(mid(l_sTmp,1,l_j))) = 46)) break
+ increment l_iNumCount
loop
if ((length(l_sTmp) > 0) and (length(l_sTmp) = l_iNumCount)) begin
set array_value of (mSort_array(current_object)) item l_i to (number(l_sTmp))
@@ -1390,11 +1459,13 @@ class matrix is an array
end
loop
- if (order = "ASCENDING") send sort_items to (mSort_array(current_object)) ascending
- if (order = "DESCENDING") send sort_items to (mSort_array(current_object)) descending
+ //Rely on dataflex sort
+ if (left(order,3) = "ASC") send sort_items to (mSort_array(current_object)) ascending
+ if (left(order,4) = "DESC") send sort_items to (mSort_array(current_object)) descending
move l_iMax to l_iPoolMax
+ // Nested loop join, sort of. Not good :-(
for l_i from 0 to l_iMax
get array_value of (mSort_array(current_object)) item l_i to l_sTmp
if (l_sTmp = character(2)) move "" to l_sTmp
@@ -1416,7 +1487,7 @@ class matrix is an array
forward send delete_item to current_object l_iPoolMax
decrement l_iPoolMax
- // Remap hash
+ // Rebuild hash
if (l_iHashOn <> -1) begin
get token_value of (mTokens(current_object)) item l_iHashOn to l_sHash
get find_hash of (mHash_table(current_object)) item l_sHash to l_iHash
@@ -1442,6 +1513,132 @@ class matrix is an array
send destroy_object to (mSort_array(current_object)) // Use "send request_destroy_object" to destroy object and all children.
send destroy_object to (mClone_array(current_object))
end_procedure
+
+
+ // Recursive partition for quicksort.
+ // Dataflex arrays track the type of each row and perform a sort acordingly
+ // but we have no easy way of knowing. So perform compare based on what a
+ // value looks "like" unless told otherwise.
+ // Index from (lo_in), index to (hi_in), numeric/string mode (1=integer, 0=string), invert (1=descending, 0=ascending)
+ procedure partition integer lo_in integer hi_in integer mode integer itemy integer invert
+ local integer pivot lo_idx hi_idx t
+ local string pivot_val lo_row hi_row lo_val hi_val
+
+ if ((hi_in-lo_in) > 0) begin
+ move lo_in to lo_idx
+ move hi_in to hi_idx
+ move ((lo_in+hi_in)/2) to pivot
+
+ while ((lo_idx <= pivot) AND (hi_idx >= pivot))
+
+ forward get array_value item pivot to pivot_val
+ get column_value item itemy item pivot_val to pivot_val
+
+ forward get array_value item lo_idx to lo_row
+ get column_value item itemy item lo_row to lo_val
+
+ forward get array_value item hi_idx to hi_row
+ get column_value item itemy item hi_row to hi_val
+
+
+ if (invert) begin
+ while ( ( ((mode) and (number(lo_val) > number(pivot_val))) or (not (mode) and (lo_val > pivot_val))) and (lo_idx <= pivot))
+ increment lo_idx
+ forward get array_value item lo_idx to lo_row
+ get column_value item itemy item lo_row to lo_val
+ loop
+ while ( ( ((mode) and (number(hi_val) < number(pivot_val))) or (not (mode) and (hi_val < pivot_val))) and (hi_idx >= pivot))
+ decrement hi_idx
+ forward get array_value item hi_idx to hi_row
+ get column_value item itemy item hi_row to hi_val
+ loop
+ end
+ else begin
+ while ( ( ((mode) and (number(lo_val) < number(pivot_val))) or (not (mode) and (lo_val < pivot_val))) and (lo_idx <= pivot))
+ increment lo_idx
+ forward get array_value item lo_idx to lo_row
+ get column_value item itemy item lo_row to lo_val
+ loop
+ while ( ( ((mode) and (number(hi_val) > number(pivot_val))) or (not (mode) and (hi_val > pivot_val))) and (hi_idx >= pivot))
+ decrement hi_idx
+ forward get array_value item hi_idx to hi_row
+ get column_value item itemy item hi_row to hi_val
+ loop
+ end
+
+ forward set array_value item lo_idx to hi_row
+ forward set array_value item hi_idx to lo_row
+
+ increment lo_idx
+ decrement hi_idx
+
+ if ((lo_idx-1) = pivot) begin
+ increment hi_idx
+ move hi_idx to pivot
+ end
+ else if ((hi_idx+1) = pivot) begin
+ decrement lo_idx
+ move lo_idx to pivot
+ end
+
+ loop
+
+ if ((pivot-lo_in) > 1);
+ send partition lo_in (pivot-1) mode itemy invert
+ if ((hi_in-pivot) > 1);
+ send partition (pivot+1) hi_in mode itemy invert
+ end
+ end_procedure
+
+ // Perform a quick sort on a perticular column (y) in the martix
+ // This is done in native dataflex, so no match for compiled C
+ procedure quick_sort integer itemy string order integer mode
+ local integer l_i l_j l_iHashOn l_iMax l_iInvert
+ local string l_sBuf
+
+ if (uppercase(left(trim(order),4)) = "DESC") move 1 to l_iInvert
+ else move 0 to l_iInvert
+
+ get item_count to l_iMax
+
+ // If we've not been told string/numeric, try and work out here.
+ if (mode = -1) begin
+ for l_i from 0 to (l_iMax-1)
+ forward get array_value item l_i to l_sBuf
+ get column_value item itemy item l_sBuf to l_sBuf
+ move (is_number(l_sBuf)) to mode
+ if (mode = 0) break
+ loop
+ end
+
+ // Remove the current hash index if there is one
+ get c_iHashOn to l_iHashOn
+ if (l_iHashOn <> -1);
+ send remove_hash_on_column
+
+ // Do the quick-sort
+ send partition 0 (l_iMax-1) mode itemy l_iInvert
+
+ // Recreate any the hash if there was one
+ if (l_iHashOn <> -1);
+ send hash_on_column l_iHashOn
+
+ end_procedure
+
+ //Wrapper for sort_items
+ procedure sort_items integer itemy string order
+ send quick_sort itemy order -1
+ end_procedure
+
+ //Wrapper for sort_items
+ procedure sort_items_ascii integer itemy string order
+ send quick_sort itemy order 0
+ end_procedure
+
+ //Wrapper for sort_items
+ procedure sort_items_num integer itemy string order
+ send quick_sort itemy order 1
+ end_procedure
end_class
diff --git a/src/df32/df32func.inc.autodoc b/src/df32/df32func.inc.autodoc
index d2df0a8..31f5cd9 100644
--- a/src/df32/df32func.inc.autodoc
+++ b/src/df32/df32func.inc.autodoc
@@ -1,4 +1,4 @@
-df32func.inc last compiled on 25/09/2015 at 14:46:00.74
+df32func.inc last compiled on 05/10/2015 at 15:44:49.94
df32func DLL functions:
df32func.h:external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer
df32func.h:external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer
@@ -142,6 +142,7 @@ regex.inc:function regexp_matches global string str string pattern string flags
regex.inc:function regexp_replace global string str string pattern string replacement string flags returns string
regex.inc:function regexp_matches_count global string argv returns integer
regex.inc:function regexp_matches_item global string argv integer argv2 returns string
+regex.inc:function regexp_matches_item_stripped global string argv integer argv2 returns string
string.inc:function titlecase global string argv returns string
string.inc:function replaceall global string argv string argv2 string argv3 returns string
string.inc:function zeropad global string argv integer argv2 returns string
@@ -154,6 +155,8 @@ string.inc:function sanitize_num global number l_nInput returns integer
string.inc:function sanitize_str global string l_sInput string l_sLevel returns string
string.inc:function nbstring global string argv string argv2 returns string
string.inc:function msxsl global string engine string source string stylesheet string params string outfile returns string
+string.inc:function is_number global string argv returns integer
+string.inc:function is_integer global string argv returns integer
tstamp.inc:function timestemp_to_posix global string inTs returns number
tstamp.inc:function posix_to_timestamp global number argv returns string
tstamp.inc:function timestamp_adjust global string inTs number inMSeconds returns string
diff --git a/src/df32/regex.inc b/src/df32/regex.inc
index a0f9b5c..32e0010 100644
--- a/src/df32/regex.inc
+++ b/src/df32/regex.inc
@@ -22,144 +22,182 @@
//-------------------------------------------------------------------------
// All the regex function accept a set of flags, this can be one or more of:
-// g = Perform match against each substring rather than just the first (greedy)
-// n = Perform newline-sensitive matching
-// i = Perform cases insensitive matching
+// g = Perform match against each substring rather than just the first (greedy)
+// n = Perform newline-sensitive matching
+// i = Perform cases insensitive matching
//Purely check if a regex expression produces match in the input string
// Returns 1 on match, 0 on no match
-// E.g
+// E.g
// move (regexp_match('the quick brown fox jumps over the lazy dog.', 'fox', 'g'))
function regexp_match global string str string pattern string flags returns integer
- local integer l_iReturn
- local pointer l_pStr l_pPattern l_pFlags
-
- getaddress of str to l_pStr
- getaddress of pattern to l_pPattern
- getaddress of flags to l_pFlags
-
- move (RegexpMatch(l_pStr, l_pPattern, l_pFlags, ERRORS_TO_STDERR)) to l_iReturn
-
- function_return l_iReturn
+ local integer l_iReturn
+ local pointer l_pStr l_pPattern l_pFlags
+
+ getaddress of str to l_pStr
+ getaddress of pattern to l_pPattern
+ getaddress of flags to l_pFlags
+
+ move (RegexpMatch(l_pStr, l_pPattern, l_pFlags, ERRORS_TO_STDERR)) to l_iReturn
+
+ function_return l_iReturn
end_function
//Return a string containing all regex matches in the input string
// E.g
// move (regexp_matches('the quick brown fox jumps over the la\{zy d"og.', 'fox|(the)|brown|(la\\\{zy)|(d"og)', 'g')) to myString
function regexp_matches global string str string pattern string flags returns string
- local integer l_iReturn
- local pointer l_pStr l_pPattern l_pFlags l_pOut
- local string l_sOut l_sReturn
-
- move "" to l_sReturn
- getaddress of str to l_pStr
- getaddress of pattern to l_pPattern
- getaddress of flags to l_pFlags
- zerostring MAX_DFREGEX_BUFFER to l_sOut
- getaddress of l_sOut to l_pOut
-
- move (RegexpMatches(l_pStr, l_pPattern, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn
-
- if (l_iReturn = 0);
- move (cstring(l_sOut)) To l_sReturn
- else begin
- if (l_iReturn = -1);
- custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER
- if (l_iReturn = -2);
+ local integer l_iReturn
+ local pointer l_pStr l_pPattern l_pFlags l_pOut
+ local string l_sOut l_sReturn
+
+ move "" to l_sReturn
+ getaddress of str to l_pStr
+ getaddress of pattern to l_pPattern
+ getaddress of flags to l_pFlags
+ zerostring MAX_DFREGEX_BUFFER to l_sOut
+ getaddress of l_sOut to l_pOut
+
+ move (RegexpMatches(l_pStr, l_pPattern, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn
+
+ if (l_iReturn = 0);
+ move (cstring(l_sOut)) To l_sReturn
+ else begin
+ if (l_iReturn = -1);
+ custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER
+ if (l_iReturn = -2);
custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE
- move "" to l_sReturn
- end
-
- function_return l_sReturn
+ move "" to l_sReturn
+ end
+
+ function_return l_sReturn
end_function
//Perform a replacement on the input string all matches with the given pattern
// E.g.
// move (regexp_replace('22 quick brown foxes jump over the 44 lazy dogs.', '([0-9]*).* (foxes) .* ([0-9]*) .* (dogs).*', 'SELECT build_data(\1,\2), build_data(\3,\4);', 'g')) to myString
function regexp_replace global string str string pattern string replacement string flags returns string
- local integer l_iReturn
- local pointer l_pStr l_pPattern l_pFlags l_pReplacement l_pOut
- local string l_sOut l_sReturn
-
- move "" to l_sReturn
- getaddress of str to l_pStr
- getaddress of pattern to l_pPattern
- getaddress of flags to l_pFlags
- getaddress of replacement to l_pReplacement
- zerostring MAX_DFREGEX_BUFFER to l_sOut
- getaddress of l_sOut to l_pOut
-
- move (RegexpReplace(l_pStr, l_pPattern, l_pReplacement, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn
-
- if (l_iReturn = 0);
- move (cstring(l_sOut)) To l_sReturn
- else begin
- if (l_iReturn = -1);
- custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER
- if (l_iReturn = -2);
+ local integer l_iReturn
+ local pointer l_pStr l_pPattern l_pFlags l_pReplacement l_pOut
+ local string l_sOut l_sReturn
+
+ move "" to l_sReturn
+ getaddress of str to l_pStr
+ getaddress of pattern to l_pPattern
+ getaddress of flags to l_pFlags
+ getaddress of replacement to l_pReplacement
+ zerostring MAX_DFREGEX_BUFFER to l_sOut
+ getaddress of l_sOut to l_pOut
+
+ move (RegexpReplace(l_pStr, l_pPattern, l_pReplacement, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn
+
+ if (l_iReturn = 0);
+ move (cstring(l_sOut)) To l_sReturn
+ else begin
+ if (l_iReturn = -1);
+ custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER
+ if (l_iReturn = -2);
custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE
- move "" to l_sReturn
- end
-
- function_return l_sReturn
+ move "" to l_sReturn
+ end
+
+ function_return l_sReturn
end_function
// Parse an output string from regexp_matches to get the result count
// E.g
// move (regexp_matches_count(myRegexMatchesOutput)) to myInt
function regexp_matches_count global string argv returns integer
- local integer l_iCount l_i
- local string l_sChar l_sLast
-
- move "" to l_sChar
- move "" to l_sLast
- for l_i from 0 to (length(argv))
- move (mid(argv,1,l_i)) to l_sChar
- if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount
- move l_sChar to l_sLast
- loop
-
- function_return l_iCount
+ local integer l_iCount l_i
+ local string l_sChar l_sLast
+
+ move "" to l_sChar
+ move "" to l_sLast
+ for l_i from 0 to (length(argv))
+ move (mid(argv,1,l_i)) to l_sChar
+ if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount
+ move l_sChar to l_sLast
+ loop
+
+ function_return l_iCount
end_function
// Parse an output string from regexp_matches to get the result at an index
+// This can then be treated as csv data.
// E.g
// move (regexp_matches_item(myRegexMatchesOutput,muInt)) to myString
+// object mt is a StringTokenizer
+// end_object
+// move (regexp_matches_count(myString)) to myCount
+// for i from 1 to myCount
+// move (regexp_matches_item(myString,i)) to bufString
+// send delete_data to mt
+// send set_string_csv to mt bufString
+// get token_count of mt to myTokenCount
+// for j from 0 to myTokenCount
+// get token_value of mt item j to bufString
+// showln i "-" j ")" buf
+// loop
+// loop
function regexp_matches_item global string argv integer argv2 returns string
- local integer l_iCount l_i l_iOpen l_iQuot
- local string l_sChar l_sLast l_sNext l_sBuf
-
- move 0 to l_iCount
- move 0 to l_iOpen
- move 0 to l_iQuot
- move "" to l_sLast
- for l_i from 0 to (length(argv))
- move (mid(argv,1,l_i)) to l_sChar
- move (mid(argv,1,l_i-1)) to l_sLast
-
- if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount
- if (l_iCount <> argv2) break begin
+ local integer l_iCount l_i
+ local string l_sChar l_sLast l_sReturn
+
+ move "" to l_sChar
+ move "" to l_sLast
+ move "" to l_sReturn
+ for l_i from 0 to (length(argv))
+ move (mid(argv,1,l_i)) to l_sChar
+ move (mid(argv,1,l_i-1)) to l_sLast
+ if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount
+ if ((l_sChar = '}') and (l_sLast <> '\') and (l_iCount = argv2)) break
+ if (((l_sChar = '{') and (l_sLast <> '\')) or (l_iCount < argv2)) break begin
+
+ append l_sReturn l_sChar
+ loop
+
+ function_return l_sReturn
+end_function
+
+// Parse an output string from regexp_matches to get the result at an index
+// stripping out all escaping.
+// E.g
+// move (regexp_matches_item_stripped(myRegexMatchesOutput,muInt)) to myString
+function regexp_matches_item_stripped global string argv integer argv2 returns string
+ local integer l_iCount l_i l_iOpen l_iQuot
+ local string l_sChar l_sLast l_sNext l_sBuf
+
+ move 0 to l_iCount
+ move 0 to l_iOpen
+ move 0 to l_iQuot
+ move "" to l_sLast
+ for l_i from 0 to (length(argv))
+ move (mid(argv,1,l_i)) to l_sChar
+ move (mid(argv,1,l_i-1)) to l_sLast
+
+ if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount
+ if (l_iCount <> argv2) break begin
- move (mid(argv,1,l_i+1)) to l_sNext
-
- if ((l_sChar = '{') and not (l_iQuot)) begin
- move 1 to l_iOpen
- move "" to l_sBuf
- end
- else if ((l_sChar = '}') and not (l_iQuot)) begin
- move 0 to l_iOpen
- end
- else if ((l_sChar = '"') and (l_sLast <> '\')) begin
- if (l_iQuot) move 0 to l_iQuot
- else move 1 to l_iQuot
- end
- if ((l_sChar = ',') and not (l_iOpen)) break begin
- if (((l_sChar = '{') or (l_sChar = '}')) and not (l_iQuot)) break begin
- if ((l_sChar = '"') and (l_sLast <> '\')) break begin
- if ((l_iQuot) and (l_sChar = '\') and ((l_sNext = '"') or (l_sNext = '\'))) break begin
-
- append l_sBuf l_sChar
- loop
-
- function_return l_sBuf
-end_function
\ No newline at end of file
+ move (mid(argv,1,l_i+1)) to l_sNext
+
+ if ((l_sChar = '{') and not (l_iQuot)) begin
+ move 1 to l_iOpen
+ move "" to l_sBuf
+ end
+ else if ((l_sChar = '}') and not (l_iQuot)) begin
+ move 0 to l_iOpen
+ end
+ else if ((l_sChar = '"') and (l_sLast <> '\')) begin
+ if (l_iQuot) move 0 to l_iQuot
+ else move 1 to l_iQuot
+ end
+ if ((l_sChar = ',') and not (l_iOpen)) break begin
+ if (((l_sChar = '{') or (l_sChar = '}')) and not (l_iQuot)) break begin
+ if ((l_sChar = '"') and (l_sLast <> '\')) break begin
+ if ((l_iQuot) and (l_sChar = '\') and ((l_sNext = '"') or (l_sNext = '\'))) break begin
+
+ append l_sBuf l_sChar
+ loop
+
+ function_return l_sBuf
+end_function
diff --git a/src/df32/string.inc b/src/df32/string.inc
index f951c2e..e09adf8 100644
--- a/src/df32/string.inc
+++ b/src/df32/string.inc
@@ -206,7 +206,7 @@ function sanitize_str global string l_sInput string l_sLevel returns string
function_return l_sReturn
end_function
-// Return none blank of two strings
+// Return one blank of two strings
function nbstring global string argv string argv2 returns string
if (argv <> "") function_return argv
else if (argv2 <> "") function_return argv2
@@ -261,6 +261,90 @@ function msxsl global string engine string source string stylesheet string param
function_return l_sReturn
end_function
+// Check if a string looks like a valid dataflex number
+//True
+// showln (is_number("99999999999999.99999999")) (is_number("-99999999999999.99999999"))
+// showln (is_number("99999999999999.0")) (is_number("0")) (is_number("-0")) (is_number("100"))
+//False
+// showln (is_number("99999999999999.999999999")) (is_number("-999999999999999.99999999"))
+// showln (is_number("999999999999999.99999999")) (is_number("1-0")) (is_number(".0D"))
+// showln (is_number("")) (is_number("-")) (is_number("100A")) (is_number("A100"))
+function is_number global string argv returns integer
+ local integer l_iChar l_iDec l_iNum l_iLen l_i l_iNeg
+
+ move 0 to l_iNum
+ move 0 to l_iDec
+
+ // Is the value negative
+ if (ascii(mid(argv,1,1)) = 45);
+ move 1 to l_iNeg
+ else;
+ move 0 to l_iNeg
+
+ move (length(argv)) to l_iLen
+
+ // Check basic length conforms to number
+ if ((l_iLen-L_iNeg = 0) or (l_iLen-l_iNeg > 23)) function_return 0
+
+ //Check for non numerics
+ for l_i from (1+l_iNeg) to l_iLen
+ move (ascii(mid(argv,1,l_i))) to l_iChar
+ if ((l_iChar = 46) and ((l_iDec = 1) or (l_i > 15+l_iNeg))) break
+ if not ((l_iChar >= 48) and (l_iChar <= 57) or (l_iChar = 46)) break
+ if (l_iChar = 46);
+ move 1 to l_iDec
+ increment l_iNum
+ loop
+
+ function_return ((l_iNum+l_iNeg) = l_iLen)
+end_function
+
+
+// Check if a string looks like a valid dataflex integer
+//True
+// showln (is_integer("2147483647")) (is_integer("2147483638"))
+// showln (is_integer("-2147483647")) (is_integer("-2147483648"))
+// showln (is_integer("0")) (is_integer("-0"))
+//False
+// showln (is_integer("214748364 ")) (is_integer("2147483648")) (is_integer("2947483647"))
+// showln (is_integer("-2147483649")) (is_integer("21474836478")) (is_integer("21474836470"))
+// showln (is_integer("-21474836470")) (is_integer("214748364A")) (is_integer("-A"))
+// showln (is_integer("-214748364A")) (is_integer("-")) (is_integer("-21474B364P"))
+function is_integer global string argv returns integer
+ local integer l_iChar l_iInt l_iLen l_i l_iNeg
+
+ move 0 to l_iInt
+ move (length(argv)) to l_iLen
+
+ //Is the value negative
+ if (ascii(mid(argv,1,1)) = 45);
+ move 1 to l_iNeg
+ else;
+ move 0 to l_iNeg
+
+ // Check basic length conforms to integer
+ if ((l_iLen-L_iNeg = 0) or (l_iLen-l_iNeg > 10)) function_return 0
+
+ //Check for non numerics
+ for l_i from (1+l_iNeg) to l_iLen
+ move (ascii(mid(argv,1,l_i))) to l_iChar
+ if not ((l_iChar >= 48) and (l_iChar <= 57)) break
+ increment l_iInt
+ loop
+
+ //Check for 32 bit signed integer bounds
+ if ((l_iLen-l_iNeg = 10) and ((l_iInt+l_iNeg) = l_iLen)) begin
+ if (integer(mid(argv,9,1+l_iNeg)) > 214748364);
+ function_return 0
+ if (integer(mid(argv,9,1+l_iNeg)) = 214748364) begin
+ if (integer(mid(argv,1,10+l_iNeg)) > 7+l_iNeg);
+ function_return 0
+ end
+ end
+
+ function_return ((l_iInt+l_iNeg) = l_iLen)
+end_function
+
//-------------------------------------------------------------------------
// Classes
//-------------------------------------------------------------------------
@@ -268,11 +352,11 @@ end_function
// String tokenizer class
//
// Send message methods:
-// set_string <string> <delimiter> - Send the string to be tokenized and the delimiter to split on
-// set_string_csv <string> - Send a CSV string to be tokenized. As per general CSV data:
-// * Items containting commas to be enclosed in double quotes: '"'
-// * Double quotes in quotes to be escaped with a backslash: '\'
-//
+// set_string <string> <delimiter> - Send the string to be tokenized and the delimiter to split on
+// set_string_csv <string> - Send a CSV string to be tokenized. As per general CSV data:
+// * Items containting commas to be enclosed in double quotes: '"'
+// * Double quotes in quotes to be escaped with a backslash: '\'
+//
// Set methods:
// token_value
//
@@ -333,45 +417,46 @@ class StringTokenizer is an array
set c_iTokens to l_iTokens
end_procedure
- procedure set_string_csv string argv
- local integer l_i l_iQuot l_iTokens
- local string l_sChar l_sLast l_sNext l_sBuf
-
- move -1 to l_iTokens
- move 0 to l_iQuot
- move "" to l_sLast
-
- for l_i from 0 to (length(argv))
- move (mid(argv,1,l_i)) to l_sChar
- move (mid(argv,1,l_i+1)) to l_sNext
- move (mid(argv,1,l_i-1)) to l_sLast
-
- if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '"')) break begin
-
- if ((l_sChar = '"') and (l_sLast <> '\')) begin
- if (l_iQuot) move 0 to l_iQuot
- else move 1 to l_iQuot
- end
- if ((l_sChar = '"') and (l_sLast <> '\')) break begin
-
- if ((l_sChar = ',') and not (l_iQuot)) begin
- //fwd to Array
- increment l_iTokens
- forward set array_value item l_iTokens to l_sBuf
- move "" to l_sBuf
- end
- if ((l_sChar = ',') and not (l_iQuot)) break begin
-
- append l_sBuf l_sChar
- loop
-
- //fwd to Array
- increment l_iTokens
- forward set array_value item l_iTokens to l_sBuf
+ procedure set_string_csv string argv
+ local integer l_i l_iQuot l_iTokens
+ local string l_sChar l_sLast l_sNext l_sBuf
+
+ move -1 to l_iTokens
+ move 0 to l_iQuot
+ move "" to l_sLast
+
+ for l_i from 0 to (length(argv))
+ move (mid(argv,1,l_i)) to l_sChar
+ move (mid(argv,1,l_i+1)) to l_sNext
+ move (mid(argv,1,l_i-1)) to l_sLast
+
+ if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '"')) break begin
+ if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '\')) break begin
+
+ if ((l_sChar = '"') and (l_sLast <> '\')) begin
+ if (l_iQuot) move 0 to l_iQuot
+ else move 1 to l_iQuot
+ end
+ if ((l_sChar = '"') and (l_sLast <> '\')) break begin
+
+ if ((l_sChar = ',') and not (l_iQuot)) begin
+ //fwd to Array
+ increment l_iTokens
+ forward set array_value item l_iTokens to l_sBuf
+ move "" to l_sBuf
+ end
+ if ((l_sChar = ',') and not (l_iQuot)) break begin
+
+ append l_sBuf l_sChar
+ loop
+
+ //fwd to Array
+ increment l_iTokens
+ forward set array_value item l_iTokens to l_sBuf
- set c_iTokenOn to 0
+ set c_iTokenOn to 0
set c_iTokens to l_iTokens
- end_procedure
+ end_procedure
procedure set token_value integer itemx string val
forward set array_value item itemx to val
diff --git a/src/df32/tcpcomm.h b/src/df32/tcpcomm.h
deleted file mode 100644
index 17c2ce5..0000000
--- a/src/df32/tcpcomm.h
+++ /dev/null
@@ -1,26 +0,0 @@
-//-------------------------------------------------------------------------
-// tcpcomm.h
-// This file contains definitions of "Win32" api functions provided by
-// the df32func.dll dynamic link library.
-//
-// This file is to be included when using socket networking in df32func.mk
-//
-// Copyright (c) 2006-2009, glyn@8kb.co.uk
-//
-// df32func/tcpcomm.h
-//-------------------------------------------------------------------------
-
-Define __tcpcomm_h__
-
-//-------------------------------------------------------------------------
-// External functions
-//-------------------------------------------------------------------------
-
-external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer
-external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer
-external_function AcceptClient "AcceptClient" df32func.dll returns integer
-external_function Send "Send" df32func.dll dword socket string data returns integer
-external_function Receive "Receive" df32func.dll dword socket pointer dataOut returns integer
-external_function CloseConnection "CloseConnection" df32func.dll dword socket returns integer
-external_function PseudoRand "PseudoRand" df32func.dll dword w returns integer
-external_function RdtscRand "RdtscRand" df32func.dll returns integer