pgtclCmds.c 35.6 KB
Newer Older
1 2 3
/*-------------------------------------------------------------------------
 *
 * pgtclCmds.c--
4
 *	  C functions which implement pg_* tcl commands
5 6 7 8 9
 *
 * Copyright (c) 1994, Regents of the University of California
 *
 *
 * IDENTIFICATION
10
 *	  $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.39 1999/01/17 21:12:55 tgl Exp $
11 12 13 14 15 16 17
 *
 *-------------------------------------------------------------------------
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
18
#include <ctype.h>
19 20

#include "postgres.h"
21 22
#include "pgtclCmds.h"
#include "pgtclId.h"
23
#include "libpq/libpq-fs.h"		/* large-object interface */
24

25
#ifdef TCL_ARRAYS
26

27 28
#define ISOCTAL(c)		(((c) >= '0') && ((c) <= '7'))
#define DIGIT(c)		((c) - '0')
29 30 31 32 33 34 35 36 37 38 39

/*
 * 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).
 */

40
static inline char *
41 42
translate_escape(char *p, int isArray)
{
43
	char		c,
44 45
			   *q,
			   *s;
46

47
#ifdef TCL_ARRAYS_DEBUG_ESCAPE
48
	printf("   escape = '%s'\n", p);
49
#endif
50 51 52 53
	/* Address of the first character after the escape sequence */
	s = p + 2;
	switch (c = *(p + 1))
	{
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
		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.
			 */
121
			*p = c;
122
	}
123 124 125 126 127
	/* Shift the rest of the buffer over itself after the current char */
	q = p + 1;
	for (; *s;)
		*q++ = *s++;
	*q = '\0';
128
#ifdef TCL_ARRAYS_DEBUG_ESCAPE
129
	printf("   after  = '%s'\n", p);
130
#endif
131
	return p;
132 133 134 135 136 137 138 139 140 141
}

/*
 * 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.
 */

142
static char *
143
tcl_value(char *value)
144
{
145 146
	int			literal,
				last;
147
	char	   *p;
148

149
	if (!value)
150
		return (char *) NULL;
151

152
#ifdef TCL_ARRAYS_DEBUG
153
	printf("pq_value  = '%s'\n", value);
154
#endif
155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
	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)
				{
170 171 172 173 174 175
					case '"':	/* beginning of literal */
						literal = 1;
						break;
					case ',':	/* replace the ',' with space */
						*p = ' ';
						break;
176 177 178 179 180 181 182
				}
			}
			else
			{
				/* We are inside a C string */
				switch (*p)
				{
183 184 185 186 187 188 189 190 191 192
					case '"':	/* end of literal */
						literal = 0;
						break;
					case '\\':

						/*
						 * escape sequence, translate it
						 */
						p = translate_escape(p, 1);
						break;
193 194 195 196
				}
			}
			if (!*p)
				break;
197 198
		}
	}
199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
	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;
		}
215
	}
216
#ifdef TCL_ARRAYS_DEBUG
217
	printf("tcl_value = '%s'\n\n", value);
218
#endif
219
	return value;
220 221
}

222 223
#endif						/* TCL_ARRAYS */

224

225 226
/**********************************
 * pg_conndefaults
227

228 229
 syntax:
 pg_conndefaults
230

231 232 233 234
 the return result is a list describing the possible options and their
 current default values for a call to pg_connect with the new -conninfo
 syntax. Each entry in the list is a sublist of the format:

235 236
	 {optname label dispchar dispsize value}

237 238 239
 **********************************/

int
240
Pg_conndefaults(ClientData cData, Tcl_Interp * interp, int argc, char **argv)
241
{
242
	PQconninfoOption *option;
243 244
	Tcl_DString result;
	char ibuf[32];
245

246
	Tcl_DStringInit(&result);
247 248
	for (option = PQconndefaults(); option->keyword != NULL; option++)
	{
249 250 251 252 253 254 255 256 257
		char * val = option->val ? option->val : "";
		sprintf(ibuf, "%d", option->dispsize);
		Tcl_DStringStartSublist(&result);
		Tcl_DStringAppendElement(&result, option->keyword);
		Tcl_DStringAppendElement(&result, option->label);
		Tcl_DStringAppendElement(&result, option->dispchar);
		Tcl_DStringAppendElement(&result, ibuf);
		Tcl_DStringAppendElement(&result, val);
		Tcl_DStringEndSublist(&result);
258
	}
259
	Tcl_DStringResult(interp, &result);
260 261

	return TCL_OK;
262 263 264
}


265 266
/**********************************
 * pg_connect
267 268
 make a connection to a backend.

269 270
 syntax:
 pg_connect dbName [-host hostName] [-port portNumber] [-tty pqtty]]
271

272 273
 the return result is either an error message or a handle for a database
 connection.  Handles start with the prefix "pgp"
274

275 276 277
 **********************************/

