Amend functionality of antiquated matrix methods and minor changes to matrix parsing...

diff --git a/src/c/gnuregex.c b/src/c/gnuregex.c
index f0f2dea668b76d7960c85bef8c81b931eb99de56..f5cce37a72929641ce34a68d25ee6c5211f66542 100644 (file)
--- 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 */\r
     for (ptr = str; *ptr; ptr++) {\r
         char        ch = *ptr;\r
     /* Check for characters that need quoting */\r
     for (ptr = str; *ptr; ptr++) {\r
         char        ch = *ptr;\r

-        if (ch == '\"' || ch =='\\' || ch == '\{' || ch == ',') {\r
+        if (ch == '"' || ch =='\\' || ch == '{' || ch == ',') {\r

             do_quote = 1;\r
             break;\r
         }\r
             do_quote = 1;\r
             break;\r
         }\r


@@ -118,11 +118,11 @@ static int compile_regex(regex_t *re, const char *pattern, const char *flags, in
 \r
     status = regcomp(re, pattern, cflags);\r
     if (status != REG_NOERROR) {\r
 \r
     status = regcomp(re, pattern, cflags);\r
     if (status != REG_NOERROR) {\r

-               if (errors == 1) {\r
-               char error_message[MAX_ERROR_MSG];\r
-               regerror (status, re, error_message, MAX_ERROR_MSG);\r
-               fprintf (stderr, "Regex error compiling '%s': %s\n", pattern, error_message);\r
-               }\r
+        if (errors == 1) {\r
+            char error_message[MAX_ERROR_MSG];\r
+            regerror (status, re, error_message, MAX_ERROR_MSG);\r
+            fprintf (stderr, "Regex error compiling '%s': %s\n", pattern, error_message);\r
+        }\r

     }\r
     return status;\r
 }\r
     }\r
     return status;\r
 }\r


@@ -300,7 +300,7 @@ int regexp_match(const char *str, const char *pattern, const char *flags, int er
         if (!result) /* match */\r
             return 1;\r
         else /* no match */\r
         if (!result) /* match */\r
             return 1;\r
         else /* no match */\r

-               return 0;\r
+            return 0;\r

     }\r
     else /* error condition, but still: no match */\r
         return 0;\r
     }\r
     else /* error condition, but still: no match */\r
         return 0;\r

diff --git a/src/df32/data.inc b/src/df32/data.inc
index 14eafd7b52c8407507a73240f85bfac759601242..5f80d00feec2e116954bdb4c0b1c11eca4ae993c 100644 (file)
--- a/src/df32/data.inc
+++ b/src/df32/data.inc
@@ -790,7 +790,10 @@ end_class
 //\r
 // Send message methods:\r
 //    delete_data                   - Clear the matrix\r
 //\r
 // Send message methods:\r
 //    delete_data                   - Clear the matrix\r

-//    matrix_sort                   - Y pos to sort on\r
+//    [obsolete] matrix_sort        - Y pos to sort on, ASC OR DESC\r
+//    sort_items                    - Y pos to sort on, ASC OR DESC (auto detects)\r
+//    sort_items_ascii              - Y pos to sort on, ASC OR DESC (ascii)\r
+//    sort_items_num                - Y pos to sort on, ASC OR DESC (numeric)\r

 //    matrix_delete                 - X and Y pos to delete \r
 //    delete_item                   - X position to delete (this reshuffles the matrix; avoid using)\r
 //    hash_on_column_algorithm      - Hash algorithm to use\r
 //    matrix_delete                 - X and Y pos to delete \r
 //    delete_item                   - X position to delete (this reshuffles the matrix; avoid using)\r
 //    hash_on_column_algorithm      - Hash algorithm to use\r


@@ -799,8 +802,10 @@ end_class
 //    hash_is_unique                - Add a unique constraint on the hash\r
 //    remove_hash_is_unique         - Remove a unique constraint from the hash\r
 //    matrix_index_lookup_clear     - Clear the lookup buffer\r
 //    hash_is_unique                - Add a unique constraint on the hash\r
 //    remove_hash_is_unique         - Remove a unique constraint from the hash\r
 //    matrix_index_lookup_clear     - Clear the lookup buffer\r

-//    matrix_append_csv                                - Append some data in CSV format to the array E.g. ('My Name,"My,\"address\""')\r
-//    matrix_copy_csv                          - Copy csv data from sprecified file into matrix\r
+//    matrix_append_csv             - Append some data in CSV format to the array E.g. ('My Name,"My,\"address\""')\r
+//    matrix_copy_csv_in            - Copy csv data from specified file into matrix\r
+//    matrix_copy_csv_in_header     - Copy csv data with header from specified file into matrix\r
+//    matrix_copy_csv_out           - Copy csv data from matrix into specified file\r

 //\r
 // Set methods:\r
 //    matrix_value                  - Set a value at X, Y\r
 //\r
 // Set methods:\r
 //    matrix_value                  - Set a value at X, Y\r


@@ -817,8 +822,8 @@ end_class
 //    matrix_index_lookup_clear     - Clear the buffer for an indexed lookup\r
 //    matrix_index_count_from_value - Get a count of rows with a particular value\r
 //    matrix_index_from_value       - Get the next X pos (row) with indexed value. Returns -1 when nothing left to find.\r
 //    matrix_index_lookup_clear     - Clear the buffer for an indexed lookup\r
 //    matrix_index_count_from_value - Get a count of rows with a particular value\r
 //    matrix_index_from_value       - Get the next X pos (row) with indexed value. Returns -1 when nothing left to find.\r

-//    item_count                                       - Get count of rows in matrix\r
-//    item_width                                       - Get count of columns in matrix\r
+//    item_count                    - Get count of rows in matrix\r
+//    item_width                    - Get count of columns in matrix\r

 //    \r
 // Example usage:\r
 //\r
 //    \r
 // Example usage:\r
 //\r


@@ -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\r
 //    get matrix_value of (test(current_object)) item 0 item 1 to tmpStr - x then y pos to Value\r
 //    send matrix_append_csv to test ('My Name,"My,\"address\""')        - Append CSV data to the end of the matrix\r
 //    set matrix_value of (test(current_object)) item 0 item 1 to "1"    - x then y pos to Value\r
 //    get matrix_value of (test(current_object)) item 0 item 1 to tmpStr - x then y pos to Value\r
 //    send matrix_append_csv to test ('My Name,"My,\"address\""')        - Append CSV data to the end of the matrix\r

-//       send matrix_copy_csv to (test(current_object)) "f:\data.csv"          - Copy data from csv file into matrix\r
-//    send matrix_sort to (test(current_object)) 1               - x then y pos to sort by\r
+//    send matrix_copy_csv_in to (test(current_object)) "f:\data.csv"       - Copy data from csv file into matrix\r
+//    [obsolete] send matrix_sort to (test(current_object)) 1 ASC        - y pos to sort by, ASCENDING/DESCENDING\r
+//    send sort_items to (test(current_object)) 1                        - y pos to sort by, ASCENDING/DESCENDING (auto)\r
+//    send sort_items_ascii to (test(current_object)) 1                  - y pos to sort by, ASCENDING/DESCENDING (ascii)\r
+//    send sort_items_num to (test(current_object)) 1                    - y pos to sort by, ASCENDING/DESCENDING (numeric)\r

 //    send matrix_delete to (test(current_object)) 1 1           - x then y pos to delete \r
 //    send matrix_delete_row to (test(current_object)) 1             - x essentially blanks record out, no reshuffle\r
 //    send delete_item to (test(current_object)) 1              - x pos (not v efficient), reshuffles\r
 //    send matrix_delete to (test(current_object)) 1 1           - x then y pos to delete \r
 //    send matrix_delete_row to (test(current_object)) 1             - x essentially blanks record out, no reshuffle\r
 //    send delete_item to (test(current_object)) 1              - x pos (not v efficient), reshuffles\r


