Skip to content

Commit

Permalink
Merge branch 'master' into BCK-6946
Browse files Browse the repository at this point in the history
  • Loading branch information
@resuna
resuna committed Apr 29, 2024
2 parents 06f5cea + 6f6e346 commit 2cbb377
Show file tree
Hide file tree
Showing 17 changed files with 182 additions and 1,953 deletions.
4 changes: 2 additions & 2 deletions .github/workflows/linux-ci.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,8 @@ jobs:
run: |
sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test
sudo apt-get update -qq
sudo apt-get install -y gcc-7 g++-7
sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-7 70 --slave /usr/bin/g++ g++ /usr/bin/g++-7
sudo apt-get install -y gcc-11 g++-11
sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-11 70 --slave /usr/bin/g++ g++ /usr/bin/g++-11
sudo apt-get install -y tcl8.6-dev
- name: configure
run: |
Expand Down
4 changes: 2 additions & 2 deletions README.md
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
![Linux CI](https://github.com/flightaware/Pgtcl/workflows/Linux%20CI/badge.svg)
![Mac CI](https://github.com/flightaware/Pgtcl/workflows/Mac%20CI/badge.svg)
[![Linux CI](https://github.com/flightaware/Pgtcl/actions/workflows/linux-ci.yml/badge.svg)](https://github.com/flightaware/Pgtcl/actions/workflows/linux-ci.yml)
[![Mac CI](https://github.com/flightaware/Pgtcl/actions/workflows/mac-ci.yml/badge.svg)](https://github.com/flightaware/Pgtcl/actions/workflows/mac-ci.yml)

Thank you for downloading Pgtcl, a package that adds PostgreSQL interface extensions to the Tcl programming language... an open source project that's been in existence for nearly twenty years.

Expand Down
2 changes: 1 addition & 1 deletion configure.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ dnl to configure the system for the local environment.
# so you can encode the package version directly into the source files.
#-----------------------------------------------------------------------

AC_INIT([pgtcl], [2.8.1])
AC_INIT([pgtcl], [3.0.1])

#-----
# Version with patch stripped
Expand Down
3 changes: 3 additions & 0 deletions generic/libpgtcl.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,9 @@

#include <tcl.h>

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

EXTERN int Pgtcl_Init(Tcl_Interp *interp);
extern int Pgtcl_SafeInit(Tcl_Interp *interp);

Expand Down
88 changes: 19 additions & 69 deletions generic/pgtcl.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,35 +24,9 @@
#endif

#ifdef WIN32
#include <c.h>
#include <winsock2.h>
#endif

#ifdef _MSC_VER
/* Only do this when MSVC++ is compiling us. */
#ifdef USE_TCL_STUBS
/* Mark this .obj as needing tcl's Stubs library. */
#pragma comment(lib, "tclstub" \
STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) ".lib")
#if !defined(_MT) || !defined(_DLL) || defined(_DEBUG)

/*
* This fixes a bug with how the Stubs library was compiled. The
* requirement for msvcrt.lib from tclstubXX.lib should be removed.
*/
#pragma comment(linker, "-nodefaultlib:msvcrt.lib")
#endif
#else
/* Mark this .obj needing the import library */
#pragma comment(lib, "tcl" \
STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) ".lib")
#endif
#endif
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
/* END STUBS MUMBO JUMBO */



typedef struct {
char *name; /* Name of command. */
char *name2; /* Name of command, in ::pg namespace. */
Expand Down Expand Up @@ -115,55 +89,31 @@ static PgCmd commands[] = {
EXTERN int
Pgtcl_Init(Tcl_Interp *interp)
{
double tclversion;
Tcl_Obj *tclVersionObj;
PgCmd *cmdPtr;
double tclversion;
Tcl_Obj *tclVersionObj;
PgCmd *cmdPtr;

#ifdef WIN32
WSADATA wsaData;
#endif
#ifdef WIN32
WSADATA wsaData;
#endif

#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, "8.1", 0) == NULL)
return TCL_ERROR;
#endif

#ifdef WIN32X
/*
* On Windows, need to explicitly load the libpq library to
* force the call to WSAStartup.
*/
Tcl_Obj *tresult;

if (LoadLibrary("libpq.dll") == NULL) {
//char buf[32];
//sprintf(buf, "%d", GetLastError());
tresult = Tcl_NewStringObj("Cannot load \"libpq.dll\" (or dependant), error was ");
Tcl_AppendToObj(tresult, GetLastError(), -1);
Tcl_SetObjResult(interp, tresult);

/*
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"Cannot load \"libpq.dll\" (or dependant), error was ",
GetLastError(), NULL);
*/

return TCL_ERROR;
}
#endif

#ifdef WIN32

if (WSAStartup(MAKEWORD(1, 1), &wsaData))
{
/*
* No really good way to do error handling here, since we
* don't know how we were loaded
*/
return TCL_ERROR;
}

#endif
#ifdef WIN32

if (WSAStartup(MAKEWORD(1, 1), &wsaData))
{
/*
* No really good way to do error handling here, since we
* don't know how we were loaded
*/
return TCL_ERROR;
}

#endif


/*
Expand Down
206 changes: 1 addition & 205 deletions generic/pgtclCmds.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,207 +41,6 @@ static int build_param_array(Tcl_Interp *interp, int nParams, Tcl_Obj *CONST obj

static void report_connection_error(Tcl_Interp *interp, PGconn *conn);

#ifdef TCL_ARRAYS

#define ISOCTAL(c) (((c) >= '0') && ((c) <= '7'))
#define DIGIT(c) ((c) - '0')


/*
* translate_escape()
*
* This function performs in-place translation of a single C-style
* escape sequence pointed by p. Curly braces { } and double-quote
* are left escaped if they appear inside an array.
* The value returned is the pointer to the last character (the one
* just before the rest of the buffer).
*/

static inline char *
translate_escape(char *p, int isArray)
{
char c,
*q,
*s;

#ifdef TCL_ARRAYS_DEBUG_ESCAPE
printf(" escape = '%s'\n", p);
#endif
/* Address of the first character after the escape sequence */
s = p + 2;
switch (c = *(p + 1))
{
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
c = DIGIT(c);
if (ISOCTAL(*s))
c = (c << 3) + DIGIT(*s++);
if (ISOCTAL(*s))
c = (c << 3) + DIGIT(*s++);
*p = c;
break;
case 'b':
*p = '\b';
break;
case 'f':
*p = '\f';
break;
case 'n':
*p = '\n';
break;
case 'r':
*p = '\r';
break;
case 't':
*p = '\t';
break;
case 'v':
*p = '\v';
break;
case '\\':
case '{':
case '}':
case '"':

/*
* Backslahes, curly braces and double-quotes are left escaped
* if they appear inside an array. They will be unescaped by
* Tcl in Tcl_AppendElement. The buffer position is advanced
* by 1 so that the this character is not processed again by
* the caller.
*/
if (isArray)
return p + 1;
else
*p = c;
break;
case '\0':

/*
* This means a backslash at the end of the string. It should
* never happen but in that case replace the \ with a \0 but
* don't shift the rest of the buffer so that the caller can
* see the end of the string and terminate.
*/
*p = c;
return p;
break;
default:

/*
* Default case, store the escaped character over the
* backslash and shift the buffer over itself.
*/
*p = c;
}
/* Shift the rest of the buffer over itself after the current char */
q = p + 1;
for (; *s;)
*q++ = *s++;
*q = '\0';
#ifdef TCL_ARRAYS_DEBUG_ESCAPE
printf(" after = '%s'\n", p);
#endif
return p;
}

/*
* tcl_value()
*
* This function does in-line conversion of a value returned by libpq
* into a tcl string or into a tcl list if the value looks like the
* representation of a postgres array.
*/

static char *
tcl_value(char *value)
{
int literal,
last;
char *p;

if (!value)
return NULL;


#ifdef TCL_ARRAYS_DEBUG
printf("pq_value = '%s'\n", value);
#endif
last = strlen(value) - 1;
if ((last >= 1) && (value[0] == '{') && (value[last] == '}'))
{
/* Looks like an array, replace ',' with spaces */
/* Remove the outer pair of { }, the last first! */
value[last] = '\0';
value++;
literal = 0;
for (p = value; *p; p++)
{
if (!literal)
{
/* We are at the list level, look for ',' and '"' */
switch (*p)
{
case '"': /* beginning of literal */
literal = 1;
break;
case ',': /* replace the ',' with space */
*p = ' ';
break;
}
}
else
{
/* We are inside a C string */
switch (*p)
{
case '"': /* end of literal */
literal = 0;
break;
case '\\':

/*
* escape sequence, translate it
*/
p = translate_escape(p, 1);
break;
}
}
if (!*p)
break;
}
}
else
{
/* Looks like a normal scalar value */
for (p = value; *p; p++)
{
if (*p == '\\')
{
/*
* escape sequence, translate it
*/
p = translate_escape(p, 0);
}
if (!*p)
break;
}
}
#ifdef TCL_ARRAYS_DEBUG
printf("tcl_value = '%s'\n\n", value);
#endif
return value;
}
#else /* TCL_ARRAYS */
#define tcl_value(x) x
#endif /* TCL_ARRAYS */

static Tcl_Encoding utf8encoding = NULL;

/*
Expand Down Expand Up @@ -344,9 +143,6 @@ Tcl_Obj *UTF_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1ptr, Tcl_Obj *part2ptr
* the returned field is actually null and, if so, the null string value
* associated with the connection is returned.
*
* If array-into-list processing has been defined, it is also performed,
* which is probably a bad idea, since it can be tricked by legitimate
* data, but that's tcl_value's fault, if TCL_ARRAYS is defined.
*/

static char *
Expand All @@ -373,7 +169,7 @@ PGgetvalue ( PGresult *result, char *nullString, int tupno, int fieldNumber )
}

/* string is not empty */
return tcl_value (string);
return string;
}

/**********************************
Expand Down
Loading

0 comments on commit 2cbb377

Please sign in to comment.