int
278
Pg_connect(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
279
{
280 281 282 283 284 285 286 287 288 289 290 291 292 293
	char	   *pghost = NULL;
	char	   *pgtty = NULL;
	char	   *pgport = NULL;
	char	   *pgoptions = NULL;
	char	   *dbName;
	int			i;
	PGconn	   *conn;

	if (argc == 1)
	{
		Tcl_AppendResult(interp, "pg_connect: database name missing\n", 0);
		Tcl_AppendResult(interp, "pg_connect databaseName [-host hostName] [-port portNumber] [-tty pgtty]]\n", 0);
		Tcl_AppendResult(interp, "pg_connect -conninfo <conninfo-string>", 0);
		return TCL_ERROR;
294 295

	}
296 297 298 299 300 301 302 303 304 305 306 307

	if (!strcmp("-conninfo", argv[1]))
	{

		/*
		 * Establish a connection using the new PQconnectdb() interface
		 */
		if (argc != 3)
		{
			Tcl_AppendResult(interp, "pg_connect: syntax error\n", 0);
			Tcl_AppendResult(interp, "pg_connect -conninfo <conninfo-string>", 0);
			return TCL_ERROR;
308
		}
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355
		conn = PQconnectdb(argv[2]);
	}
	else
	{

		/*
		 * Establish a connection using the old PQsetdb() interface
		 */
		if (argc > 2)
		{
			/* parse for pg environment settings */
			i = 2;
			while (i + 1 < argc)
			{
				if (strcmp(argv[i], "-host") == 0)
				{
					pghost = argv[i + 1];
					i += 2;
				}
				else if (strcmp(argv[i], "-port") == 0)
				{
					pgport = argv[i + 1];
					i += 2;
				}
				else if (strcmp(argv[i], "-tty") == 0)
				{
					pgtty = argv[i + 1];
					i += 2;
				}
				else if (strcmp(argv[i], "-options") == 0)
				{
					pgoptions = argv[i + 1];
					i += 2;
				}
				else
				{
					Tcl_AppendResult(interp, "Bad option to pg_connect : \n",
									 argv[i], 0);
					Tcl_AppendResult(interp, "pg_connect databaseName [-host hostName] [-port portNumber] [-tty pgtty]]", 0);
					return TCL_ERROR;
				}
			}					/* while */
			if ((i % 2 != 0) || i != argc)
			{
				Tcl_AppendResult(interp, "wrong # of arguments to pg_connect\n", argv[i], 0);
				Tcl_AppendResult(interp, "pg_connect databaseName [-host hostName] [-port portNumber] [-tty pgtty]]", 0);
				return TCL_ERROR;
356
			}
357 358 359
		}
		dbName = argv[1];
		conn = PQsetdb(pghost, pgport, pgoptions, pgtty, dbName);
360
	}
361

Bruce Momjian's avatar
Bruce Momjian committed
362
    if (PQstatus(conn) == CONNECTION_OK)
363 364 365 366 367 368
	{
		PgSetConnectionId(interp, conn);
		return TCL_OK;
	}
	else
	{
369 370
		Tcl_AppendResult(interp, "Connection to database failed\n",
			PQerrorMessage(conn), 0);
371 372 373
		PQfinish(conn);
		return TCL_ERROR;
	}
374 375 376 377 378 379
}


/**********************************
 * pg_disconnect
 close a backend connection
380

381 382
 syntax:
 pg_disconnect connection
383

384
 The argument passed in must be a connection pointer.
385

386 387 388
 **********************************/

int
389
Pg_disconnect(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
390
{
391
	Tcl_Channel conn_chan;
392

393 394 395 396 397
	if (argc != 2)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n", "pg_disconnect connection", 0);
		return TCL_ERROR;
	}
398

399 400 401 402 403 404 405
	conn_chan = Tcl_GetChannel(interp, argv[1], 0);
	if (conn_chan == NULL)
	{
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, argv[1], " is not a valid connection\n", 0);
		return TCL_ERROR;
	}
406

407
	return Tcl_UnregisterChannel(interp, conn_chan);
408 409 410 411 412
}

/**********************************
 * pg_exec
 send a query string to the backend connection
413

414 415
 syntax:
 pg_exec connection query
416

417 418 419 420 421
 the return result is either an error message or a handle for a query
 result.  Handles start with the prefix "pgp"
 **********************************/

int
422
Pg_exec(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
423
{
424 425 426
	Pg_ConnectionId *connid;
	PGconn	   *conn;
	PGresult   *result;
427

428 429 430 431 432 433
	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_exec connection queryString", 0);
		return TCL_ERROR;
	}
434

435 436 437 438 439 440 441 442 443
	conn = PgGetConnectionId(interp, argv[1], &connid);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	if (connid->res_copyStatus != RES_COPY_NONE)
	{
		Tcl_SetResult(interp, "Attempt to query while COPY in progress", TCL_STATIC);
		return TCL_ERROR;
	}
444

445
	result = PQexec(conn, argv[2]);
446

447 448
	/* Transfer any notify events from libpq to Tcl event queue. */
	PgNotifyTransferEvents(connid);
449

450 451 452 453
	if (result)
	{
		int			rId = PgSetResultId(interp, argv[1], result);

454 455
		ExecStatusType rStat = PQresultStatus(result);
		if (rStat == PGRES_COPY_IN || rStat == PGRES_COPY_OUT)
456 457 458 459 460 461 462 463 464
		{
			connid->res_copyStatus = RES_COPY_INPROGRESS;
			connid->res_copy = rId;
		}
		return TCL_OK;
	}
	else
	{
		/* error occurred during the query */
465
		Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
466
		return TCL_ERROR;
467
	}
468 469 470 471 472
}