@@ -846,7 +854,7 @@ end_class
 //    get matrix_index_from_value of (test(current_object)) item "1" to x_pos   \r
 //    get matrix_indextable_from_value of (test(current_object)) item "1" to tmpStr \r
 //    get matrix_hash_from_value of (test(current_object)) item "1" to tmpInt   \r
 //    get matrix_index_from_value of (test(current_object)) item "1" to x_pos   \r
 //    get matrix_indextable_from_value of (test(current_object)) item "1" to tmpStr \r
 //    get matrix_hash_from_value of (test(current_object)) item "1" to tmpInt   \r

-//       get item_count of (test(current_object) to tmpInt\r
+//    get item_count of (test(current_object) to tmpInt\r

 //    get item_width of (test(current_object) to tmpInt\r
 \r
 class matrix is an array\r
 //    get item_width of (test(current_object) to tmpInt\r
 \r
 class matrix is an array\r


@@ -869,7 +877,22 @@ class matrix is an array
         set c_iLastIndexTableHash to -1\r
         set c_iLastIndexTablePos to -1\r
         set c_iEnforceUnique to 0\r
         set c_iLastIndexTableHash to -1\r
         set c_iLastIndexTablePos to -1\r
         set c_iEnforceUnique to 0\r

-    end_procedure\r
+    end_procedure    \r
+    \r
+    // Pull the value of a column from the string representation\r
+    function column_value integer itemy string row\r
+        local string l_sResult\r
+        local integer l_i\r
+        \r
+        move row to l_sResult\r
+        \r
+        for l_i from 0 to (itemy-1)\r
+            move (right(l_sResult,length(l_sResult)-pos(character(1),l_sResult))) to l_sResult\r
+        loop\r
+        move (left(l_sResult,pos(character(1),l_sResult)-1)) to l_sResult\r
+        \r
+        function_return l_sResult\r
+    end_function    \r

     \r
     procedure hash_on_column_algorithm string hashalg\r
         if ((hashalg = "hash_reduced_djb2") or (hashalg = "hash_reduced_sdbm") or (hashalg = "hash_reduced_lazy") or (hashalg = "hash_for_df_arrays") or (hashalg = "")) begin\r
     \r
     procedure hash_on_column_algorithm string hashalg\r
         if ((hashalg = "hash_reduced_djb2") or (hashalg = "hash_reduced_sdbm") or (hashalg = "hash_reduced_lazy") or (hashalg = "hash_for_df_arrays") or (hashalg = "")) begin\r


@@ -914,10 +937,9 @@ class matrix is an array
                 \r
                 for l_i from 0 to l_iMax\r
                     forward get array_value item l_i to l_sBuf\r
                 \r
                 for l_i from 0 to l_iMax\r
                     forward get array_value item l_i to l_sBuf\r

-                \r
-                    send delete_data to (mTokens(current_object))\r
-                    send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
-                    get token_value of (mTokens(current_object)) item l_iColumn to l_sTmp                                       \r
+\r
+                    get column_value item l_iColumn item l_sBuf to l_sTmp\r
+                    \r

                     get insert_hash of (mHash_table(current_object)) item l_sTmp to l_iHash\r
                     get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
                         \r
                     get insert_hash of (mHash_table(current_object)) item l_sTmp to l_iHash\r
                     get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
                         \r


@@ -951,6 +973,8 @@ class matrix is an array
         \r
         if (l_iHashOn <> -1) begin          \r
             set c_iHashOn to -1\r
         \r
         if (l_iHashOn <> -1) begin          \r
             set c_iHashOn to -1\r

+            set c_iLastIndexTableHash to -1\r
+            set c_iLastIndexTablePos to -1\r

             send destroy_object to (mHash_array(current_object))\r
             send destroy_object to (mHash_table(current_object))\r
         end\r
             send destroy_object to (mHash_array(current_object))\r
             send destroy_object to (mHash_table(current_object))\r
         end\r


@@ -1034,102 +1058,139 @@ class matrix is an array
     end_procedure\r
     \r
     procedure matrix_append_csv string row        \r
     end_procedure\r
     \r
     procedure matrix_append_csv string row        \r

-        local integer l_iMax l_iValues l_i\r
+        local integer l_iMax l_iValues l_i l_iHashOn l_iWidth l_iCount\r

         local string l_sBuf\r
             \r
         local string l_sBuf\r
             \r

+        get c_iHashOn to l_iHashOn\r

         forward get item_count to l_iMax\r
         forward get item_count to l_iMax\r

-               \r
-               send delete_data to (mTokens2(current_object))\r
-               send set_string_csv to (mTokens2(current_object)) row\r
-               get token_count of (mTokens2(current_object)) to l_iValues\r
-               \r
-               for l_i from 0 to l_iValues                             \r
-                       get token_value of (mTokens2(current_object)) item l_i to l_sBuf\r
-                       indicate err false\r
-                       set matrix_value item l_iMax item l_i to l_sBuf                 \r
-                       if (err) forward send delete_item l_iMax\r
-                       if (err) break\r
-               loop\r
+        \r
+        if ((l_iHashOn <> -1) or (row contains '"')) begin \r
+            send delete_data to (mTokens2(current_object))\r
+            send set_string_csv to (mTokens2(current_object)) row\r
+            get token_count of (mTokens2(current_object)) to l_iValues\r
+        \r
+            for l_i from 0 to l_iValues                 \r
+                get token_value of (mTokens2(current_object)) item l_i to l_sBuf\r
+                indicate err false\r
+                set matrix_value item l_iMax item l_i to l_sBuf         \r
+                if (err) forward send delete_item l_iMax\r
+                if (err) break\r
+            loop\r
+        end\r
+        else begin\r
+            get c_iWidth to l_iWidth \r
+            move 0 to l_iCount\r
+            forward set array_value item l_iMax to (replaces(',', row, character(1)))\r
+            for l_i from (pos(',', row)) to (length(row))\r
+                if (mid(row,1,l_i) = ',') increment l_iCount\r
+            loop            \r
+            if (l_iCount > l_iWidth) set c_iWidth to l_iCount\r
+        end\r

 \r
     end_procedure\r
 \r
     end_procedure\r

+\r
+    procedure matrix_copy_csv_worker string fname integer offset\r
+        local string l_sBuf \r
+        local integer l_i\r
+        \r
+        move 0 to l_i\r
+        if (does_exist(fname)) begin\r
+            direct_input channel DEFAULT_FILE_CHANNEL fname\r
+                while not (seqeof)\r
+                    readln channel DEFAULT_FILE_CHANNEL l_sBuf\r
+                    increment l_i\r
+                    if (l_i <= offset) break begin\r
+                    if (seqeof) break\r
+                    if (trim(l_sBuf) <> "") begin\r
+                        send matrix_append_csv l_sBuf\r
+                    end\r
+                loop\r
+            close_input channel DEFAULT_FILE_CHANNEL\r
+        end\r
+        else;\r
+            custom_error ERROR_CODE_FILE_NOT_FOUND$ ERROR_MSG_FILE_NOT_FOUND ERROR_DETAIL_FILE_NOT_FOUND fname\r
+                    \r
+    end_procedure \r

     \r
     \r

-       procedure matrix_copy_csv string fname\r
-               local string l_sBuf\r
-               \r
-               if (does_exist(fname)) begin\r
-                       direct_input channel DEFAULT_FILE_CHANNEL fname\r
-                               while not (seqeof)\r
-                                       readln channel DEFAULT_FILE_CHANNEL l_sBuf\r
-                                       if (seqeof) break\r
-                                       if (trim(l_sBuf) <> "") begin\r
-                                               send matrix_append_csv l_sBuf\r
-                                       end\r
-                               loop\r
-                       close_input channel DEFAULT_FILE_CHANNEL\r
-               end\r
-               else;\r
-                       custom_error ERROR_CODE_FILE_NOT_FOUND$ ERROR_MSG_FILE_NOT_FOUND ERROR_DETAIL_FILE_NOT_FOUND fname                      \r
-       end_procedure    \r
-    \r
-    function matrix_string integer itemx integer itemy returns string\r
-        local string l_sBuf l_sTmp\r
+    procedure matrix_copy_csv_in string fname\r
+        send matrix_copy_csv_worker fname 0\r
+    end_procedure \r

 \r
 \r

