--- /dev/null
+/*-------------------------------------------------------------------------\r
+ * gnuregex.c\r
+ * posix regex extensions\r
+ *\r
+ * Copyright (c) 2007-2015, glyn@8kb.co.uk\r
+ * Author: Glyn Astill <glyn@8kb.co.uk>\r
+ *\r
+ *-------------------------------------------------------------------------\r
+ */\r
+\r
+#include <stdio.h>\r
+#include <stdlib.h>\r
+#include <string.h>\r
+#include <regex.h>\r
+#include "memman.h"\r
+\r
+#define MAX_ERROR_MSG 0x1000\r
+\r
+/*\r
+ * Return a properly escaped / quoted string\r
+ */\r
+static char * quote_output(char *str) {\r
+ char *result;\r
+ char *result_return;\r
+ int len;\r
+ int do_quote = 0;\r
+ char *ptr;\r
+\r
+ len = strlen(str);\r
+\r
+ /* Check for characters that need quoting */\r
+ for (ptr = str; *ptr; ptr++) {\r
+ char ch = *ptr;\r
+ if (ch == '\"' || ch =='\\' || ch == '\{' || ch == ',') {\r
+ do_quote = 1;\r
+ break;\r
+ }\r
+ }\r
+\r
+ /* If we find no characters that need quoting just return the input */\r
+ if (do_quote != 1)\r
+ return str;\r
+\r
+ /* Do the quoting, here the allocation is wasteful */\r
+ result = (char *) wmalloc((len * 2 + 3) * sizeof(char));\r
+ result_return = result;\r
+\r
+ /*\r
+ * Starting address of result is incremented as we modify it's contents here\r
+ * with result_return keeping the starting address\r
+ */\r
+ *result++ = '"';\r
+ while (len-- > 0) {\r
+ /* Escape double quotes and backslash with backslash */\r
+ if (*str == '"') {\r
+ *result++ = '\\';\r
+ }\r
+ if (*str == '\\') {\r
+ *result++ = '\\';\r
+ }\r
+ *result++ = *str++;\r
+ }\r
+ *result++ = '"';\r
+ *result++ = '\0';\r
+\r
+ return result_return;\r
+}\r
+\r
+/*\r
+ * Count open parenthesis to evaluate the number of subexpressions in the regex\r
+ */\r
+static int count_subexpressions(const char *str){\r
+ int result = 0;\r
+ int last_was_backslash = 0;\r
+ const char *ptr;\r
+\r
+ for(ptr=str; *ptr; ptr++){\r
+ if (*ptr == '\\' && !last_was_backslash){\r
+ last_was_backslash = 1;\r
+ continue;\r
+ }\r
+ if (*ptr == ')' && !last_was_backslash)\r
+ result++;\r
+ last_was_backslash = 0;\r
+ }\r
+ return result;\r
+}\r
+\r
+/*\r
+ * Check to see if string contains any escape chars\r
+ * these could of course just be escaped backslashes\r
+ * themselvs.\r
+ */\r
+static int has_escapes(const char *str){\r
+ const char *ptr;\r
+\r
+ for(ptr=str; *ptr; ptr++){\r
+ if (*ptr == '\\')\r
+ return 1;\r
+ }\r
+ return 0;\r
+}\r
+\r
+/*\r
+ * Compile the regex pattern\r
+ */\r
+static int compile_regex(regex_t *re, const char *pattern, const char *flags, int errors)\r
+{\r
+ int status;\r
+ int cflags = REG_EXTENDED;\r
+\r
+ if (strchr(flags, 'i')) {\r
+ cflags = cflags|REG_ICASE;\r
+ }\r
+ if (strchr(flags, 'n')) {\r
+ cflags = cflags|REG_NEWLINE;\r
+ }\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
+ }\r
+ return status;\r
+}\r
+\r
+/*\r
+ * Returns a pointer to a malloced array of regmatch_t containing match offsets\r
+ * in the input string. (As opposed to offests from each match)\r
+ *\r
+ * The regmatch struct info:\r
+ * regmatch_t.rm_so (regoff_t) = byte offset from start of string to start of substring\r
+ * regmatch_t.rm_eo (regoff_t) = byte offset from start of string to first character after the end of substring\r
+ */\r
+static int find_regex_matches(regex_t *re, const char *str, const int nsub, const char *flags, regmatch_t **result)\r
+{\r
+ /* Each individual match and it's subexpression matches stored in m */\r
+ regmatch_t m[nsub+1];\r
+\r
+ /* A pointer into the string at the end of the previous match */\r
+ const char *prev_match_eo = str;\r
+\r
+ /*\r
+ * We return a count of matches and pass back an array of regmatch_t in\r
+ * matches containing match offsets in the original string\r
+ */\r
+ int array_len = strchr(flags, 'g') ? 256 : 32;\r
+ int match_count = 0;\r
+ regmatch_t *matches;\r
+\r
+ matches = (regmatch_t *) wmalloc(sizeof(regmatch_t) * array_len);\r
+\r
+ while (!regexec(re, prev_match_eo, nsub+1, m, 0)) {\r
+ int i = 0;\r
+\r
+ /* resize the matches array; when more space is required double current size */\r
+ while (match_count + (nsub * 2) > array_len) {\r
+ array_len *= 2;\r
+ matches = (regmatch_t *) wrealloc(matches, sizeof(regmatch_t) * array_len);\r
+ }\r
+\r
+ /* when we have subexpressions, we're only interested in their match offsets */\r
+ if (nsub > 0) {\r
+ for (i = 1; i <= nsub; i++) {\r
+ if (m[i].rm_so < 0 || m[i].rm_eo < 0) {\r
+ matches[match_count].rm_so = -1;\r
+ matches[match_count++].rm_eo = -1;\r
+ }\r
+ else {\r
+ matches[match_count].rm_so = (prev_match_eo - str) + m[i].rm_so;\r
+ matches[match_count++].rm_eo = (prev_match_eo - str) + m[i].rm_eo;\r
+ }\r
+ }\r
+ }\r
+ /* else we want the original match offsets*/\r
+ else {\r
+ matches[match_count].rm_so = (prev_match_eo - str) + m[0].rm_so;\r
+ matches[match_count++].rm_eo = (prev_match_eo - str) + m[0].rm_eo;\r
+ }\r
+\r
+ /*\r
+ * If we have matched on a blank expression or we were\r
+ * not flagged to do greedy matching then break\r
+ */\r
+ if (!m[0].rm_eo || !strchr(flags, 'g'))\r
+ break;\r
+\r
+ /*\r
+ * Advance the search position to the end of the current match\r
+ * If the match happens to be zero length, advance search position\r
+ * by one?\r
+ */\r
+ if (m[0].rm_eo == m[0].rm_so)\r
+ prev_match_eo++;\r
+ else\r
+ prev_match_eo += m[0].rm_eo;\r
+ }\r
+ *result = matches;\r
+\r
+ return match_count;\r
+}\r
+\r
+/*\r
+ * Takes regmatch_t array returned by find_regex_matches and returns a malloced\r
+ * string representing the captured substrings.\r
+ */\r
+static char * regex_matches_to_string(const char *str, int nsub, int match_count, regmatch_t *matches) {\r
+ int j;\r
+ int i;\r
+ char *unquoted = NULL;\r
+ char *quoted = NULL;\r
+ int quoted_len;\r
+ char *result;\r
+\r
+ int str_len = strlen(str);\r
+ int allocated_sz = str_len+1;\r
+ result = wmalloc(allocated_sz * sizeof(char));\r
+ int result_sz = 0;\r
+\r
+ j = 0;\r
+ while (j < match_count) {\r
+\r
+ if (j > 0) {\r
+ result_sz += 2;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-2] = ',';\r
+ result[result_sz-1] = '{';\r
+ }\r
+ else {\r
+ result_sz++;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-1] = '{';\r
+ }\r
+\r
+ for (i = 0; i <= nsub; i++) {\r
+ if ((nsub > 0) && (i == 0))\r
+ continue;\r
+\r
+ if (i > 1) {\r
+ result_sz++;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-1] = ',';\r
+ }\r
+\r
+ int so = matches[j].rm_so;\r
+ int eo = matches[j].rm_eo;\r
+\r
+ if (so == -1 || eo == -1) {\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+4) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, "NULL", 4);\r
+ result_sz += 4;\r
+ }\r
+ else {\r
+ unquoted = wmalloc((eo-so)+1 * sizeof(char));\r
+ strncpy(unquoted, str+so, eo-so);\r
+ unquoted[eo-so] = '\0';\r
+ quoted = quote_output(unquoted);\r
+ quoted_len = strlen(quoted);\r
+\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+quoted_len) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, quoted, quoted_len);\r
+ result_sz += quoted_len;\r
+\r
+ if (quoted != unquoted)\r
+ wfree(unquoted);\r
+ wfree(quoted);\r
+ }\r
+ j++;\r
+ }\r
+\r
+ result_sz++;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-1] = '}';\r
+ }\r
+\r
+ result_sz++;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-1] = '\0';\r
+\r
+ return result;\r
+}\r
+\r
+/*\r
+ * Purely check for a match in the regex\r
+ */\r
+int regexp_match(const char *str, const char *pattern, const char *flags, int errors)\r
+{\r
+ regex_t re;\r
+ int result;\r
+ int status;\r
+\r
+ status = compile_regex(&re, pattern, flags, errors);\r
+ if (status == REG_NOERROR) {\r
+ result = regexec(&re, str, (size_t) 0, NULL, 0);\r
+ regfree(&re);\r
+\r
+ if (!result) /* match */\r
+ return 1;\r
+ else /* no match */\r
+ return 0;\r
+ }\r
+ else /* error condition, but still: no match */\r
+ return 0;\r
+}\r
+\r
+/*\r
+ * Return all matches in the regex as a string by first calling find_regex_matches\r
+ * and then regex_matches_to_string. Arguably this could all be one function\r
+ * however separation will make future multiple output formats easier.\r
+ */\r
+char * regexp_matches(const char *str, const char *pattern, const char *flags, int errors)\r
+{\r
+ regex_t re;\r
+ regmatch_t *matches_p = NULL;\r
+ int nsub;\r
+ int match_count;\r
+ int status;\r
+ char *result = NULL;\r
+\r
+ /* Compile the regex */\r
+ status = compile_regex(&re, pattern, flags, errors);\r
+ if (status == REG_NOERROR) {\r
+ /* Count our subexpressions to size our regmatch_t array */\r
+ nsub = count_subexpressions(pattern);\r
+ /* Find all the matches relative to the input string */\r
+ match_count = find_regex_matches(&re, str, nsub, flags, &matches_p);\r
+ /* Turn the matches into an output string */\r
+ result = regex_matches_to_string(str, nsub, match_count, matches_p);\r
+ /* Free up the regmatch_t malloced by find_regex_matches */\r
+ wfree(matches_p);\r
+ regfree(&re);\r
+ }\r
+\r
+ return result;\r
+}\r
+\r
+/*\r
+ * Substitutes matches with the regex pattern in the string with the replacement\r
+ * pattern/string.\r
+ */\r
+char * regexp_replace(const char *str, const char *pattern, const char *replacement, const char *flags, int errors)\r
+{\r
+ regex_t re;\r
+ int nsub;\r
+ char *result = NULL;\r
+ char *match_str;\r
+ int status;\r
+ const char *prev_match_eo = str;\r
+ int str_len = strlen(str);\r
+ int replacement_len = strlen(replacement);\r
+ int allocated_sz = str_len+1;\r
+ int result_sz = 0;\r
+\r
+ status = compile_regex(&re, pattern, flags, errors);\r
+ if (status == REG_NOERROR) {\r
+\r
+ result = wmalloc(allocated_sz * sizeof(char));\r
+\r
+ /* Count our subexpressions to size our regmatch_t array */\r
+ nsub = count_subexpressions(pattern);\r
+ regmatch_t m[nsub+1];\r
+\r
+ while (!regexec(&re, prev_match_eo, nsub+1, m, 0)) {\r
+\r
+ /* Copy everything to the left of the first match */\r
+ if (m[0].rm_so > 0) {\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+m[0].rm_so) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, prev_match_eo, m[0].rm_so);\r
+ result_sz += m[0].rm_so;\r
+ }\r
+\r
+ /* If there are no backreferences in the replacement, copy in the replacement */\r
+ if (!has_escapes(replacement)) {\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+replacement_len) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, replacement, replacement_len);\r
+ result_sz += replacement_len;\r
+ }\r
+ /* Otherwise process the backreferences and copy in subcaptures */\r
+ else {\r
+ /* find the next escape char */\r
+ const char *start = replacement;\r
+ const char *ptr;\r
+\r
+ for(ptr = replacement; *ptr; ptr++) {\r
+ if (*ptr != '\\')\r
+ continue;\r
+\r
+ /* append everything to the left of the current escape */\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+(ptr-start)) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, start, (ptr-start));\r
+ result_sz += (ptr-start);\r
+\r
+ ptr++;\r
+\r
+ if ((*ptr >= '1' && *ptr <= '9') || (*ptr == '&'))\r
+ {\r
+ /* Use the back reference of regexp. */\r
+ int sub;\r
+ if (*ptr == '&')\r
+ sub = 0;\r
+ else\r
+ sub = *ptr - '0';\r
+\r
+ if (m[sub].rm_so != -1 && m[sub].rm_eo != -1 && sub <= nsub) {\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+(m[sub].rm_eo-m[sub].rm_so)) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, prev_match_eo+m[sub].rm_so, (m[sub].rm_eo-m[sub].rm_so));\r
+ result_sz += (m[sub].rm_eo-m[sub].rm_so);\r
+ }\r
+ ptr++;\r
+ }\r
+ else if (*ptr == '\\')\r
+ {\r
+ /* append backsalsh */\r
+ result_sz++;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-1] = '\\';\r
+ ptr++;\r
+ }\r
+ else {\r
+ /* append backsalsh */\r
+ result_sz++;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-1] = '\\';\r
+ }\r
+ start = ptr;\r
+ }\r
+ /*\r
+ * Append right trailing replacement, except in the instance\r
+ * when it starts with character zero, which can happen when the\r
+ * last part of the replace string is escaped.\r
+ */\r
+ if (*start) {\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+(ptr-start)) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, start, (ptr-start));\r
+ result_sz += (ptr-start);\r
+ }\r
+\r
+ }\r
+ prev_match_eo += m[0].rm_eo;\r
+\r
+ /*\r
+ * If we have matched on a blank expression or we were\r
+ * not flagged to do greedy matching then break\r
+ */\r
+ if (!m[0].rm_eo || !strchr(flags, 'g'))\r
+ break;\r
+ }\r
+\r
+ /* Copy everything to the right of the last match */\r
+ result = reallocate_block(result, &allocated_sz, (result_sz+(str_len-(prev_match_eo-str))) * sizeof(char), str_len);\r
+ strncpy(result+result_sz, prev_match_eo, str_len-(prev_match_eo-str));\r
+ result_sz += str_len-(prev_match_eo-str);\r
+\r
+ regfree(&re);\r
+\r
+ result_sz++;\r
+ result = reallocate_block(result, &allocated_sz, result_sz * sizeof(char), str_len);\r
+ result[result_sz-1] = '\0';\r
+ }\r
+ return result;\r
+}\r
--- /dev/null
+/*-------------------------------------------------------------------------\r
+ * gnuregex.h\r
+ * posix regex extension definitions\r
+ *\r
+ * Copyright (c) 2007-2015, glyn@8kb.co.uk\r
+ * Author: Glyn Astill <glyn@8kb.co.uk>\r
+ *\r
+ *--------------------------------------------------------------------------\r
+ */\r
+\r
+#ifndef __GNUREGEX_H__\r
+#define __GNUREGEX_H__\r
+\r
+extern int regexp_match(const char *str, const char *pattern, const char *flags, int errors);\r
+extern char * regexp_matches(const char *str, const char *pattern, const char *flags, int errors);\r
+extern char * regexp_replace(const char *str, const char *pattern, const char *replacement, const char *flags, int errors);\r
+\r
+#endif\r
--- /dev/null
+/*-------------------------------------------------------------------------\r
+ * memman.c\r
+ * wrappers around malloc/realloc/free\r
+ *\r
+ * Copyright (c) 2007-2015, glyn@8kb.co.uk\r
+ * Author: Glyn Astill <glyn@8kb.co.uk>\r
+ *\r
+ *-------------------------------------------------------------------------\r
+ */\r
+\r
+\r
+#include <stdio.h>\r
+#include <stdlib.h>\r
+#include <assert.h>\r
+\r
+/*\r
+ * Wrappers around malloc/realloc/free\r
+ */\r
+void * wmalloc(unsigned int size) {\r
+ char *result;\r
+\r
+ if ((result = malloc(size)) == NULL) {\r
+ fprintf(stderr, "Failed to malloc %d bytes\n", size);\r
+ exit(1);\r
+ }\r
+ return result;\r
+}\r
+\r
+void * wrealloc(void *iptr, unsigned int size) {\r
+ char *result;\r
+\r
+ assert(iptr != NULL);\r
+\r
+ if ((result = realloc(iptr, size)) == NULL) {\r
+ fprintf(stderr, "Failed to realloc %d bytes\n", size);\r
+ exit(1);\r
+ }\r
+ return result;\r
+}\r
+\r
+void wfree(void *iptr){\r
+ assert(iptr != NULL);\r
+\r
+ if (iptr) {\r
+ free(iptr);\r
+ }\r
+ iptr = NULL;\r
+}\r
+\r
+/*\r
+ * Reallocate memory block pointed to by iptr in chunks of chunk_size when\r
+ * required_size is greater than value pointed to be allocated_size.\r
+ * Sets value of allocated_size to current allocation.\r
+ */\r
+void * reallocate_block(void *iptr, int *allocated_size, int required_size, int chunk_size) {\r
+ void *result;\r
+\r
+ if (*allocated_size >= required_size)\r
+ return iptr;\r
+\r
+ *allocated_size += (((required_size-*allocated_size)/chunk_size)+1)*chunk_size;\r
+\r
+ result = wrealloc(iptr, *allocated_size);\r
+\r
+ return result;\r
+}\r
--- /dev/null
+/*-------------------------------------------------------------------------\r
+ * memman.h\r
+ * definitions for wrappers around malloc/realloc/free\r
+ *\r
+ * Copyright (c) 2007-2015, glyn@8kb.co.uk\r
+ * Author: Glyn Astill <glyn@8kb.co.uk>\r
+ *\r
+ *-------------------------------------------------------------------------\r
+ */\r
+\r
+#ifndef __MEMMAN_H__\r
+#define __MEMMAN_H__\r
+\r
+extern void * wmalloc(unsigned int size);\r
+extern void * wrealloc(void *iptr, unsigned int size);\r
+extern void wfree(void *iptr);\r
+extern void * reallocate_block(void *iptr, int *allocated_size, int required_size, int chunk_size);\r
+\r
+#endif\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// df32func.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-2015, glyn@8kb.co.uk\r
+//\r
+// df32func/df32func.h\r
+//-------------------------------------------------------------------------\r
+\r
+Define __df32func_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
+external_function GetTzi "GetTzi" df32func.dll pointer lpTimeZone pointer lpResult returns integer\r
+external_function RegexpMatch "RegexpMatch" df32func.dll pointer str pointer pattern pointer flags integer errors returns integer\r
+external_function RegexpMatches "RegexpMatches" df32func.dll pointer str pointer pattern pointer flags pointer out pointer out_len integer errors returns integer\r
+external_function RegexpReplace "RegexpReplace" df32func.dll pointer str pointer pattern pointer replacement pointer flags pointer out pointer out_len integer errors returns integer
\ No newline at end of file
--- /dev/null
+//-------------------------------------------------------------------------\r
+// regex.inc\r
+// This file contains DataFlex functions to provide basic regex \r
+// functionality based on the GNU POSIX regex library, and accessed\r
+// via Win32 API calls to df32func.dll. \r
+// See df32func.h for external function definitions.\r
+//\r
+// This file is to be included when using Win32 capabilities in df32func.mk\r
+//\r
+// Copyright (c) 2006-2015, glyn@8kb.co.uk\r
+// \r
+// df32func/regex.inc\r
+//-------------------------------------------------------------------------\r
+\r
+#IFDEF __df32func_h__\r
+#ELSE\r
+ #INCLUDE df32func.h\r
+#ENDIF\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\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
+\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
+// 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
+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
+ 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
+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
+ 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
+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
+end_function\r
+\r
+// Parse an output string from regexp_matches to get the result at an index\r
+// E.g\r
+// move (regexp_matches_item(myRegexMatchesOutput,muInt)) to myString\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
+\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
--- /dev/null
+//-------------------------------------------------------------------------
+// tap.inc
+// This file contains some DataFlex 3.2 Console Mode classes
+// to provide some test anything protocol functionality.
+// See: http://testanything.org/
+//
+// This file is to be included in df32func.mk
+//
+// Copyright (c) 2006-2015, glyn@8kb.co.uk
+//
+// df32func/tap.inc
+//-------------------------------------------------------------------------
+
+//-------------------------------------------------------------------------
+// Classes
+//-------------------------------------------------------------------------
+
+// TAP class - impliments the vet basic of the Test Anything Protocol
+//
+// Get methods:
+// plan - Gets the "plan" or expected number of tests
+// tests - Gets the number of tests executed so far
+//
+// Set methods: (All of the following methods are intended to be private)
+// plan <number of tests> - Sets the "plan" or expected number of tests
+//
+// Send message methods:
+// ok <boolean> - Fundamental test, to check binary outcome of an expression
+// is <v1> <v2> <msg> - Test values are equivaent
+// isnt <v1> <v2> <msg> - Test values are not equivaent
+// cmp_ok <val1> <val2> <op> <msg> - Test values are not equivaent
+// finish - Complete the set of tests (also alias "done_testing")
+//
+// Notes
+// If a plan has been set, and the program aborts without calling finish, finish is called
+// automatically, and results will be output. Piping test output to a file or creating a
+// "wrapper" around the program with a simple "chain wait" allows test results to always be
+// seen.
+//
+// Example usage:
+//
+// object myTest is a TAP
+// end_object
+//
+// set plan of myTest to 8
+//
+// send ok to myTest (1=1) "One is equal to one"
+// send ok to myTest (2=1) "Two is equal to one"
+// send ok to myTest (3=3) "Three is equal to three"
+// send is to myTest "pie" 100 "Pie is numeric"
+// send isnt to myTest "pie" "pie" "Both should be pie"
+// send cmp_ok to myTest "pie" "pie" "=" "Pie equals pie"
+// send cmp_ok to myTest 1 2 "=" "One equals two"
+// send cmp_ok to myTest 1 2 ">" "One is greater than two"
+// send cmp_ok to myTest "pankcake" "cake" "~~" "Pankace contains cake"
+//
+// send finish to myTest
+//
+class TAP is an array
+ procedure construct_object integer argc
+ forward send construct_object
+ property integer c_iPlan public argc
+ property integer c_iTest
+ set c_iPlan to -1
+ set c_iTest to 0
+ end_procedure
+
+ procedure set plan integer argv
+ set c_iPlan to argv
+ end_procedure
+
+ function plan
+ local integer l_iPlan
+ get c_iPlan to l_iPlan
+ function_return l_iPlan
+ end_procedure
+
+ function tests
+ local integer l_iTest
+ get c_iTest to l_iTest
+ function_return l_iTest
+ end_procedure
+
+ procedure is string argv string argv2 string argv3
+ local integer l_iTest
+ local string l_sTestResult
+
+ get c_iTest to l_iTest
+ increment l_iTest
+
+ move (ternary((argv = argv2),"1","0")+string(l_iTest)+" - "+argv3) to l_sTestResult
+
+ forward set array_value item l_iTest to l_sTestResult
+ set c_iTest to l_iTest
+ end_procedure
+
+ procedure isnt string argv string argv2 string argv3
+ local integer l_iTest
+ local string l_sTestResult
+
+ get c_iTest to l_iTest
+ increment l_iTest
+
+ move (ternary((argv <> argv2),"1","0")+string(l_iTest)+" - "+argv3) to l_sTestResult
+
+ forward set array_value item l_iTest to l_sTestResult
+ set c_iTest to l_iTest
+ end_procedure
+
+ procedure cmp_ok string argv string argv2 string argv3 string argv4
+ local integer l_iTest
+ local string l_sTestResult
+
+ get c_iTest to l_iTest
+ increment l_iTest
+
+ case begin
+ case ((argv3 = "=") or (argv3 = "eq") or (argv3 = "==")) move (ternary((argv = argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult
+ case break
+ case ((argv3 = "<>") or (argv3 = "ne") or (argv3 = "!=") or (argv3 = "!")) move (ternary((argv <> argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult
+ case break
+ case ((argv3 = ">") or (argv3 = "gt")) move (ternary((argv > argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult
+ case break
+ case ((argv3 = ">=") or (argv3 = "ge")) move (ternary((argv >= argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult
+ case break
+ case ((argv3 = "<") or (argv3 = "lt")) move (ternary((argv < argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult
+ case break
+ case ((argv3 = "<=") or (argv3 = "le")) move (ternary((argv <= argv2),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult
+ case break
+ case ((argv3 = "~") or (argv3 = "~~") or (argv3 = "contains")) move (ternary(((argv contains argv2) > 0),"1","0")+string(l_iTest)+" - "+argv4) to l_sTestResult
+ case break
+ case else custom_error ERROR_CODE_COMPARISON_OPERATOR$ ERROR_MSG_COMPARISON_OPERATOR argv3
+ case end
+
+ forward set array_value item l_iTest to l_sTestResult
+ set c_iTest to l_iTest
+ end_procedure
+
+ procedure ok integer argv string argv2
+ local integer l_iTest
+ local string l_sTestResult
+
+ get c_iTest to l_iTest
+ increment l_iTest
+
+ if ((argv <= 1) and (argv >= 0)) begin
+ move (string(argv)+string(l_iTest)+" - "+argv2) to l_sTestResult
+ end
+ else begin
+ custom_error ERROR_CODE_INVALID_BOOLEAN$ ERROR_MSG_INVALID_BOOLEAN ERROR_DETAIL_INVALID_BOOLEAN argv
+ end
+
+ forward set array_value item l_iTest to l_sTestResult
+ set c_iTest to l_iTest
+ end_procedure
+
+ procedure finish
+ local integer l_iPlan l_iTest l_i l_iStatus
+ local string l_sBuf l_sMsg
+
+ get c_iPlan to l_iPlan
+ get c_iTest to l_iTest
+
+
+ if (l_iPlan <> -1) showln "1.." l_iPlan
+ for l_i from 1 to l_iTest
+ forward get string_value item l_i to l_sBuf
+ move (left(l_sBuf,1)) to l_iStatus
+ move (right(l_sBuf,length(l_sBuf)-1)) to l_sMsg
+
+ if (l_iStatus = 1) begin
+ showln "ok " l_sMsg
+ end
+ else begin
+ showln "not ok " l_sMsg
+ end
+ loop
+
+ if (l_iPlan <> -1) begin
+ set c_iPlan to -1
+ end
+ else showln "1.." l_iTest
+
+ forward send delete_data
+ set c_iTest to 0
+ end_procedure
+
+ procedure done_testing
+ send finish
+ end_procedure
+
+ procedure destroy_object
+ local integer l_iPlan
+ get c_iPlan to l_iPlan
+ if (l_iPlan <> -1) send finish
+ //forward send destroy_object
+ send destroy_object
+ end_procedure
+
+end_class
+
+// TAP_harness class - overrides finish method of TAP class to provide a
+// basic harness
+//
+// Inherits all methods from TAP
+//
+// Set methods: (extra methods)
+// timing_on - Turns on test timing
+// timing_off - Turns off test timing
+// notices_on - Turns on test notices
+// notices_off - Turns off test notices
+//
+class TAP_harness is a TAP
+ procedure construct_object integer argc
+ forward send construct_object argc
+ property integer c_iNotices
+ property integer c_iTiming
+ property integer c_nStart
+ set c_iNotices to 0
+ set c_iTiming to 0
+ end_procedure
+
+ function get_timer_seconds returns number
+ local date l_dDate
+ local number l_nHr l_nMin l_nSec
+
+ sysdate l_dDate l_nHr l_nMin l_nSec
+ function_return ((integer(l_dDate)-integer(date("01/01/1970"))*86400)+(((l_nHr*60)+l_nMin)*60)+l_nSec)
+ end_procedure
+
+ procedure notices_on
+ set c_iNotices to 1
+ end_procedure
+
+ procedure notices_off
+ set c_iNotices to 0
+ end_procedure
+
+ procedure timing_on
+ local number l_iSecs
+ set c_iTiming to 1
+ get get_timer_seconds to l_iSecs
+ set c_nStart to l_iSecs
+ end_procedure
+
+ procedure timing_off
+ set c_iTiming to 0
+ end_procedure
+
+ procedure finish
+ local integer l_iPlan l_iTest l_i l_iStatus l_iFailed l_iNotices l_iTiming
+ local string l_sBuf l_sMsg l_sFailed
+ local number l_nStart l_nSecs
+
+ forward get c_iPlan to l_iPlan
+ forward get c_iTest to l_iTest
+ get c_iNotices to l_iNotices
+ get c_iTiming to l_iTiming
+
+ move 0 to l_iFailed
+ move "" to l_sFailed
+
+ if (l_iPlan <> -1) showln "1.." l_iPlan
+ for l_i from 1 to l_iTest
+ forward get string_value item l_i to l_sBuf
+ move (left(l_sBuf,1)) to l_iStatus
+ move (right(l_sBuf,length(l_sBuf)-1)) to l_sMsg
+
+ if (l_iStatus = 1) begin
+ showln "ok " l_sMsg
+ end
+ else begin
+ showln "not ok " l_sMsg
+ if (l_iFailed > 0) append l_sFailed ", "
+ append l_sFailed l_i
+ increment l_iFailed
+ end
+ loop
+
+ if (l_iPlan <> -1) begin
+ if (l_iNotices) begin
+ if (l_iTest < l_iPlan);
+ showln "Notice: Only ran " l_iTest " of " l_iPlan " tests"
+ if (l_iTest > l_iPlan);
+ showln "Notice: Ran " l_iTest " tests, but only expected " l_iPlan
+ end
+
+ if (l_iFailed > 0) begin
+ showln "FAILED test" (ternary((l_iFailed > 1),"s "," ")) l_sFailed
+ showln "Failed " l_iFailed "/" l_iTest " tests, " (decround(1-(number(l_iFailed)/number(l_iTest))*100,2)) "% ok"
+ end
+
+ forward set c_iPlan to -1
+ end
+ else showln "1.." l_iTest
+
+ if (l_iTiming) begin
+ get get_timer_seconds to l_nSecs
+ get c_nStart to l_nStart
+ showln "Timing: " (l_nSecs-l_nStart) " seconds"
+ end
+ end_procedure
+
+end_class