/**********************************
 * pg_result
 get information about the results of a query
473

474
 syntax:
475 476

 	pg_result result ?option?
477

478
 the options are:
479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518

 	-status		the status of the result

	-error		the error message, if the status indicates error; otherwise
				an empty string

	-conn		the connection that produced the result

	-oid		if command was an INSERT, the OID of the inserted tuple

	-numTuples	the number of tuples in the query

	-numAttrs	returns the number of attributes returned by the query

	-assign arrayName
 				assign the results to an array, using subscripts of the form
 				(tupno,attributeName)

	-assignbyidx arrayName ?appendstr?
 				assign the results to an array using the first field's value
				as a key.
				All but the first field of each tuple are stored, using
				subscripts of the form (field0value,attributeNameappendstr)

	-getTuple tupleNumber
				returns the values of the tuple in a list

	-tupleArray tupleNumber arrayName
 				stores the values of the tuple in array arrayName, indexed
				by the attributes returned

	-attributes
 				returns a list of the name/type pairs of the tuple attributes

	-lAttributes
 				returns a list of the {name type len} entries of the tuple
				attributes

    -clear		clear the result buffer. Do not reuse after this

519 520
 **********************************/
int
521
Pg_result(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
522
{
523 524 525 526 527 528
	PGresult   *result;
	char	   *opt;
	int			i;
	int			tupno;
	char	   *arrVar;
	char		nameBuffer[256];
529
    const char *appendstr;
530 531 532 533

	if (argc < 3 || argc > 5)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n", 0);
534
		goto Pg_result_errReturn; /* append help info */
535
	}
536

537 538 539
	result = PgGetResultId(interp, argv[1]);
	if (result == (PGresult *) NULL)
	{
540
		Tcl_AppendResult(interp, argv[1], " is not a valid query result", 0);
541 542
		return TCL_ERROR;
	}
543

544 545 546 547 548 549
	opt = argv[2];

	if (strcmp(opt, "-status") == 0)
	{
		Tcl_AppendResult(interp, pgresStatus[PQresultStatus(result)], 0);
		return TCL_OK;
550
	}
551 552
	else if (strcmp(opt, "-error") == 0)
	{
553 554
		Tcl_SetResult(interp, (char*) PQresultErrorMessage(result),
					  TCL_STATIC);
555 556 557 558
		return TCL_OK;
	}
	else if (strcmp(opt, "-conn") == 0)
		return PgGetConnByResultId(interp, argv[1]);
559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590
	else if (strcmp(opt, "-oid") == 0)
	{
		Tcl_AppendResult(interp, PQoidStatus(result), 0);
		return TCL_OK;
	}
	else if (strcmp(opt, "-clear") == 0)
	{
		PgDelResultId(interp, argv[1]);
		PQclear(result);
		return TCL_OK;
	}
	else if (strcmp(opt, "-numTuples") == 0)
	{
		sprintf(interp->result, "%d", PQntuples(result));
		return TCL_OK;
	}
	else if (strcmp(opt, "-numAttrs") == 0)
	{
		sprintf(interp->result, "%d", PQnfields(result));
		return TCL_OK;
	}
	else if (strcmp(opt, "-assign") == 0)
	{
		if (argc != 4)
		{
			Tcl_AppendResult(interp, "-assign option must be followed by a variable name", 0);
			return TCL_ERROR;
		}
		arrVar = argv[3];

		/*
		 * this assignment assigns the table of result tuples into a giant
591 592 593
		 * array with the name given in the argument.
		 * The indices of the array are of the form (tupno,attrName).
		 * Note we expect field names not to
594 595 596 597 598 599 600 601 602
		 * exceed a few dozen characters, so truncating to prevent buffer
		 * overflow shouldn't be a problem.
		 */
		for (tupno = 0; tupno < PQntuples(result); tupno++)
		{
			for (i = 0; i < PQnfields(result); i++)
			{
				sprintf(nameBuffer, "%d,%.200s", tupno, PQfname(result, i));
				if (Tcl_SetVar2(interp, arrVar, nameBuffer,
603
#ifdef TCL_ARRAYS
604
								tcl_value(PQgetvalue(result, tupno, i)),
605
#else
606
								PQgetvalue(result, tupno, i),
607
#endif
608 609 610 611 612 613
								TCL_LEAVE_ERR_MSG) == NULL)
					return TCL_ERROR;
			}
		}
		Tcl_AppendResult(interp, arrVar, 0);
		return TCL_OK;
614
	}
615 616
	else if (strcmp(opt, "-assignbyidx") == 0)
	{
617
		if (argc != 4 && argc != 5)
618
		{
619
			Tcl_AppendResult(interp, "-assignbyidx option requires an array name and optionally an append string",0);
620 621 622
			return TCL_ERROR;
		}
		arrVar = argv[3];
623
		appendstr = (argc == 5) ? (const char *) argv[4] : "";
624 625 626

		/*
		 * this assignment assigns the table of result tuples into a giant
627 628 629 630 631
		 * array with the name given in the argument.  The indices of the array
		 * are of the form (field0Value,attrNameappendstr).
		 * Here, we still assume PQfname won't exceed 200 characters,
		 * but we dare not make the same assumption about the data in field 0
		 * nor the append string.
632 633 634
		 */
		for (tupno = 0; tupno < PQntuples(result); tupno++)
		{
635 636 637 638 639 640 641
			const char *field0 = 
#ifdef TCL_ARRAYS
								 tcl_value(PQgetvalue(result, tupno, 0));
#else
								 PQgetvalue(result, tupno, 0);
#endif
			char *workspace = malloc(strlen(field0) + strlen(appendstr) + 210);
642 643 644

			for (i = 1; i < PQnfields(result); i++)
			{
645
				sprintf(workspace, "%s,%.200s%s", field0, PQfname(result,i),
646
						appendstr);
647
				if (Tcl_SetVar2(interp, arrVar, workspace,
648 649 650
#ifdef TCL_ARRAYS
								tcl_value(PQgetvalue(result, tupno, i)),
#else
651
								PQgetvalue(result, tupno, i),
652
#endif
653 654 655 656 657 658 659 660 661 662
								TCL_LEAVE_ERR_MSG) == NULL)
				{
					free(workspace);
					return TCL_ERROR;
				}
			}
			free(workspace);
		}
		Tcl_AppendResult(interp, arrVar, 0);
		return TCL_OK;
663
	}
664 665 666 667 668 669 670 671 672 673 674 675 676
	else if (strcmp(opt, "-getTuple") == 0)
	{
		if (argc != 4)
		{
			Tcl_AppendResult(interp, "-getTuple option must be followed by a tuple number", 0);
			return TCL_ERROR;
		}
		tupno = atoi(argv[3]);
		if (tupno < 0 || tupno >= PQntuples(result))
		{
			Tcl_AppendResult(interp, "argument to getTuple cannot exceed number of tuples - 1", 0);
			return TCL_ERROR;
		}
677 678 679 680 681 682
#ifdef TCL_ARRAYS
		for (i = 0; i < PQnfields(result); i++)
		{
			Tcl_AppendElement(interp, tcl_value(PQgetvalue(result, tupno, i)));
		}
#else
683 684
		for (i = 0; i < PQnfields(result); i++)
			Tcl_AppendElement(interp, PQgetvalue(result, tupno, i));
685
#endif
686
		return TCL_OK;
687
	}
688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703
	else if (strcmp(opt, "-tupleArray") == 0)
	{
		if (argc != 5)
		{
			Tcl_AppendResult(interp, "-tupleArray option must be followed by a tuple number and array name", 0);
			return TCL_ERROR;
		}
		tupno = atoi(argv[3]);
		if (tupno < 0 || tupno >= PQntuples(result))
		{
			Tcl_AppendResult(interp, "argument to tupleArray cannot exceed number of tuples - 1", 0);
			return TCL_ERROR;
		}
		for (i = 0; i < PQnfields(result); i++)
		{
			if (Tcl_SetVar2(interp, argv[4], PQfname(result, i),
704 705 706
#ifdef TCL_ARRAYS
							tcl_value(PQgetvalue(result, tupno, i)),
#else
707
							PQgetvalue(result, tupno, i),
708
#endif
709 710 711 712
							TCL_LEAVE_ERR_MSG) == NULL)
				return TCL_ERROR;
		}
		return TCL_OK;
713
	}
714 715 716 717 718
	else if (strcmp(opt, "-attributes") == 0)
	{
		for (i = 0; i < PQnfields(result); i++)
			Tcl_AppendElement(interp, PQfname(result, i));
		return TCL_OK;
719
	}
720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737
	else if (strcmp(opt, "-lAttributes") == 0)
	{
		for (i = 0; i < PQnfields(result); i++)
		{
			/* start a sublist */
			if (i > 0)
				Tcl_AppendResult(interp, " {", 0);
			else
				Tcl_AppendResult(interp, "{", 0);
			Tcl_AppendElement(interp, PQfname(result, i));
			sprintf(nameBuffer, "%ld", (long) PQftype(result, i));
			Tcl_AppendElement(interp, nameBuffer);
			sprintf(nameBuffer, "%ld", (long) PQfsize(result, i));
			Tcl_AppendElement(interp, nameBuffer);
			/* end the sublist */
			Tcl_AppendResult(interp, "}", 0);
		}
		return TCL_OK;
738
	}
739
	else
740
	{
741 742
		Tcl_AppendResult(interp, "Invalid option\n", 0);
		goto Pg_result_errReturn; /* append help info */
743 744 745 746 747
	}


Pg_result_errReturn:
	Tcl_AppendResult(interp,
748
					 "pg_result result ?option? where option is\n",
749
					 "\t-status\n",
750
					 "\t-error\n",
751
					 "\t-conn\n",
752
					 "\t-oid\n",
753 754
					 "\t-numTuples\n",
					 "\t-numAttrs\n"
755 756
					 "\t-assign arrayVarName\n",
					 "\t-assignbyidx arrayVarName ?appendstr?\n",
757 758
					 "\t-getTuple tupleNumber\n",
					 "\t-tupleArray tupleNumber arrayVarName\n",
759 760
					 "\t-attributes\n"
					 "\t-lAttributes\n"
761 762 763 764
					 "\t-clear\n",
					 (char *) 0);
	return TCL_ERROR;

765 766 767 768 769

}