-        forward get array_value item itemx to l_sBuf\r
+    procedure matrix_copy_csv_in_header string fname\r
+        send matrix_copy_csv_worker fname 1\r
+    end_procedure \r

         \r
         \r

-        send delete_data to (mTokens(current_object))\r
-        send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
-        get token_value of (mTokens(current_object)) item itemy to l_sTmp\r
+    procedure matrix_copy_csv_out string fname \r
+        local integer l_iMax l_i l_j l_iValues\r
+        local string l_sBuf\r

         \r
         \r

-        function_return l_sTmp\r
-    end_function        \r
+        forward get item_count to l_iMax\r
+        \r
+        direct_output channel DEFAULT_FILE_CHANNEL fname\r
+            for l_i from 0 to l_iMax\r
+                forward get string_value item l_i to l_sBuf\r
+                if (l_sBuf <> "") begin\r
+                    if ((l_sBuf contains '"') or (l_sBuf contains ',')) begin\r
+                        send delete_data to (mTokens2(current_object))\r
+                        send set_string to (mTokens2(current_object)) l_sBuf (character(1))\r
+                        get token_count of (mTokens2(current_object)) to l_iValues\r
+        \r
+                        for l_j from 0 to l_iValues                 \r
+                            get token_value of (mTokens2(current_object)) item l_j to l_sBuf\r
+                            if (l_j <> 0);\r
+                                write channel DEFAULT_FILE_CHANNEL ','\r
+                            if (l_sBuf contains '"');\r
+                                write channel DEFAULT_FILE_CHANNEL ('"'+(replaces('"', l_sBuf, '\"'))+'"')\r
+                            else;\r
+                                write channel DEFAULT_FILE_CHANNEL l_sBuf\r
+                        loop\r
+                        writeln channel DEFAULT_FILE_CHANNEL ""\r
+                    end\r
+                    else;\r
+                        writeln channel DEFAULT_FILE_CHANNEL (replaces(character(1), l_sBuf, ','))\r
+                end\r
+            loop\r
+        close_output channel DEFAULT_FILE_CHANNEL\r
+    end_procedure \r
+    \r

     \r
     function matrix_value integer itemx integer itemy returns string\r
         local string l_sBuf l_sTmp\r
 \r
         forward get array_value item itemx to l_sBuf\r
     \r
     function matrix_value integer itemx integer itemy returns string\r
         local string l_sBuf l_sTmp\r
 \r
         forward get array_value item itemx to l_sBuf\r

+        get column_value item itemy item l_sBuf to l_sTmp\r

         \r
         \r

-        send delete_data to (mTokens(current_object))\r
-        send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
-        get token_value of (mTokens(current_object)) item itemy to l_sTmp\r
+        function_return l_sTmp\r
+    end_function        \r
+    \r
+    function matrix_string integer itemx integer itemy returns string\r
+        local string l_sTmp\r
+\r
+        get matrix_value item itemx item itemy to l_sTmp\r

         \r
         function_return l_sTmp\r
     end_function        \r
     \r
     function matrix_integer integer itemx integer itemy returns integer\r
         \r
         function_return l_sTmp\r
     end_function        \r
     \r
     function matrix_integer integer itemx integer itemy returns integer\r

-        local string l_sBuf\r

         local integer l_iTmp\r
         local integer l_iTmp\r

-\r
-        forward get array_value item itemx to l_sBuf\r

         \r
         \r

-        send delete_data to (mTokens(current_object))\r
-        send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
-        get token_value of (mTokens(current_object)) item itemy to l_iTmp\r
+        get matrix_value item itemx item itemy to l_iTmp\r

         \r
         function_return l_iTmp\r
     end_function\r
     \r
     function matrix_number integer itemx integer itemy returns number\r
         \r
         function_return l_iTmp\r
     end_function\r
     \r
     function matrix_number integer itemx integer itemy returns number\r

-        local string l_sBuf\r

         local number l_nTmp\r
         \r
         local number l_nTmp\r
         \r

-        forward get array_value item itemx to l_sBuf\r
-        \r
-        send delete_data to (mTokens(current_object))\r
-        send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
-        get token_value of (mTokens(current_object)) item itemy to l_nTmp\r
+        get matrix_value item itemx item itemy to l_nTmp\r

         \r
         function_return l_nTmp\r
     end_function\r
     \r
     function matrix_real integer itemx integer itemy returns real\r
         \r
         function_return l_nTmp\r
     end_function\r
     \r
     function matrix_real integer itemx integer itemy returns real\r

-        local string l_sBuf\r

         local real l_rTmp\r
         \r
         local real l_rTmp\r
         \r

-        forward get array_value item itemx to l_sBuf\r
-        \r
-        send delete_data to (mTokens(current_object))\r
-        send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
-        get token_value of (mTokens(current_object)) item itemy to l_rTmp\r
+        get matrix_value item itemx item itemy to l_rTmp\r

         \r
         function_return l_rTmp\r
     end_function\r
         \r
         function_return l_rTmp\r
     end_function\r


@@ -1177,6 +1238,7 @@ class matrix is an array
 \r
         get c_iHashOn to l_iHashOn\r
         move -1 to l_iIndex\r
 \r
         get c_iHashOn to l_iHashOn\r
         move -1 to l_iIndex\r

+        move 0 to l_iLastIndexTablePos\r

             \r
         if (l_iHashOn <> -1) begin\r
             get find_hash of (mHash_table(current_object)) item val to l_iHash\r
             \r
         if (l_iHashOn <> -1) begin\r
             get find_hash of (mHash_table(current_object)) item val to l_iHash\r


@@ -1208,7 +1270,7 @@ class matrix is an array
     end_function\r
     \r
     function matrix_index_count_from_value string val returns integer\r
     end_function\r
     \r
     function matrix_index_count_from_value string val returns integer\r

-        local integer l_iHashOn l_iHash l_iIndexValues\r
+        local integer l_iHashOn l_iHash l_iIndexValues l_i\r

         local string l_sIndexTable\r
     \r
         get c_iHashOn to l_iHashOn\r
         local string l_sIndexTable\r
     \r
         get c_iHashOn to l_iHashOn\r


@@ -1217,12 +1279,14 @@ class matrix is an array
             get find_hash of (mHash_table(current_object)) item val to l_iHash\r
             get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
     \r
             get find_hash of (mHash_table(current_object)) item val to l_iHash\r
             get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
     \r

-            send delete_data to (mTokens(current_object))\r
-            send set_string to (mTokens(current_object)) l_sIndexTable "|"\r
-            get token_count of (mTokens(current_object)) to l_iIndexValues\r
+            move 0 to l_iIndexValues\r
+            for l_i from 1 to (length(l_sIndexTable))\r
+                if (mid(l_sIndexTable,1,l_i) = '|');\r
+                    increment l_iIndexValues\r
+            loop\r

         end\r
     \r
         end\r
     \r

-        function_return l_iIndexValues\r
+        function_return (l_iIndexValues-1)\r

     end_function\r
         \r
     procedure set item_count integer newVal\r
     end_function\r
         \r
     procedure set item_count integer newVal\r


@@ -1230,9 +1294,9 @@ class matrix is an array
     end_procedure\r
     \r
     function item_width returns integer\r
     end_procedure\r
     \r
     function item_width returns integer\r

-           local integer l_iWidth\r
-           get c_iWidth to l_iWidth\r
-           function_return l_iWidth\r
+        local integer l_iWidth\r
+        get c_iWidth to l_iWidth\r
+        function_return l_iWidth\r

     end_function\r
         \r
     procedure matrix_delete integer itemx integer itemy\r
     end_function\r
         \r
     procedure matrix_delete integer itemx integer itemy\r


