From: glyn 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/?p=dataflex%2Fdf32func;a=commitdiff_plain;h=67d1bf8be782956ec104758872a300e934b80895 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 - Send the string to be tokenized and the delimiter to split on -// set_string_csv - 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 - Send the string to be tokenized and the delimiter to split on +// set_string_csv - 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