/**********************************
 * pg_lo_open
770 771
	 open a large object

772
 syntax:
773
 pg_lo_open conn objOid mode
774 775 776 777 778

 where mode can be either 'r', 'w', or 'rw'
**********************/

int
779
Pg_lo_open(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
780
{
781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837
	PGconn	   *conn;
	int			lobjId;
	int			mode;
	int			fd;

	if (argc != 4)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_open connection lobjOid mode", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	lobjId = atoi(argv[2]);
	if (strlen(argv[3]) < 1 ||
		strlen(argv[3]) > 2)
	{
		Tcl_AppendResult(interp, "mode argument must be 'r', 'w', or 'rw'", 0);
		return TCL_ERROR;
	}
	switch (argv[3][0])
	{
		case 'r':
		case 'R':
			mode = INV_READ;
			break;
		case 'w':
		case 'W':
			mode = INV_WRITE;
			break;
		default:
			Tcl_AppendResult(interp, "mode argument must be 'r', 'w', or 'rw'", 0);
			return TCL_ERROR;
	}
	switch (argv[3][1])
	{
		case '\0':
			break;
		case 'r':
		case 'R':
			mode = mode & INV_READ;
			break;
		case 'w':
		case 'W':
			mode = mode & INV_WRITE;
			break;
		default:
			Tcl_AppendResult(interp, "mode argument must be 'r', 'w', or 'rw'", 0);
			return TCL_ERROR;
	}

	fd = lo_open(conn, lobjId, mode);
	sprintf(interp->result, "%d", fd);
	return TCL_OK;
838 839 840 841
}

/**********************************
 * pg_lo_close
842 843
	 close a large object

844
 syntax:
845
 pg_lo_close conn fd
846 847 848

**********************/
int
849
Pg_lo_close(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
850
{
851 852
	PGconn	   *conn;
	int			fd;
853

854 855 856 857 858 859
	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_close connection fd", 0);
		return TCL_ERROR;
	}
860

861 862 863 864 865 866 867
	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	fd = atoi(argv[2]);
	sprintf(interp->result, "%d", lo_close(conn, fd));
	return TCL_OK;
868 869 870 871
}

/**********************************
 * pg_lo_read
872
	 reads at most len bytes from a large object into a variable named
873
 bufVar
874

875 876 877 878 879 880 881
 syntax:
 pg_lo_read conn fd bufVar len

 bufVar is the name of a variable in which to store the contents of the read

**********************/
int
882
Pg_lo_read(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
883
{
884 885 886 887 888 889
	PGconn	   *conn;
	int			fd;
	int			nbytes = 0;
	char	   *buf;
	char	   *bufVar;
	int			len;
890

891 892 893 894 895 896
	if (argc != 5)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 " pg_lo_read conn fd bufVar len", 0);
		return TCL_ERROR;
	}
897

898 899 900
	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;
901

902
	fd = atoi(argv[2]);
903

904
	bufVar = argv[3];
905

906 907 908 909 910 911 912 913 914 915 916 917 918 919 920
	len = atoi(argv[4]);

	if (len <= 0)
	{
		sprintf(interp->result, "%d", nbytes);
		return TCL_OK;
	}
	buf = ckalloc(len + 1);

	nbytes = lo_read(conn, fd, buf, len);

	Tcl_SetVar(interp, bufVar, buf, TCL_LEAVE_ERR_MSG);
	sprintf(interp->result, "%d", nbytes);
	ckfree(buf);
	return TCL_OK;
921

922 923 924 925
}