@@ -1343,12 +1407,17 @@ class matrix is an array
         forward send delete_item to current_object itemx\r
     end_procedure\r
 \r
         forward send delete_item to current_object itemx\r
     end_procedure\r
 \r

-    procedure matrix_sort integer itemy string order \r
+    // The routine below relies on the internal dataflex sort, doing\r
+    // what is essentially a nested loop join on the result and rebuilding\r
+    // the original matrix.  It's pretty awful and is only left here for\r
+    // reference.  Behaviour isn't quite quadratic, a feeble guess is\r
+    // something like O( (2N + Nlog(n) + N^1.8) :-(\r
+    procedure matrix_sort integer itemy string order\r

         local string l_sBuf l_sTmp l_sTmp2 l_sHash\r
         local integer l_iX l_i l_j l_iMax l_iPoolMax l_iWidth l_iThrow l_iNumCount l_iHashOn l_iHash\r
         \r
         move (trim(uppercase(order))) to order\r
         local string l_sBuf l_sTmp l_sTmp2 l_sHash\r
         local integer l_iX l_i l_j l_iMax l_iPoolMax l_iWidth l_iThrow l_iNumCount l_iHashOn l_iHash\r
         \r
         move (trim(uppercase(order))) to order\r

-        if ((order <> "ASCENDING") and (order <> "DESCENDING")) move "ASCENDING" to order\r
+        if ((left(order,3) <> "ASC") and (left(order,4) <> "DESC")) move "ASCENDING" to order\r

         \r
         object mSort_array is an array\r
         end_object\r
         \r
         object mSort_array is an array\r
         end_object\r


@@ -1363,6 +1432,7 @@ class matrix is an array
         send delete_data to (mClone_array(current_object))\r
         \r
         if (l_iHashOn <> -1) begin\r
         send delete_data to (mClone_array(current_object))\r
         \r
         if (l_iHashOn <> -1) begin\r

+            //Zero the hash\r

             send delete_data to (mHash_array(current_object))\r
         end\r
         \r
             send delete_data to (mHash_array(current_object))\r
         end\r
         \r


@@ -1377,9 +1447,8 @@ class matrix is an array
         \r
             move 0 to l_iNumCount \r
             for l_j from 1 to (length(l_sTmp))\r
         \r
             move 0 to l_iNumCount \r
             for l_j from 1 to (length(l_sTmp))\r

-                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\r
-                    increment l_iNumCount\r
-                end\r
+                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\r
+                increment l_iNumCount\r

             loop\r
             if ((length(l_sTmp) > 0) and (length(l_sTmp) = l_iNumCount)) begin\r
                 set array_value of (mSort_array(current_object)) item l_i to (number(l_sTmp))\r
             loop\r
             if ((length(l_sTmp) > 0) and (length(l_sTmp) = l_iNumCount)) begin\r
                 set array_value of (mSort_array(current_object)) item l_i to (number(l_sTmp))\r


@@ -1390,11 +1459,13 @@ class matrix is an array
             end\r
         loop\r
         \r
             end\r
         loop\r
         \r

-        if (order = "ASCENDING") send sort_items to (mSort_array(current_object)) ascending\r
-        if (order = "DESCENDING") send sort_items to (mSort_array(current_object)) descending\r
+        //Rely on dataflex sort\r
+        if (left(order,3) = "ASC") send sort_items to (mSort_array(current_object)) ascending\r
+        if (left(order,4) = "DESC") send sort_items to (mSort_array(current_object)) descending\r

 \r
         move l_iMax to l_iPoolMax\r
 \r
 \r
         move l_iMax to l_iPoolMax\r
 \r

+        // Nested loop join, sort of. Not good :-(\r

         for l_i from 0 to l_iMax\r
             get array_value of (mSort_array(current_object)) item l_i to l_sTmp\r
             if (l_sTmp = character(2)) move "" to l_sTmp\r
         for l_i from 0 to l_iMax\r
             get array_value of (mSort_array(current_object)) item l_i to l_sTmp\r
             if (l_sTmp = character(2)) move "" to l_sTmp\r


@@ -1416,7 +1487,7 @@ class matrix is an array
                     forward send delete_item to current_object l_iPoolMax\r
                     decrement l_iPoolMax                    \r
                         \r
                     forward send delete_item to current_object l_iPoolMax\r
                     decrement l_iPoolMax                    \r
                         \r

-                    // Remap hash\r
+                    // Rebuild hash\r

                     if (l_iHashOn <> -1) begin                  \r
                         get token_value of (mTokens(current_object)) item l_iHashOn to l_sHash\r
                         get find_hash of (mHash_table(current_object)) item l_sHash to l_iHash\r
                     if (l_iHashOn <> -1) begin                  \r
                         get token_value of (mTokens(current_object)) item l_iHashOn to l_sHash\r
                         get find_hash of (mHash_table(current_object)) item l_sHash to l_iHash\r


@@ -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.\r
         send destroy_object to (mClone_array(current_object))\r
     end_procedure\r
         send destroy_object to (mSort_array(current_object))  // Use "send request_destroy_object" to destroy object and all children.\r
         send destroy_object to (mClone_array(current_object))\r
     end_procedure\r