/***********************************
Pg_lo_write
926
   write at most len bytes to a large object
927 928 929 930 931 932

 syntax:
 pg_lo_write conn fd buf len

***********************************/
int
933
Pg_lo_write(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
934
{
935 936 937 938 939
	PGconn	   *conn;
	char	   *buf;
	int			fd;
	int			nbytes = 0;
	int			len;
940

941 942 943 944 945 946
	if (argc != 5)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_write conn fd buf len", 0);
		return TCL_ERROR;
	}
947

948 949 950
	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;
951

952
	fd = atoi(argv[2]);
953

954 955 956 957 958 959 960 961 962
	buf = argv[3];

	len = atoi(argv[4]);

	if (len <= 0)
	{
		sprintf(interp->result, "%d", nbytes);
		return TCL_OK;
	}
963

964 965 966
	nbytes = lo_write(conn, fd, buf, len);
	sprintf(interp->result, "%d", nbytes);
	return TCL_OK;
967 968 969 970
}

/***********************************
Pg_lo_lseek
971
	seek to a certain position in a large object
972 973 974 975 976 977 978 979

syntax
  pg_lo_lseek conn fd offset whence

whence can be either
"SEEK_CUR", "SEEK_END", or "SEEK_SET"
***********************************/
int
980
Pg_lo_lseek(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
981
{
982 983 984 985 986
	PGconn	   *conn;
	int			fd;
	char	   *whenceStr;
	int			offset,
				whence;
987

988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017
	if (argc != 5)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_lseek conn fd offset whence", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	fd = atoi(argv[2]);

	offset = atoi(argv[3]);

	whenceStr = argv[4];
	if (strcmp(whenceStr, "SEEK_SET") == 0)
		whence = SEEK_SET;
	else if (strcmp(whenceStr, "SEEK_CUR") == 0)
		whence = SEEK_CUR;
	else if (strcmp(whenceStr, "SEEK_END") == 0)
		whence = SEEK_END;
	else
	{
		Tcl_AppendResult(interp, "the whence argument to Pg_lo_lseek must be SEEK_SET, SEEK_CUR or SEEK_END", 0);
		return TCL_ERROR;
	}

	sprintf(interp->result, "%d", lo_lseek(conn, fd, offset, whence));
	return TCL_OK;
1018 1019 1020 1021 1022 1023 1024 1025 1026 1027
}


/***********************************
Pg_lo_creat
   create a new large object with mode

 syntax:
   pg_lo_creat conn mode

1028
mode can be any OR'ing together of INV_READ, INV_WRITE,
1029 1030 1031 1032
for now, we don't support any additional storage managers.

***********************************/
int
1033
Pg_lo_creat(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
1034
{
1035 1036 1037 1038
	PGconn	   *conn;
	char	   *modeStr;
	char	   *modeWord;
	int			mode;
1039

1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078
	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_creat conn mode", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	modeStr = argv[2];

	modeWord = strtok(modeStr, "|");
	if (strcmp(modeWord, "INV_READ") == 0)
		mode = INV_READ;
	else if (strcmp(modeWord, "INV_WRITE") == 0)
		mode = INV_WRITE;
	else
	{
		Tcl_AppendResult(interp,
						 "invalid mode argument to Pg_lo_creat\nmode argument must be some OR'd combination of INV_READ, and INV_WRITE",
						 0);
		return TCL_ERROR;
	}

	while ((modeWord = strtok((char *) NULL, "|")) != NULL)
	{
		if (strcmp(modeWord, "INV_READ") == 0)
			mode |= INV_READ;
		else if (strcmp(modeWord, "INV_WRITE") == 0)
			mode |= INV_WRITE;
		else
		{
			Tcl_AppendResult(interp,
							 "invalid mode argument to Pg_lo_creat\nmode argument must be some OR'd combination of INV_READ, INV_WRITE",
							 0);
			return TCL_ERROR;
		}
1079
	}
1080 1081
	sprintf(interp->result, "%d", lo_creat(conn, mode));
	return TCL_OK;
1082 1083 1084 1085
}

/***********************************
Pg_lo_tell
1086
	returns the current seek location of the large object
1087 1088 1089 1090 1091 1092

 syntax:
   pg_lo_tell conn fd

***********************************/
int
1093
Pg_lo_tell(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
1094
{
1095 1096
	PGconn	   *conn;
	int			fd;
1097

1098 1099 1100 1101 1102 1103
	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_tell conn fd", 0);
		return TCL_ERROR;
	}
1104

1105 1106 1107
	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;
1108

1109 1110 1111 1112
	fd = atoi(argv[2]);

	sprintf(interp->result, "%d", lo_tell(conn, fd));
	return TCL_OK;
1113 1114 1115 1116 1117

}

/***********************************
Pg_lo_unlink
1118
	unlink a file based on lobject id
1119 1120 1121 1122 1123 1124 1125

 syntax:
   pg_lo_unlink conn lobjId


***********************************/
int
1126
Pg_lo_unlink(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
1127
{
1128 1129 1130
	PGconn	   *conn;
	int			lobjId;
	int			retval;
1131

1132 1133 1134 1135 1136 1137
	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_tell conn fd", 0);
		return TCL_ERROR;
	}
1138

1139 1140 1141
	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;
1142

1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153
	lobjId = atoi(argv[2]);

	retval = lo_unlink(conn, lobjId);
	if (retval == -1)
	{
		sprintf(interp->result, "Pg_lo_unlink of '%d' failed", lobjId);
		return TCL_ERROR;
	}

	sprintf(interp->result, "%d", retval);
	return TCL_OK;
1154 1155 1156 1157
}

/***********************************
Pg_lo_import
1158
	import a Unix file into an (inversion) large objct
1159 1160 1161 1162 1163 1164 1165 1166 1167
 returns the oid of that object upon success
 returns InvalidOid upon failure

 syntax:
   pg_lo_import conn filename

***********************************/

int
1168
Pg_lo_import(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
1169
{
1170 1171 1172
	PGconn	   *conn;
	char	   *filename;
	Oid			lobjId;
1173

1174 1175 1176 1177 1178 1179
	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_import conn filename", 0);
		return TCL_ERROR;
	}
1180

1181 1182 1183
	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;
1184

1185 1186 1187 1188 1189 1190 1191 1192 1193 1194
	filename = argv[2];

	lobjId = lo_import(conn, filename);
	if (lobjId == InvalidOid)
	{
		sprintf(interp->result, "Pg_lo_import of '%s' failed", filename);
		return TCL_ERROR;
	}
	sprintf(interp->result, "%d", lobjId);
	return TCL_OK;
1195 1196 1197 1198
}

/***********************************
Pg_lo_export
1199 1200
	export an Inversion large object to a Unix file

1201 1202 1203 1204 1205 1206
 syntax:
   pg_lo_export conn lobjId filename

***********************************/

int
1207
Pg_lo_export(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
1208
{
1209 1210 1211 1212
	PGconn	   *conn;
	char	   *filename;
	Oid			lobjId;
	int			retval;
1213

1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234
	if (argc != 4)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_export conn lobjId filename", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	lobjId = atoi(argv[2]);
	filename = argv[3];

	retval = lo_export(conn, lobjId, filename);
	if (retval == -1)
	{
		sprintf(interp->result, "Pg_lo_export %d %s failed", lobjId, filename);
		return TCL_ERROR;
	}
	return TCL_OK;
1235 1236
}

1237 1238 1239
/**********************************
 * pg_select
 send a select query string to the backend connection
1240

1241 1242 1243 1244 1245 1246 1247 1248 1249
 syntax:
 pg_select connection query var proc

 The query must be a select statement
 The var is used in the proc as an array
 The proc is run once for each row found

 Originally I was also going to update changes but that has turned out
 to be not so simple.  Instead, the caller should get the OID of any
1250
 table they want to update and update it themself in the loop.	I may
1251 1252 1253 1254 1255 1256 1257 1258
 try to write a simplified table lookup and update function to make
 that task a little easier.

 The return is either TCL_OK, TCL_ERROR or TCL_RETURN and interp->result
 may contain more information.
 **********************************/

int
1259
Pg_select(ClientData cData, Tcl_Interp * interp, int argc, char **argv)
1260
{
1261 1262 1263
	Pg_ConnectionId *connid;
	PGconn	   *conn;
	PGresult   *result;
1264 1265
	int			r,
				retval;
1266 1267 1268
	size_t		tupno,
				column,
				ncols;
1269
	Tcl_DString headers;
1270 1271 1272 1273 1274 1275
	char		buffer[2048];
	struct info_s
	{
		char	   *cname;
		int			change;
	}		   *info;
1276 1277 1278 1279

	if (argc != 5)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
1280
						 "pg_select connection queryString var proc", 0);
1281 1282 1283
		return TCL_ERROR;
	}

1284 1285 1286 1287
	conn = PgGetConnectionId(interp, argv[1], &connid);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

1288
	if ((result = PQexec(conn, argv[2])) == 0)
1289
	{
1290
		/* error occurred sending the query */
1291
		Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
1292
		return TCL_ERROR;
1293
	}
1294

1295 1296
	/* Transfer any notify events from libpq to Tcl event queue. */
	PgNotifyTransferEvents(connid);
1297

1298 1299 1300 1301 1302 1303 1304 1305 1306
	if (PQresultStatus(result) != PGRES_TUPLES_OK)
	{
		/* query failed, or it wasn't SELECT */
		Tcl_SetResult(interp, (char*) PQresultErrorMessage(result),
					  TCL_VOLATILE);
		PQclear(result);
		return TCL_ERROR;
	}

1307
	if ((info = (struct info_s *) ckalloc(sizeof(*info) * (ncols = PQnfields(result)))) == NULL)
1308 1309
	{
		Tcl_AppendResult(interp, "Not enough memory", 0);
1310
		PQclear(result);
1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323
		return TCL_ERROR;
	}

	Tcl_DStringInit(&headers);

	for (column = 0; column < ncols; column++)
	{
		info[column].cname = PQfname(result, column);
		info[column].change = 0;
		Tcl_DStringAppendElement(&headers, info[column].cname);
	}

	Tcl_SetVar2(interp, argv[3], ".headers", Tcl_DStringValue(&headers), 0);
1324
	Tcl_DStringFree(&headers);
1325 1326
	sprintf(buffer, "%d", ncols);
	Tcl_SetVar2(interp, argv[3], ".numcols", buffer, 0);
1327

1328 1329
	retval = TCL_OK;

1330 1331
	for (tupno = 0; tupno < PQntuples(result); tupno++)
	{
1332 1333
		sprintf(buffer, "%d", tupno);
		Tcl_SetVar2(interp, argv[3], ".tupno", buffer, 0);
1334 1335

		for (column = 0; column < ncols; column++)
1336 1337 1338 1339 1340 1341 1342
			Tcl_SetVar2(interp, argv[3], info[column].cname,
#ifdef TCL_ARRAYS
						tcl_value(PQgetvalue(result, tupno, column)),
#else
						PQgetvalue(result, tupno, column),
#endif
						0);
1343 1344 1345 1346 1347

		Tcl_SetVar2(interp, argv[3], ".command", "update", 0);

		if ((r = Tcl_Eval(interp, argv[4])) != TCL_OK && r != TCL_CONTINUE)
		{
1348
			if (r == TCL_BREAK)
1349
				break;			/* exit loop, but return TCL_OK */
1350

1351 1352
			if (r == TCL_ERROR)
			{
1353
				char		msg[60];
1354 1355

				sprintf(msg, "\n    (\"pg_select\" body line %d)",
1356
						interp->errorLine);
1357 1358
				Tcl_AddErrorInfo(interp, msg);
			}
1359

1360 1361
			retval = r;
			break;
1362 1363 1364
		}
	}

1365
	ckfree((void *) info);
1366
	Tcl_UnsetVar(interp, argv[3], 0);
1367
	PQclear(result);
1368
	return retval;
1369
}
1370

1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390
/*
 * Test whether any callbacks are registered on this connection for
 * the given relation name.  NB: supplied name must be case-folded already.
 */

static int
Pg_have_listener (Pg_ConnectionId *connid, const char * relname)
{
	Pg_TclNotifies *notifies;
	Tcl_HashEntry *entry;

	for (notifies = connid->notify_list;
		 notifies != NULL;
		 notifies = notifies->next)
	{
		Tcl_Interp *interp = notifies->interp;

		if (interp == NULL)
			continue;			/* ignore deleted interpreter */

1391
		entry = Tcl_FindHashEntry(&notifies->notify_hash, (char*) relname);
1392 1393 1394 1395 1396 1397 1398 1399 1400
		if (entry == NULL)
			continue;			/* no pg_listen in this interpreter */

		return TRUE;			/* OK, there is a listener */
	}

	return FALSE;				/* Found no listener */
}

1401 1402
/***********************************
Pg_listen
1403
	create or remove a callback request for notifies on a given name
1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414

 syntax:
   pg_listen conn notifyname ?callbackcommand?

   With a fourth arg, creates or changes the callback command for
   notifies on the given name; without, cancels the callback request.

   Callbacks can occur whenever Tcl is executing its event loop.
   This is the normal idle loop in Tk; in plain tclsh applications,
   vwait or update can be used to enter the Tcl event loop.
***********************************/
1415
int
1416
Pg_listen(ClientData cData, Tcl_Interp * interp, int argc, char *argv[])
1417
{
1418 1419 1420
	char	   *origrelname;
	char	   *caserelname;
	char	   *callback = NULL;
1421
	Pg_TclNotifies *notifies;
1422 1423 1424 1425 1426
	Tcl_HashEntry *entry;
	Pg_ConnectionId *connid;
	PGconn	   *conn;
	PGresult   *result;
	int			new;
1427

1428 1429
	if (argc < 3 || argc > 4)
	{
1430 1431 1432
		Tcl_AppendResult(interp, "wrong # args, should be \"",
						 argv[0], " connection relname ?callback?\"", 0);
		return TCL_ERROR;
1433 1434 1435 1436 1437
	}

	/*
	 * Get the command arguments. Note that the relation name will be
	 * copied by Tcl_CreateHashEntry while the callback string must be
1438
	 * allocated by us.
1439 1440 1441
	 */
	conn = PgGetConnectionId(interp, argv[1], &connid);
	if (conn == (PGconn *) NULL)
1442
		return TCL_ERROR;
1443

1444 1445
	/*
	 * LISTEN/NOTIFY do not preserve case unless the relation name is
1446
	 * quoted.	We have to do the same thing to ensure that we will find
1447 1448 1449 1450
	 * the desired pg_listen item.
	 */
	origrelname = argv[2];
	caserelname = (char *) ckalloc((unsigned) (strlen(origrelname) + 1));
1451 1452
	if (*origrelname == '"')
	{
1453 1454 1455
		/* Copy a quoted string without downcasing */
		strcpy(caserelname, origrelname + 1);
		caserelname[strlen(caserelname) - 1] = '\0';
1456 1457 1458
	}
	else
	{
1459
		/* Downcase it */
1460 1461 1462 1463
		char	   *rels = origrelname;
		char	   *reld = caserelname;

		while (*rels)
1464 1465
			*reld++ = tolower(*rels++);
		*reld = '\0';
1466 1467
	}

1468 1469
	if ((argc > 3) && *argv[3])
	{
1470 1471
		callback = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1));
		strcpy(callback, argv[3]);
1472
	}
1473

1474
	/* Find or make a Pg_TclNotifies struct for this interp and connection */
1475

1476 1477
	for (notifies = connid->notify_list; notifies; notifies = notifies->next)
	{
1478 1479 1480
		if (notifies->interp == interp)
			break;
	}
1481 1482
	if (notifies == NULL)
	{
1483 1484 1485 1486 1487 1488 1489 1490
		notifies = (Pg_TclNotifies *) ckalloc(sizeof(Pg_TclNotifies));
		notifies->interp = interp;
		Tcl_InitHashTable(&notifies->notify_hash, TCL_STRING_KEYS);
		notifies->next = connid->notify_list;
		connid->notify_list = notifies;
		Tcl_CallWhenDeleted(interp, PgNotifyInterpDelete,
							(ClientData) notifies);
	}
1491

1492 1493
	if (callback)
	{
1494 1495 1496 1497 1498
		/*
		 * Create or update a callback for a relation
		 */
		int alreadyHadListener = Pg_have_listener(connid, caserelname);

1499
		entry = Tcl_CreateHashEntry(&notifies->notify_hash, caserelname, &new);
1500 1501 1502 1503 1504
		/* If update, free the old callback string */
		if (! new)
			ckfree((char *) Tcl_GetHashValue(entry));
		/* Store the new callback string */
		Tcl_SetHashValue(entry, callback);
1505

1506 1507 1508 1509 1510 1511 1512 1513 1514 1515
		/* Start the notify event source if it isn't already running */
		PgStartNotifyEventSource(connid);

		/*
		 * Send a LISTEN command if this is the first listener.
		 */
		if (! alreadyHadListener)
		{
			char   *cmd = (char *)
				ckalloc((unsigned) (strlen(origrelname) + 8));
1516 1517 1518 1519 1520
			sprintf(cmd, "LISTEN %s", origrelname);
			result = PQexec(conn, cmd);
			ckfree(cmd);
			/* Transfer any notify events from libpq to Tcl event queue. */
			PgNotifyTransferEvents(connid);
Bruce Momjian's avatar
Bruce Momjian committed
1521
			if (PQresultStatus(result) != PGRES_COMMAND_OK)
1522
			{
1523
				/* Error occurred during the execution of command */
1524
				PQclear(result);
1525
				Tcl_DeleteHashEntry(entry);
1526 1527 1528 1529 1530 1531
				ckfree(callback);
				ckfree(caserelname);
				Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
				return TCL_ERROR;
			}
			PQclear(result);
1532 1533
		}
	}