+\r
+    \r
+    // Recursive partition for quicksort.\r
+    // Dataflex arrays track the type of each row and perform a sort acordingly\r
+    // but we have no easy way of knowing.  So perform compare based on what a\r
+    // value looks "like" unless told otherwise.    \r
+    // Index from (lo_in), index to (hi_in), numeric/string mode (1=integer, 0=string), invert (1=descending, 0=ascending)\r
+    procedure partition integer lo_in integer hi_in integer mode integer itemy integer invert\r
+        local integer pivot lo_idx hi_idx t\r
+        local string pivot_val lo_row hi_row lo_val hi_val      \r
+        \r
+        if ((hi_in-lo_in) > 0) begin\r
+            move lo_in to lo_idx\r
+            move hi_in to hi_idx       \r
+            move ((lo_in+hi_in)/2) to pivot\r
+                        \r
+            while ((lo_idx <= pivot) AND (hi_idx >= pivot))\r
+                        \r
+                forward get array_value item pivot to pivot_val\r
+                get column_value item itemy item pivot_val to pivot_val\r
+                \r
+                forward get array_value item lo_idx to lo_row\r
+                get column_value item itemy item lo_row to lo_val\r
+\r
+                forward get array_value item hi_idx to hi_row\r
+                get column_value item itemy item hi_row to hi_val\r
+\r
+                \r
+                if (invert) begin\r
+                    while ( ( ((mode) and (number(lo_val) > number(pivot_val))) or (not (mode) and (lo_val > pivot_val))) and (lo_idx <= pivot))\r
+                        increment lo_idx\r
+                        forward get array_value item lo_idx to lo_row\r
+                        get column_value item itemy item lo_row to lo_val\r
+                    loop\r
+                    while ( ( ((mode) and (number(hi_val) < number(pivot_val))) or (not (mode) and (hi_val < pivot_val))) and (hi_idx >= pivot))\r
+                        decrement hi_idx\r
+                        forward get array_value item hi_idx to hi_row\r
+                        get column_value item itemy item hi_row to hi_val\r
+                    loop\r
+                end\r
+                else begin\r
+                    while ( ( ((mode) and (number(lo_val) < number(pivot_val))) or (not (mode) and (lo_val < pivot_val))) and (lo_idx <= pivot))\r
+                        increment lo_idx\r
+                        forward get array_value item lo_idx to lo_row\r
+                        get column_value item itemy item lo_row to lo_val\r
+                    loop\r
+                    while ( ( ((mode) and (number(hi_val) > number(pivot_val))) or (not (mode) and (hi_val > pivot_val))) and (hi_idx >= pivot))\r
+                        decrement hi_idx\r
+                        forward get array_value item hi_idx to hi_row\r
+                        get column_value item itemy item hi_row to hi_val\r
+                    loop\r
+                end\r
+                \r
+                forward set array_value item lo_idx to hi_row\r
+                forward set array_value item hi_idx to lo_row\r
+                \r
+                increment lo_idx\r
+                decrement hi_idx\r
+                \r
+                if ((lo_idx-1) = pivot) begin\r
+                    increment hi_idx\r
+                    move hi_idx to pivot\r
+                end\r
+                else if ((hi_idx+1) = pivot) begin\r
+                    decrement lo_idx\r
+                    move lo_idx to pivot\r
+                end\r
+                \r
+            loop\r
+    \r
+            if ((pivot-lo_in) > 1);\r
+                send partition lo_in (pivot-1) mode itemy invert\r
+            if ((hi_in-pivot) > 1);\r
+                send partition (pivot+1) hi_in mode itemy invert\r
+        end        \r
+    end_procedure   \r
+    \r
+    // Perform a quick sort on a perticular column (y) in the martix\r
+    // This is done in native dataflex, so no match for compiled C\r
+    procedure quick_sort integer itemy string order integer mode\r
+        local integer l_i l_j l_iHashOn l_iMax l_iInvert\r
+        local string l_sBuf\r
+        \r
+        if (uppercase(left(trim(order),4)) = "DESC") move 1 to l_iInvert\r
+        else move 0 to l_iInvert    \r
+        \r
+        get item_count to l_iMax\r
+        \r
+        // If we've not been told string/numeric, try and work out here.\r
+        if (mode = -1) begin\r
+            for l_i from 0 to (l_iMax-1)\r
+                forward get array_value item l_i to l_sBuf\r
+                get column_value item itemy item l_sBuf to l_sBuf\r
+                move (is_number(l_sBuf)) to mode\r
+                if (mode = 0) break\r
+            loop\r
+        end\r
+        \r
+        // Remove the current hash index if there is one        \r
+        get c_iHashOn to l_iHashOn\r
+        if (l_iHashOn <> -1);\r
+            send remove_hash_on_column  \r
+        \r
+        // Do the quick-sort\r
+        send partition 0 (l_iMax-1) mode itemy l_iInvert\r
+        \r
+        // Recreate any the hash if there was one\r
+        if (l_iHashOn <> -1);\r
+            send hash_on_column l_iHashOn\r
+\r
+    end_procedure\r
+    \r
+    //Wrapper for sort_items\r
+    procedure sort_items integer itemy string order\r
+        send quick_sort itemy order -1\r
+    end_procedure\r
+    \r
+    //Wrapper for sort_items\r
+    procedure sort_items_ascii integer itemy string order\r
+        send quick_sort itemy order 0\r
+    end_procedure    \r
+    \r
+    //Wrapper for sort_items\r
+    procedure sort_items_num integer itemy string order\r
+        send quick_sort itemy order 1\r
+    end_procedure        \r

     \r
 end_class\r
 \r
     \r
 end_class\r
 \r

diff --git a/src/df32/df32func.inc.autodoc b/src/df32/df32func.inc.autodoc
index d2df0a849213bc9964a16998dae85ecea41890d4..31f5cd93c87d9fd3dda59c9b554d6f95493720f2 100644 (file)
--- 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 \r
+df32func.inc last compiled on 05/10/2015 at 15:44:49.94 \r

 df32func DLL functions: \r
 df32func.h:external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer\r
 df32func.h:external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer\r
 df32func DLL functions: \r
 df32func.h:external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer\r
 df32func.h:external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer\r


@@ -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\r
 regex.inc:function regexp_matches_count global string argv returns integer\r
 regex.inc:function regexp_matches_item global string argv integer argv2 returns string\r
 regex.inc:function regexp_replace global string str string pattern string replacement string flags returns string\r
 regex.inc:function regexp_matches_count global string argv returns integer\r
 regex.inc:function regexp_matches_item global string argv integer argv2 returns string\r

+regex.inc:function regexp_matches_item_stripped global string argv integer argv2 returns string\r

 string.inc:function titlecase global string argv returns string\r
 string.inc:function replaceall global string argv string argv2 string argv3 returns string\r
 string.inc:function zeropad global string argv integer argv2 returns string\r
 string.inc:function titlecase global string argv returns string\r
 string.inc:function replaceall global string argv string argv2 string argv3 returns string\r
 string.inc:function zeropad global string argv integer argv2 returns string\r


@@ -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\r
 string.inc:function nbstring global string argv string argv2 returns string\r
 string.inc:function msxsl global string engine string source string stylesheet string params string outfile returns string\r
 string.inc:function sanitize_str global string l_sInput string l_sLevel returns string\r
 string.inc:function nbstring global string argv string argv2 returns string\r
 string.inc:function msxsl global string engine string source string stylesheet string params string outfile returns string\r

+string.inc:function is_number global string argv returns integer\r
+string.inc:function is_integer global string argv returns integer\r

 tstamp.inc:function timestemp_to_posix global string inTs returns number\r
 tstamp.inc:function posix_to_timestamp global number argv returns string\r
 tstamp.inc:function timestamp_adjust global string inTs number inMSeconds returns string\r
 tstamp.inc:function timestemp_to_posix global string inTs returns number\r
 tstamp.inc:function posix_to_timestamp global number argv returns string\r
 tstamp.inc:function timestamp_adjust global string inTs number inMSeconds returns string\r

diff --git a/src/df32/regex.inc b/src/df32/regex.inc
index a0f9b5ca7870f73868217feb82bcce347267cc5f..32e00104473911ae41560dd4a976442cd0e5e5b8 100644 (file)
--- a/src/df32/regex.inc
+++ b/src/df32/regex.inc
@@ -22,144 +22,182 @@
 //-------------------------------------------------------------------------\r
 \r
 // All the regex function accept a set of flags, this can be one or more of:\r
 //-------------------------------------------------------------------------\r
 \r
 // All the regex function accept a set of flags, this can be one or more of:\r

-//             g = Perform match against each substring rather than just the first (greedy)\r
-//             n = Perform newline-sensitive matching\r
-//             i = Perform cases insensitive matching\r
+//      g = Perform match against each substring rather than just the first (greedy)\r
+//      n = Perform newline-sensitive matching\r
+//      i = Perform cases insensitive matching\r

 \r
 //Purely check if a regex expression produces match in the input string\r
 // Returns 1 on match, 0 on no match\r
 \r
 //Purely check if a regex expression produces match in the input string\r
 // Returns 1 on match, 0 on no match\r

-//       E.g\r
+//    E.g\r

 //    move (regexp_match('the quick brown fox jumps over the lazy dog.', 'fox', 'g'))\r
 function regexp_match global string str string pattern string flags returns integer\r
 //    move (regexp_match('the quick brown fox jumps over the lazy dog.', 'fox', 'g'))\r
 function regexp_match global string str string pattern string flags returns integer\r

-       local integer l_iReturn\r
-       local pointer l_pStr l_pPattern l_pFlags\r
-       \r
-       getaddress of str to l_pStr\r
-       getaddress of pattern to l_pPattern\r
-       getaddress of flags to l_pFlags\r
-       \r
-       move (RegexpMatch(l_pStr, l_pPattern, l_pFlags, ERRORS_TO_STDERR)) to l_iReturn\r
-       \r
-       function_return l_iReturn\r
+    local integer l_iReturn\r
+    local pointer l_pStr l_pPattern l_pFlags\r
+    \r
+    getaddress of str to l_pStr\r
+    getaddress of pattern to l_pPattern\r
+    getaddress of flags to l_pFlags\r
+    \r
+    move (RegexpMatch(l_pStr, l_pPattern, l_pFlags, ERRORS_TO_STDERR)) to l_iReturn\r
+    \r
+    function_return l_iReturn\r

 end_function   \r
 \r
 //Return a string containing all regex matches in the input string\r
 //    E.g\r
 //    move (regexp_matches('the quick brown fox jumps over the la\{zy d"og.', 'fox|(the)|brown|(la\\\{zy)|(d"og)', 'g')) to myString\r
 function regexp_matches global string str string pattern string flags returns string\r
 end_function   \r
 \r
 //Return a string containing all regex matches in the input string\r
 //    E.g\r
 //    move (regexp_matches('the quick brown fox jumps over the la\{zy d"og.', 'fox|(the)|brown|(la\\\{zy)|(d"og)', 'g')) to myString\r
 function regexp_matches global string str string pattern string flags returns string\r