1534
	else
1535
	{
1536 1537 1538
		/*
		 * Remove a callback for a relation
		 */
1539
		entry = Tcl_FindHashEntry(&notifies->notify_hash, caserelname);
1540 1541
		if (entry == NULL)
		{
1542 1543 1544 1545 1546 1547
			Tcl_AppendResult(interp, "not listening on ", origrelname, 0);
			ckfree(caserelname);
			return TCL_ERROR;
		}
		ckfree((char *) Tcl_GetHashValue(entry));
		Tcl_DeleteHashEntry(entry);
1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571
		/*
		 * Send an UNLISTEN command if that was the last listener.
		 * Note: we don't attempt to turn off the notify mechanism
		 * if no LISTENs remain active; not worth the trouble.
		 */
		if (! Pg_have_listener(connid, caserelname))
		{
			char   *cmd = (char *)
				ckalloc((unsigned) (strlen(origrelname) + 10));
			sprintf(cmd, "UNLISTEN %s", origrelname);
			result = PQexec(conn, cmd);
			ckfree(cmd);
			/* Transfer any notify events from libpq to Tcl event queue. */
			PgNotifyTransferEvents(connid);
			if (PQresultStatus(result) != PGRES_COMMAND_OK)
			{
				/* Error occurred during the execution of command */
				PQclear(result);
				ckfree(caserelname);
				Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
				return TCL_ERROR;
			}
			PQclear(result);
		}
1572
	}
1573

1574
	ckfree(caserelname);
1575
	return TCL_OK;
1576
}