-       local integer l_iReturn\r
-       local pointer l_pStr l_pPattern l_pFlags l_pOut\r
-       local string l_sOut l_sReturn\r
-       \r
-       move "" to l_sReturn\r
-       getaddress of str to l_pStr\r
-       getaddress of pattern to l_pPattern\r
-       getaddress of flags to l_pFlags\r
-       zerostring MAX_DFREGEX_BUFFER to l_sOut\r
-       getaddress of l_sOut to l_pOut\r
-       \r
-       move (RegexpMatches(l_pStr, l_pPattern, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn\r
-       \r
-       if (l_iReturn = 0);\r
-               move (cstring(l_sOut)) To l_sReturn\r
-       else begin\r
-               if (l_iReturn = -1);\r
-                       custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER                       \r
-               if (l_iReturn = -2);\r
+    local integer l_iReturn\r
+    local pointer l_pStr l_pPattern l_pFlags l_pOut\r
+    local string l_sOut l_sReturn\r
+    \r
+    move "" to l_sReturn\r
+    getaddress of str to l_pStr\r
+    getaddress of pattern to l_pPattern\r
+    getaddress of flags to l_pFlags\r
+    zerostring MAX_DFREGEX_BUFFER to l_sOut\r
+    getaddress of l_sOut to l_pOut\r
+    \r
+    move (RegexpMatches(l_pStr, l_pPattern, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn\r
+    \r
+    if (l_iReturn = 0);\r
+        move (cstring(l_sOut)) To l_sReturn\r
+    else begin\r
+        if (l_iReturn = -1);\r
+            custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER           \r
+        if (l_iReturn = -2);\r

                         custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE\r
                         custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE\r

-               move "" to l_sReturn\r
-       end\r
-       \r
-       function_return l_sReturn\r
+        move "" to l_sReturn\r
+    end\r
+    \r
+    function_return l_sReturn\r

 end_function \r
 \r
 //Perform a replacement on the input string all matches with the given pattern\r
 //    E.g.\r
 //    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\r
 function regexp_replace global string str string pattern string replacement string flags returns string\r
 end_function \r
 \r
 //Perform a replacement on the input string all matches with the given pattern\r
 //    E.g.\r
 //    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\r
 function regexp_replace global string str string pattern string replacement string flags returns string\r

-       local integer l_iReturn\r
-       local pointer l_pStr l_pPattern l_pFlags l_pReplacement l_pOut\r
-       local string l_sOut l_sReturn\r
-       \r
-       move "" to l_sReturn\r
-       getaddress of str to l_pStr\r
-       getaddress of pattern to l_pPattern\r
-       getaddress of flags to l_pFlags\r
-       getaddress of replacement to l_pReplacement\r
-       zerostring MAX_DFREGEX_BUFFER to l_sOut\r
-       getaddress of l_sOut to l_pOut\r
-       \r
-       move (RegexpReplace(l_pStr, l_pPattern, l_pReplacement, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn\r
-       \r
-       if (l_iReturn = 0);\r
-               move (cstring(l_sOut)) To l_sReturn\r
-       else begin\r
-               if (l_iReturn = -1);\r
-                       custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER                       \r
-               if (l_iReturn = -2);\r
+    local integer l_iReturn\r
+    local pointer l_pStr l_pPattern l_pFlags l_pReplacement l_pOut\r
+    local string l_sOut l_sReturn\r
+    \r
+    move "" to l_sReturn\r
+    getaddress of str to l_pStr\r
+    getaddress of pattern to l_pPattern\r
+    getaddress of flags to l_pFlags\r
+    getaddress of replacement to l_pReplacement\r
+    zerostring MAX_DFREGEX_BUFFER to l_sOut\r
+    getaddress of l_sOut to l_pOut\r
+    \r
+    move (RegexpReplace(l_pStr, l_pPattern, l_pReplacement, l_pFlags, l_pOut, MAX_DFREGEX_BUFFER, ERRORS_TO_STDERR)) to l_iReturn\r
+    \r
+    if (l_iReturn = 0);\r
+        move (cstring(l_sOut)) To l_sReturn\r
+    else begin\r
+        if (l_iReturn = -1);\r
+            custom_error ERROR_CODE_REGEX_BUFFER_OVERFLOW$ ERROR_MSG_REGEX_BUFFER_OVERFLOW MAX_DFREGEX_BUFFER           \r
+        if (l_iReturn = -2);\r

                         custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE\r
                         custom_error ERROR_CODE_REGEX_COMPILE_FAILURE$ ERROR_MSG_REGEX_COMPILE_FAILURE\r

-               move "" to l_sReturn\r
-       end\r
-                       \r
-       function_return l_sReturn\r
+        move "" to l_sReturn\r
+    end\r
+            \r
+    function_return l_sReturn\r

 end_function \r
 \r
 // Parse an output string from regexp_matches to get the result count\r
 //    E.g\r
 //    move (regexp_matches_count(myRegexMatchesOutput)) to myInt\r
 function regexp_matches_count global string argv returns integer\r
 end_function \r
 \r
 // Parse an output string from regexp_matches to get the result count\r
 //    E.g\r
 //    move (regexp_matches_count(myRegexMatchesOutput)) to myInt\r
 function regexp_matches_count global string argv returns integer\r

-       local integer l_iCount l_i\r
-       local string l_sChar l_sLast\r
-       \r
-       move "" to l_sChar\r
-       move "" to l_sLast\r
-       for l_i from 0 to (length(argv))\r
-               move (mid(argv,1,l_i)) to l_sChar\r
-               if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount\r
-               move l_sChar to l_sLast\r
-       loop\r
-       \r
-       function_return l_iCount\r
+    local integer l_iCount l_i\r
+    local string l_sChar l_sLast\r
+    \r
+    move "" to l_sChar\r
+    move "" to l_sLast\r
+    for l_i from 0 to (length(argv))\r
+        move (mid(argv,1,l_i)) to l_sChar\r
+        if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount\r
+        move l_sChar to l_sLast\r
+    loop\r
+    \r
+    function_return l_iCount\r

 end_function\r
 \r
 // Parse an output string from regexp_matches to get the result at an index\r
 end_function\r
 \r
 // Parse an output string from regexp_matches to get the result at an index\r

+// This can then be treated as csv data.\r

 //    E.g\r
 //    move (regexp_matches_item(myRegexMatchesOutput,muInt)) to myString\r
 //    E.g\r
 //    move (regexp_matches_item(myRegexMatchesOutput,muInt)) to myString\r

+//    object mt is a StringTokenizer\r
+//    end_object\r
+//    move (regexp_matches_count(myString)) to myCount\r
+//    for i from 1 to myCount\r
+//        move (regexp_matches_item(myString,i)) to bufString\r
+//        send delete_data to mt    \r
+//        send set_string_csv to mt bufString\r
+//        get token_count of mt to myTokenCount\r
+//        for j from 0 to myTokenCount\r
+//            get token_value of mt item j to bufString\r
+//           showln i "-" j ")" buf\r
+//        loop\r
+//  loop\r

 function regexp_matches_item global string argv integer argv2 returns string\r
 function regexp_matches_item global string argv integer argv2 returns string\r

-       local integer l_iCount l_i l_iOpen l_iQuot\r
-       local string l_sChar l_sLast l_sNext l_sBuf\r
-       \r
-       move 0 to l_iCount\r
-       move 0 to l_iOpen\r
-       move 0 to l_iQuot\r
-       move "" to l_sLast\r
-       for l_i from 0 to (length(argv))\r
-               move (mid(argv,1,l_i)) to l_sChar\r
-               move (mid(argv,1,l_i-1)) to l_sLast\r
-               \r
-               if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount            \r
-               if (l_iCount <> argv2) break begin\r
+    local integer l_iCount l_i\r
+    local string l_sChar l_sLast l_sReturn\r
+    \r
+    move "" to l_sChar\r
+    move "" to l_sLast\r
+    move "" to l_sReturn\r
+    for l_i from 0 to (length(argv))\r
+        move (mid(argv,1,l_i)) to l_sChar\r
+        move (mid(argv,1,l_i-1)) to l_sLast\r
+        if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount        \r
+        if ((l_sChar = '}') and (l_sLast <> '\') and (l_iCount = argv2)) break\r
+        if (((l_sChar = '{') and (l_sLast <> '\')) or (l_iCount < argv2)) break begin\r
+        \r
+        append l_sReturn l_sChar\r
+    loop\r
+    \r
+    function_return l_sReturn\r
+end_function\r
+\r
+// Parse an output string from regexp_matches to get the result at an index\r
+// stripping out all escaping.\r
+//    E.g\r
+//    move (regexp_matches_item_stripped(myRegexMatchesOutput,muInt)) to myString\r
+function regexp_matches_item_stripped global string argv integer argv2 returns string\r
+    local integer l_iCount l_i l_iOpen l_iQuot\r
+    local string l_sChar l_sLast l_sNext l_sBuf\r
+    \r
+    move 0 to l_iCount\r
+    move 0 to l_iOpen\r
+    move 0 to l_iQuot\r
+    move "" to l_sLast\r
+    for l_i from 0 to (length(argv))\r
+        move (mid(argv,1,l_i)) to l_sChar\r
+        move (mid(argv,1,l_i-1)) to l_sLast\r
+        \r
+        if ((l_sChar = '{') and (l_sLast <> '\')) increment l_iCount        \r
+        if (l_iCount <> argv2) break begin\r

 \r
 \r

-               move (mid(argv,1,l_i+1)) to l_sNext\r
-               \r
-               if ((l_sChar = '{') and not (l_iQuot)) begin\r
-                       move 1 to l_iOpen\r
-                       move "" to l_sBuf       \r
-               end             \r
-               else if ((l_sChar = '}') and not (l_iQuot)) begin\r
-                       move 0 to l_iOpen\r
-               end     \r
-               else if ((l_sChar = '"') and (l_sLast <> '\')) begin\r
-                       if (l_iQuot) move 0 to l_iQuot\r
-                       else move 1 to l_iQuot\r
-               end\r
-               if ((l_sChar = ',') and not (l_iOpen)) break begin\r
-               if (((l_sChar = '{') or (l_sChar = '}')) and not (l_iQuot)) break begin\r
-               if ((l_sChar = '"') and (l_sLast <> '\')) break begin\r
-               if ((l_iQuot) and (l_sChar = '\') and ((l_sNext = '"') or (l_sNext = '\'))) break begin\r
-               \r
-               append l_sBuf l_sChar           \r
-       loop\r
-       \r
-       function_return l_sBuf\r
-end_function
\ No newline at end of file
+        move (mid(argv,1,l_i+1)) to l_sNext\r
+        \r
+        if ((l_sChar = '{') and not (l_iQuot)) begin\r
+            move 1 to l_iOpen\r
+            move "" to l_sBuf   \r
+        end     \r
+        else if ((l_sChar = '}') and not (l_iQuot)) begin\r
+            move 0 to l_iOpen\r
+        end \r
+        else if ((l_sChar = '"') and (l_sLast <> '\')) begin\r
+            if (l_iQuot) move 0 to l_iQuot\r
+            else move 1 to l_iQuot\r
+        end\r
+        if ((l_sChar = ',') and not (l_iOpen)) break begin\r
+        if (((l_sChar = '{') or (l_sChar = '}')) and not (l_iQuot)) break begin\r
+        if ((l_sChar = '"') and (l_sLast <> '\')) break begin\r
+        if ((l_iQuot) and (l_sChar = '\') and ((l_sNext = '"') or (l_sNext = '\'))) break begin\r
+        \r
+        append l_sBuf l_sChar       \r
+    loop\r
+    \r
+    function_return l_sBuf\r
+end_function\r

diff --git a/src/df32/string.inc b/src/df32/string.inc
index f951c2ed1faed620c9f7743181acffeb97ff9231..e09adf87bce360d56c454f20ab7f00c00c256f85 100644 (file)
--- 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   \r
 end_function\r
 \r
     function_return l_sReturn   \r
 end_function\r
 \r

-// Return none blank of two strings\r
+// Return one blank of two strings\r

 function nbstring global string argv string argv2 returns string\r
     if (argv <> "") function_return argv\r
     else if (argv2 <> "") function_return argv2\r
 function nbstring global string argv string argv2 returns string\r
     if (argv <> "") function_return argv\r
     else if (argv2 <> "") function_return argv2\r


@@ -261,6 +261,90 @@ function msxsl global string engine string source string stylesheet string param
     function_return l_sReturn\r
 end_function\r
 \r
     function_return l_sReturn\r
 end_function\r
 \r

+// Check if a string looks like a valid dataflex number\r
+//True\r
+// showln (is_number("99999999999999.99999999")) (is_number("-99999999999999.99999999"))\r
+// showln (is_number("99999999999999.0")) (is_number("0")) (is_number("-0")) (is_number("100"))\r
+//False\r
+// showln (is_number("99999999999999.999999999")) (is_number("-999999999999999.99999999"))\r
+// showln (is_number("999999999999999.99999999")) (is_number("1-0")) (is_number(".0D"))\r
+// showln (is_number("")) (is_number("-")) (is_number("100A")) (is_number("A100"))\r
+function is_number global string argv returns integer\r
+    local integer l_iChar l_iDec l_iNum l_iLen l_i l_iNeg\r
+        \r
+    move 0 to l_iNum    \r
+    move 0 to l_iDec\r
+    \r
+    // Is the value negative\r
+    if (ascii(mid(argv,1,1)) = 45);\r
+        move 1 to l_iNeg\r
+    else;\r
+        move 0 to l_iNeg\r
+    \r
+    move (length(argv)) to l_iLen\r
+    \r
+    // Check basic length conforms to number\r
+    if ((l_iLen-L_iNeg = 0) or (l_iLen-l_iNeg > 23)) function_return 0\r
+    \r
+    //Check for non numerics\r
+    for l_i from (1+l_iNeg) to l_iLen\r
+        move (ascii(mid(argv,1,l_i))) to l_iChar\r
+        if ((l_iChar = 46) and ((l_iDec = 1) or (l_i > 15+l_iNeg))) break\r
+        if not ((l_iChar >= 48) and (l_iChar <= 57) or (l_iChar = 46)) break                        \r
+        if (l_iChar = 46);\r
+            move 1 to l_iDec\r
+        increment l_iNum\r
+    loop\r
+    \r
+    function_return ((l_iNum+l_iNeg) = l_iLen)\r
+end_function\r
+\r
+\r
+// Check if a string looks like a valid dataflex integer\r
+//True\r
+// showln (is_integer("2147483647")) (is_integer("2147483638")) \r
+// showln (is_integer("-2147483647")) (is_integer("-2147483648")) \r
+// showln (is_integer("0")) (is_integer("-0"))\r
+//False\r
+// showln (is_integer("214748364 ")) (is_integer("2147483648")) (is_integer("2947483647"))\r
+// showln (is_integer("-2147483649")) (is_integer("21474836478")) (is_integer("21474836470"))\r
+// showln (is_integer("-21474836470")) (is_integer("214748364A")) (is_integer("-A"))\r
+// showln (is_integer("-214748364A")) (is_integer("-")) (is_integer("-21474B364P"))\r
+function is_integer global string argv returns integer\r
+    local integer l_iChar l_iInt l_iLen l_i l_iNeg \r
+    \r
+    move 0 to l_iInt\r
+    move (length(argv)) to l_iLen\r
+    \r
+    //Is the value negative\r
+    if (ascii(mid(argv,1,1)) = 45);\r
+        move 1 to l_iNeg\r
+    else;\r
+        move 0 to l_iNeg    \r
+    \r
+    // Check basic length conforms to integer\r
+    if ((l_iLen-L_iNeg = 0) or (l_iLen-l_iNeg > 10)) function_return 0  \r
+    \r
+    //Check for non numerics\r
+    for l_i from (1+l_iNeg) to l_iLen\r
+        move (ascii(mid(argv,1,l_i))) to l_iChar\r
+        if not ((l_iChar >= 48) and (l_iChar <= 57)) break\r
+        increment l_iInt\r
+    loop\r
+\r
+    //Check for 32 bit signed integer bounds\r
+    if ((l_iLen-l_iNeg = 10) and ((l_iInt+l_iNeg) = l_iLen)) begin              \r
+        if (integer(mid(argv,9,1+l_iNeg)) > 214748364);\r
+            function_return 0\r
+        if (integer(mid(argv,9,1+l_iNeg)) = 214748364) begin        \r
+            if (integer(mid(argv,1,10+l_iNeg)) > 7+l_iNeg);\r
+                function_return 0\r
+        end\r
+    end\r
+        \r
+    function_return ((l_iInt+l_iNeg) = l_iLen)\r
+end_function\r
+\r

 //-------------------------------------------------------------------------\r
 // Classes\r
 //-------------------------------------------------------------------------\r
 //-------------------------------------------------------------------------\r
 // Classes\r
 //-------------------------------------------------------------------------\r


@@ -268,11 +352,11 @@ end_function
 // String tokenizer class\r
 //\r
 // Send message methods:\r
 // String tokenizer class\r
 //\r
 // Send message methods:\r

-//    set_string <string> <delimiter>  - Send the string to be tokenized and the delimiter to split on\r
-//    set_string_csv <string>              - Send a CSV string to be tokenized. As per general CSV data:\r
-//                                                                                     * Items containting commas to be enclosed in double quotes:  '"'\r
-//                                                                                     * Double quotes in quotes to be escaped with a backslash:    '\'\r
-//                                                                                     \r
+//    set_string <string> <delimiter>   - Send the string to be tokenized and the delimiter to split on\r
+//    set_string_csv <string>           - Send a CSV string to be tokenized. As per general CSV data:\r
+//                                          * Items containting commas to be enclosed in double quotes:  '"'\r
+//                                          * Double quotes in quotes to be escaped with a backslash:    '\'\r
+//                                          \r

 // Set methods:\r
 //    token_value \r
 //\r
 // Set methods:\r
 //    token_value \r
 //\r


@@ -333,45 +417,46 @@ class StringTokenizer is an array
         set c_iTokens to l_iTokens\r
     end_procedure\r
     \r
         set c_iTokens to l_iTokens\r
     end_procedure\r
     \r

-       procedure set_string_csv string argv    \r
-               local integer l_i l_iQuot l_iTokens\r
-               local string l_sChar l_sLast l_sNext l_sBuf\r
-               \r
-               move -1 to l_iTokens\r
-               move 0 to l_iQuot\r
-               move "" to l_sLast\r
-               \r
-               for l_i from 0 to (length(argv))\r
-                       move (mid(argv,1,l_i)) to l_sChar\r
-                       move (mid(argv,1,l_i+1)) to l_sNext\r
-                       move (mid(argv,1,l_i-1)) to l_sLast             \r
-                       \r
-                       if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '"')) break begin\r
-                       \r
-                       if ((l_sChar = '"') and (l_sLast <> '\')) begin\r
-                               if (l_iQuot) move 0 to l_iQuot\r
-                               else move 1 to l_iQuot\r
-                       end\r
-                       if ((l_sChar = '"') and (l_sLast <> '\')) break begin           \r
-                       \r
-                       if ((l_sChar = ',') and not (l_iQuot)) begin\r
-                               //fwd to Array\r
-                               increment l_iTokens\r
-                               forward set array_value item l_iTokens to l_sBuf\r
-                               move "" to l_sBuf\r
-                       end\r
-                       if ((l_sChar = ',') and not (l_iQuot)) break begin\r
-                       \r
-                       append l_sBuf l_sChar\r
-               loop\r
-               \r
-               //fwd to Array\r
-               increment l_iTokens             \r
-               forward set array_value item l_iTokens to l_sBuf\r
+    procedure set_string_csv string argv    \r
+        local integer l_i l_iQuot l_iTokens\r
+        local string l_sChar l_sLast l_sNext l_sBuf\r
+        \r
+        move -1 to l_iTokens\r
+        move 0 to l_iQuot\r
+        move "" to l_sLast\r
+        \r
+        for l_i from 0 to (length(argv))\r
+            move (mid(argv,1,l_i)) to l_sChar\r
+            move (mid(argv,1,l_i+1)) to l_sNext\r
+            move (mid(argv,1,l_i-1)) to l_sLast     \r
+            \r
+            if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '"')) break begin\r
+            if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '\')) break begin\r
+            \r
+            if ((l_sChar = '"') and (l_sLast <> '\')) begin\r
+                if (l_iQuot) move 0 to l_iQuot\r
+                else move 1 to l_iQuot\r
+            end\r
+            if ((l_sChar = '"') and (l_sLast <> '\')) break begin       \r
+            \r
+            if ((l_sChar = ',') and not (l_iQuot)) begin\r
+                //fwd to Array\r
+                increment l_iTokens\r
+                forward set array_value item l_iTokens to l_sBuf\r
+                move "" to l_sBuf\r
+            end\r
+            if ((l_sChar = ',') and not (l_iQuot)) break begin\r
+            \r
+            append l_sBuf l_sChar\r
+        loop\r
+        \r
+        //fwd to Array\r
+        increment l_iTokens     \r
+        forward set array_value item l_iTokens to l_sBuf\r

 \r
 \r

-               set c_iTokenOn to 0             \r
+        set c_iTokenOn to 0     \r

         set c_iTokens to l_iTokens\r
         set c_iTokens to l_iTokens\r

-       end_procedure    \r
+    end_procedure    \r

 \r
     procedure set token_value integer itemx string val\r
         forward set array_value item itemx to val\r
 \r
     procedure set token_value integer itemx string val\r
         forward set array_value item itemx to val\r

diff --git a/src/df32/tcpcomm.h b/src/df32/tcpcomm.h
deleted file mode 100644 (file)
index 17c2ce5..0000000
--- a/src/df32/tcpcomm.h
+++ /dev/null
@@ -1,26 +0,0 @@
-//-------------------------------------------------------------------------\r
-// tcpcomm.h\r
-//      This file contains definitions of "Win32" api functions provided by\r
-//      the df32func.dll dynamic link library.\r
-//\r
-// This file is to be included when using socket networking in df32func.mk\r
-//\r
-// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
-//\r
-// df32func/tcpcomm.h\r
-//-------------------------------------------------------------------------\r
-\r
-Define __tcpcomm_h__\r
-\r
-//-------------------------------------------------------------------------\r
-// External functions\r
-//-------------------------------------------------------------------------\r
-\r
-external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer\r
-external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer\r
-external_function AcceptClient "AcceptClient" df32func.dll returns integer\r
-external_function Send "Send" df32func.dll dword socket string data returns integer\r
-external_function Receive "Receive" df32func.dll dword socket pointer dataOut returns integer\r
-external_function CloseConnection "CloseConnection" df32func.dll dword socket returns integer\r
-external_function PseudoRand "PseudoRand" df32func.dll dword w returns integer\r
-external_function RdtscRand "RdtscRand" df32func.dll returns integer\r