rts-postgresql.c

     
   1  //! @file rts-postgresql.c
   2  //! @author J. Marcel van der Veer
   3  //!
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
   8  //!
   9  //! @section License
  10  //!
  11  //! This program is free software; you can redistribute it and/or modify it 
  12  //! under the terms of the GNU General Public License as published by the 
  13  //! Free Software Foundation; either version 3 of the License, or 
  14  //! (at your option) any later version.
  15  //!
  16  //! This program is distributed in the hope that it will be useful, but 
  17  //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
  18  //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
  19  //! more details. You should have received a copy of the GNU General Public 
  20  //! License along with this program. If not, see [http://www.gnu.org/licenses/].
  21  
  22  //! @section Synopsis
  23  //!
  24  //! PostgreSQL libpq interface. 
  25  
  26  // PostgreSQL libpq interface based on initial work by Jaap Boender. 
  27  // Wraps "connection" and "result" objects in a FILE variable to support 
  28  // multiple connections.
  29  // 
  30  // Error codes:
  31  // 0    Success
  32  // -1   No connection
  33  // -2   No result
  34  // -3   Other error
  35  
  36  #include "a68g.h"
  37  #include "a68g-prelude.h"
  38  #include "a68g-genie.h"
  39  #include "a68g-transput.h"
  40  
  41  #if defined (HAVE_POSTGRESQL)
  42  
  43  #define LIBPQ_STRING "PostgreSQL libq"
  44  #define ERROR_NOT_CONNECTED "not connected to a database"
  45  #define ERROR_NO_QUERY_RESULT "no query result available"
  46  
  47  #define NO_PGCONN ((PGconn *) NULL)
  48  #define NO_PGRESULT ((PGresult *) NULL)
  49  
  50  //! @brief PROC pg connect db (REF FILE, STRING, REF STRING) INT
  51  
  52  void genie_pq_connectdb (NODE_T * p)
  53  {
  54    A68_REF ref_string, ref_file, ref_z, conninfo;
  55    A68_FILE *file;
  56    POP_REF (p, &ref_string);
  57    CHECK_REF (p, ref_string, M_REF_STRING);
  58    POP_REF (p, &conninfo);
  59    POP_REF (p, &ref_file);
  60    CHECK_REF (p, ref_file, M_REF_FILE);
  61    if (IS_IN_HEAP (&ref_file) && !IS_IN_HEAP (&ref_string)) {
  62      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SCOPE_DYNAMIC_1, M_REF_STRING);
  63      exit_genie (p, A68_RUNTIME_ERROR);
  64    } else if (IS_IN_FRAME (&ref_file) && IS_IN_FRAME (&ref_string)) {
  65      if (REF_SCOPE (&ref_string) > REF_SCOPE (&ref_file)) {
  66        diagnostic (A68_RUNTIME_ERROR, p, ERROR_SCOPE_DYNAMIC_1, M_REF_STRING);
  67        exit_genie (p, A68_RUNTIME_ERROR);
  68      }
  69    }
  70  // Initialise the file.
  71    file = FILE_DEREF (&ref_file);
  72    if (OPENED (file)) {
  73      diagnostic (A68_RUNTIME_ERROR, p, ERROR_FILE_ALREADY_OPEN);
  74      exit_genie (p, A68_RUNTIME_ERROR);
  75    }
  76    STATUS (file) = INIT_MASK;
  77    CHANNEL (file) = A68 (associate_channel);
  78    OPENED (file) = A68_TRUE;
  79    OPEN_EXCLUSIVE (file) = A68_FALSE;
  80    READ_MOOD (file) = A68_FALSE;
  81    WRITE_MOOD (file) = A68_FALSE;
  82    CHAR_MOOD (file) = A68_FALSE;
  83    DRAW_MOOD (file) = A68_FALSE;
  84    TMP_FILE (file) = A68_FALSE;
  85    if (INITIALISED (&(IDENTIFICATION (file))) && !IS_NIL (IDENTIFICATION (file))) {
  86      UNBLOCK_GC_HANDLE (&(IDENTIFICATION (file)));
  87    }
  88    IDENTIFICATION (file) = nil_ref;
  89    TERMINATOR (file) = nil_ref;
  90    FORMAT (file) = nil_format;
  91    FD (file) = -1;
  92    if (INITIALISED (&(STRING (file))) && !IS_NIL (STRING (file))) {
  93      UNBLOCK_GC_HANDLE (&(STRING (file)));
  94    }
  95    STRING (file) = ref_string;
  96    BLOCK_GC_HANDLE (&(STRING (file)));
  97    STRPOS (file) = 0;
  98    STREAM (&DEVICE (file)) = NULL;
  99    set_default_event_procedures (file);
 100  // Establish a connection.
 101    ref_z = heap_generator (p, M_C_STRING, 1 + a68_string_size (p, conninfo));
 102    CONNECTION (file) = PQconnectdb (a_to_c_string (p, DEREF (char, &ref_z), conninfo));
 103    RESULT (file) = NO_PGRESULT;
 104    if (CONNECTION (file) == NO_PGCONN) {
 105      PUSH_PRIMAL (p, -3, INT);
 106    }
 107    (void) PQsetErrorVerbosity (CONNECTION (file), PQERRORS_DEFAULT);
 108    if (PQstatus (CONNECTION (file)) != CONNECTION_OK) {
 109      PUSH_PRIMAL (p, -1, INT);
 110    } else {
 111      PUSH_PRIMAL (p, 0, INT);
 112    }
 113  }
 114  
 115  //! @brief PROC pq finish (REF FILE) VOID
 116  
 117  void genie_pq_finish (NODE_T * p)
 118  {
 119    A68_REF ref_file;
 120    A68_FILE *file;
 121    POP_REF (p, &ref_file);
 122    CHECK_REF (p, ref_file, M_REF_FILE);
 123    file = FILE_DEREF (&ref_file);
 124    CHECK_INIT (p, INITIALISED (file), M_FILE);
 125    if (CONNECTION (file) == NO_PGCONN) {
 126      PUSH_PRIMAL (p, -1, INT);
 127      return;
 128    }
 129    if (RESULT (file) != NO_PGRESULT) {
 130      PQclear (RESULT (file));
 131    }
 132    PQfinish (CONNECTION (file));
 133    CONNECTION (file) = NO_PGCONN;
 134    RESULT (file) = NO_PGRESULT;
 135    PUSH_PRIMAL (p, 0, INT);
 136  }
 137  
 138  //! @brief PROC pq reset (REF FILE) VOID
 139  
 140  void genie_pq_reset (NODE_T * p)
 141  {
 142    A68_REF ref_file;
 143    A68_FILE *file;
 144    POP_REF (p, &ref_file);
 145    CHECK_REF (p, ref_file, M_REF_FILE);
 146    file = FILE_DEREF (&ref_file);
 147    CHECK_INIT (p, INITIALISED (file), M_FILE);
 148    if (CONNECTION (file) == NO_PGCONN) {
 149      PUSH_PRIMAL (p, -1, INT);
 150      return;
 151    }
 152    if (RESULT (file) != NO_PGRESULT) {
 153      PQclear (RESULT (file));
 154    }
 155    PQreset (CONNECTION (file));
 156    PUSH_PRIMAL (p, 0, INT);
 157  }
 158  
 159  //! @brief PROC pq exec = (REF FILE, STRING) INT
 160  
 161  void genie_pq_exec (NODE_T * p)
 162  {
 163    A68_REF ref_z, query;
 164    A68_REF ref_file;
 165    A68_FILE *file;
 166    POP_REF (p, &query);
 167    POP_REF (p, &ref_file);
 168    CHECK_REF (p, ref_file, M_REF_FILE);
 169    file = FILE_DEREF (&ref_file);
 170    CHECK_INIT (p, INITIALISED (file), M_FILE);
 171    if (CONNECTION (file) == NO_PGCONN) {
 172      PUSH_PRIMAL (p, -1, INT);
 173      return;
 174    }
 175    if (RESULT (file) != NO_PGRESULT) {
 176      PQclear (RESULT (file));
 177    }
 178    ref_z = heap_generator (p, M_C_STRING, 1 + a68_string_size (p, query));
 179    RESULT (file) = PQexec (CONNECTION (file), a_to_c_string (p, DEREF (char, &ref_z), query));
 180    if ((PQresultStatus (RESULT (file)) != PGRES_TUPLES_OK)
 181        && (PQresultStatus (RESULT (file)) != PGRES_COMMAND_OK)) {
 182      PUSH_PRIMAL (p, -3, INT);
 183    } else {
 184      PUSH_PRIMAL (p, 0, INT);
 185    }
 186  }
 187  
 188  //! @brief PROC pq parameterstatus (REF FILE) INT
 189  
 190  void genie_pq_parameterstatus (NODE_T * p)
 191  {
 192    A68_REF ref_z, parameter;
 193    A68_REF ref_file;
 194    A68_FILE *file;
 195    POP_REF (p, &parameter);
 196    POP_REF (p, &ref_file);
 197    CHECK_REF (p, ref_file, M_REF_FILE);
 198    file = FILE_DEREF (&ref_file);
 199    CHECK_INIT (p, INITIALISED (file), M_FILE);
 200    if (CONNECTION (file) == NO_PGCONN) {
 201      PUSH_PRIMAL (p, -1, INT);
 202      return;
 203    }
 204    ref_z = heap_generator (p, M_C_STRING, 1 + a68_string_size (p, parameter));
 205    if (!IS_NIL (STRING (file))) {
 206      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, (char *) PQparameterStatus (CONNECTION (file), a_to_c_string (p, DEREF (char, &ref_z), parameter)), DEFAULT_WIDTH);
 207      PUSH_PRIMAL (p, 0, INT);
 208    } else {
 209      PUSH_PRIMAL (p, -3, INT);
 210    }
 211  }
 212  
 213  //! @brief PROC pq cmdstatus (REF FILE) INT
 214  
 215  void genie_pq_cmdstatus (NODE_T * p)
 216  {
 217    A68_REF ref_file;
 218    A68_FILE *file;
 219    POP_REF (p, &ref_file);
 220    CHECK_REF (p, ref_file, M_REF_FILE);
 221    file = FILE_DEREF (&ref_file);
 222    CHECK_INIT (p, INITIALISED (file), M_FILE);
 223    if (CONNECTION (file) == NO_PGCONN) {
 224      PUSH_PRIMAL (p, -1, INT);
 225      return;
 226    }
 227    if (RESULT (file) == NO_PGRESULT) {
 228      PUSH_PRIMAL (p, -1, INT);
 229      return;
 230    }
 231    if (!IS_NIL (STRING (file))) {
 232      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQcmdStatus (RESULT (file)), DEFAULT_WIDTH);
 233      STRPOS (file) = 0;
 234      PUSH_PRIMAL (p, 0, INT);
 235    } else {
 236      PUSH_PRIMAL (p, -3, INT);
 237    }
 238  }
 239  
 240  //! @brief PROC pq cmdtuples (REF FILE) INT
 241  
 242  void genie_pq_cmdtuples (NODE_T * p)
 243  {
 244    A68_REF ref_file;
 245    A68_FILE *file;
 246    POP_REF (p, &ref_file);
 247    CHECK_REF (p, ref_file, M_REF_FILE);
 248    file = FILE_DEREF (&ref_file);
 249    CHECK_INIT (p, INITIALISED (file), M_FILE);
 250    if (CONNECTION (file) == NO_PGCONN) {
 251      PUSH_PRIMAL (p, -1, INT);
 252      return;
 253    }
 254    if (RESULT (file) == NO_PGRESULT) {
 255      PUSH_PRIMAL (p, -1, INT);
 256      return;
 257    }
 258    if (!IS_NIL (STRING (file))) {
 259      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQcmdTuples (RESULT (file)), DEFAULT_WIDTH);
 260      STRPOS (file) = 0;
 261      PUSH_PRIMAL (p, 0, INT);
 262    } else {
 263      PUSH_PRIMAL (p, -3, INT);
 264    }
 265  }
 266  
 267  //! @brief PROC pq ntuples (REF FILE) INT
 268  
 269  void genie_pq_ntuples (NODE_T * p)
 270  {
 271    A68_REF ref_file;
 272    A68_FILE *file;
 273    POP_REF (p, &ref_file);
 274    CHECK_REF (p, ref_file, M_REF_FILE);
 275    file = FILE_DEREF (&ref_file);
 276    CHECK_INIT (p, INITIALISED (file), M_FILE);
 277    if (CONNECTION (file) == NO_PGCONN) {
 278      PUSH_PRIMAL (p, -1, INT);
 279      return;
 280    }
 281    if (RESULT (file) == NO_PGRESULT) {
 282      PUSH_PRIMAL (p, -2, INT);
 283      return;
 284    }
 285    PUSH_PRIMAL (p, (PQresultStatus (RESULT (file))) == PGRES_TUPLES_OK ? PQntuples (RESULT (file)) : -3, INT);
 286  }
 287  
 288  //! @brief PROC pq nfields (REF FILE) INT
 289  
 290  void genie_pq_nfields (NODE_T * p)
 291  {
 292    A68_REF ref_file;
 293    A68_FILE *file;
 294    POP_REF (p, &ref_file);
 295    CHECK_REF (p, ref_file, M_REF_FILE);
 296    file = FILE_DEREF (&ref_file);
 297    CHECK_INIT (p, INITIALISED (file), M_FILE);
 298    if (CONNECTION (file) == NO_PGCONN) {
 299      PUSH_PRIMAL (p, -1, INT);
 300      return;
 301    }
 302    if (RESULT (file) == NO_PGRESULT) {
 303      PUSH_PRIMAL (p, -2, INT);
 304      return;
 305    }
 306    PUSH_PRIMAL (p, (PQresultStatus (RESULT (file))) == PGRES_TUPLES_OK ? PQnfields (RESULT (file)) : -3, INT);
 307  }
 308  
 309  //! @brief PROC pq fname (REF FILE, INT) INT
 310  
 311  void genie_pq_fname (NODE_T * p)
 312  {
 313    A68_INT a68_index;
 314    int upb;
 315    A68_REF ref_file;
 316    A68_FILE *file;
 317    POP_OBJECT (p, &a68_index, A68_INT);
 318    CHECK_INIT (p, INITIALISED (&a68_index), M_INT);
 319    POP_REF (p, &ref_file);
 320    CHECK_REF (p, ref_file, M_REF_FILE);
 321    file = FILE_DEREF (&ref_file);
 322    CHECK_INIT (p, INITIALISED (file), M_FILE);
 323    if (CONNECTION (file) == NO_PGCONN) {
 324      PUSH_PRIMAL (p, -1, INT);
 325      return;
 326    }
 327    if (RESULT (file) == NO_PGRESULT) {
 328      PUSH_PRIMAL (p, -2, INT);
 329      return;
 330    }
 331    upb = (PQresultStatus (RESULT (file)) == PGRES_TUPLES_OK ? PQnfields (RESULT (file)) : 0);
 332    if (VALUE (&a68_index) < 1 || VALUE (&a68_index) > upb) {
 333      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INDEX_OUT_OF_BOUNDS);
 334      exit_genie (p, A68_RUNTIME_ERROR);
 335    }
 336    if (!IS_NIL (STRING (file))) {
 337      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQfname (RESULT (file), VALUE (&a68_index) - 1), DEFAULT_WIDTH);
 338      STRPOS (file) = 0;
 339    }
 340    PUSH_PRIMAL (p, 0, INT);
 341  }
 342  
 343  //! @brief PROC pq fnumber = (REF FILE, STRING) INT
 344  
 345  void genie_pq_fnumber (NODE_T * p)
 346  {
 347    A68_REF ref_z, name;
 348    A68_REF ref_file;
 349    A68_FILE *file;
 350    int k;
 351    POP_REF (p, &name);
 352    POP_REF (p, &ref_file);
 353    CHECK_REF (p, ref_file, M_REF_FILE);
 354    file = FILE_DEREF (&ref_file);
 355    CHECK_INIT (p, INITIALISED (file), M_FILE);
 356    if (CONNECTION (file) == NO_PGCONN) {
 357      PUSH_PRIMAL (p, -1, INT);
 358      return;
 359    }
 360    if (RESULT (file) == NO_PGRESULT) {
 361      PUSH_PRIMAL (p, -2, INT);
 362      return;
 363    }
 364    ref_z = heap_generator (p, M_C_STRING, 1 + a68_string_size (p, name));
 365    k = PQfnumber (RESULT (file), a_to_c_string (p, DEREF (char, &ref_z), name));
 366    if (k == -1) {
 367      PUSH_PRIMAL (p, -3, INT);
 368    } else {
 369      PUSH_PRIMAL (p, k + 1, INT);
 370    }
 371  }
 372  
 373  //! @brief PROC pq fformat (REF FILE, INT) INT
 374  
 375  void genie_pq_fformat (NODE_T * p)
 376  {
 377    A68_INT a68_index;
 378    int upb;
 379    A68_REF ref_file;
 380    A68_FILE *file;
 381    POP_OBJECT (p, &a68_index, A68_INT);
 382    CHECK_INIT (p, INITIALISED (&a68_index), M_INT);
 383    POP_REF (p, &ref_file);
 384    CHECK_REF (p, ref_file, M_REF_FILE);
 385    file = FILE_DEREF (&ref_file);
 386    CHECK_INIT (p, INITIALISED (file), M_FILE);
 387    if (CONNECTION (file) == NO_PGCONN) {
 388      PUSH_PRIMAL (p, -1, INT);
 389      return;
 390    }
 391    if (RESULT (file) == NO_PGRESULT) {
 392      PUSH_PRIMAL (p, -2, INT);
 393      return;
 394    }
 395    upb = (PQresultStatus (RESULT (file)) == PGRES_TUPLES_OK ? PQnfields (RESULT (file)) : 0);
 396    if (VALUE (&a68_index) < 1 || VALUE (&a68_index) > upb) {
 397      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INDEX_OUT_OF_BOUNDS);
 398      exit_genie (p, A68_RUNTIME_ERROR);
 399    }
 400    PUSH_PRIMAL (p, PQfformat (RESULT (file), VALUE (&a68_index) - 1), INT);
 401  }
 402  
 403  //! @brief PROC pq getvalue (REF FILE, INT, INT) INT
 404  
 405  void genie_pq_getvalue (NODE_T * p)
 406  {
 407    A68_INT row, column;
 408    char *str;
 409    int upb;
 410    A68_REF ref_file;
 411    A68_FILE *file;
 412    POP_OBJECT (p, &column, A68_INT);
 413    CHECK_INIT (p, INITIALISED (&column), M_INT);
 414    POP_OBJECT (p, &row, A68_INT);
 415    CHECK_INIT (p, INITIALISED (&row), M_INT);
 416    POP_REF (p, &ref_file);
 417    CHECK_REF (p, ref_file, M_REF_FILE);
 418    file = FILE_DEREF (&ref_file);
 419    CHECK_INIT (p, INITIALISED (file), M_FILE);
 420    if (CONNECTION (file) == NO_PGCONN) {
 421      PUSH_PRIMAL (p, -1, INT);
 422      return;
 423    }
 424    if (RESULT (file) == NO_PGRESULT) {
 425      PUSH_PRIMAL (p, -2, INT);
 426      return;
 427    }
 428    upb = (PQresultStatus (RESULT (file)) == PGRES_TUPLES_OK ? PQnfields (RESULT (file)) : 0);
 429    if (VALUE (&column) < 1 || VALUE (&column) > upb) {
 430      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INDEX_OUT_OF_BOUNDS);
 431      exit_genie (p, A68_RUNTIME_ERROR);
 432    }
 433    upb = (PQresultStatus (RESULT (file)) == PGRES_TUPLES_OK ? PQntuples (RESULT (file)) : 0);
 434    if (VALUE (&row) < 1 || VALUE (&row) > upb) {
 435      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INDEX_OUT_OF_BOUNDS);
 436      exit_genie (p, A68_RUNTIME_ERROR);
 437    }
 438    str = PQgetvalue (RESULT (file), VALUE (&row) - 1, VALUE (&column) - 1);
 439    if (str == NULL) {
 440      diagnostic (A68_RUNTIME_ERROR, p, ERROR_NO_QUERY_RESULT);
 441      exit_genie (p, A68_RUNTIME_ERROR);
 442    }
 443    if (!IS_NIL (STRING (file))) {
 444      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, str, DEFAULT_WIDTH);
 445      STRPOS (file) = 0;
 446      PUSH_PRIMAL (p, 0, INT);
 447    } else {
 448      PUSH_PRIMAL (p, -3, INT);
 449    }
 450  }
 451  
 452  //! @brief PROC pq getisnull (REF FILE, INT, INT) INT
 453  
 454  void genie_pq_getisnull (NODE_T * p)
 455  {
 456    A68_INT row, column;
 457    int upb;
 458    A68_REF ref_file;
 459    A68_FILE *file;
 460    POP_OBJECT (p, &column, A68_INT);
 461    CHECK_INIT (p, INITIALISED (&column), M_INT);
 462    POP_OBJECT (p, &row, A68_INT);
 463    CHECK_INIT (p, INITIALISED (&row), M_INT);
 464    POP_REF (p, &ref_file);
 465    CHECK_REF (p, ref_file, M_REF_FILE);
 466    file = FILE_DEREF (&ref_file);
 467    CHECK_INIT (p, INITIALISED (file), M_FILE);
 468    if (CONNECTION (file) == NO_PGCONN) {
 469      PUSH_PRIMAL (p, -1, INT);
 470      return;
 471    }
 472    if (RESULT (file) == NO_PGRESULT) {
 473      PUSH_PRIMAL (p, -2, INT);
 474      return;
 475    }
 476    upb = (PQresultStatus (RESULT (file)) == PGRES_TUPLES_OK ? PQnfields (RESULT (file)) : 0);
 477    if (VALUE (&column) < 1 || VALUE (&column) > upb) {
 478      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INDEX_OUT_OF_BOUNDS);
 479      exit_genie (p, A68_RUNTIME_ERROR);
 480    }
 481    upb = (PQresultStatus (RESULT (file)) == PGRES_TUPLES_OK ? PQntuples (RESULT (file)) : 0);
 482    if (VALUE (&row) < 1 || VALUE (&row) > upb) {
 483      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INDEX_OUT_OF_BOUNDS);
 484      exit_genie (p, A68_RUNTIME_ERROR);
 485    }
 486    PUSH_PRIMAL (p, PQgetisnull (RESULT (file), VALUE (&row) - 1, VALUE (&column) - 1), INT);
 487  }
 488  
 489  //! @brief Edit error message sting from libpq.
 490  
 491  char *pq_edit (char *str)
 492  {
 493    if (str == NULL) {
 494      return "";
 495    } else {
 496      static BUFFER edt;
 497      char *q;
 498      int newlines = 0, len = (int) strlen (str);
 499      BOOL_T suppress_blank = A68_FALSE;
 500      q = edt;
 501      while (len > 0 && str[len - 1] == NEWLINE_CHAR) {
 502        str[len - 1] = NULL_CHAR;
 503        len = (int) strlen (str);
 504      }
 505      while (str[0] != NULL_CHAR) {
 506        if (str[0] == CR_CHAR) {
 507          str++;
 508        } else if (str[0] == NEWLINE_CHAR) {
 509          if (newlines++ == 0) {
 510            *(q++) = POINT_CHAR;
 511            *(q++) = BLANK_CHAR;
 512            *(q++) = '(';
 513          } else {
 514            *(q++) = BLANK_CHAR;
 515          }
 516          suppress_blank = A68_TRUE;
 517          str++;
 518        } else if (IS_SPACE (str[0])) {
 519          if (suppress_blank) {
 520            str++;
 521          } else {
 522            if (str[1] != NEWLINE_CHAR) {
 523              *(q++) = BLANK_CHAR;
 524            }
 525            str++;
 526            suppress_blank = A68_TRUE;
 527          }
 528        } else {
 529          *(q++) = *(str++);
 530          suppress_blank = A68_FALSE;
 531        }
 532      }
 533      if (newlines > 0) {
 534        *(q++) = ')';
 535      }
 536      q[0] = NULL_CHAR;
 537      return edt;
 538    }
 539  }
 540  
 541  //! @brief PROC pq errormessage (REF FILE) INT 
 542  
 543  void genie_pq_errormessage (NODE_T * p)
 544  {
 545    A68_REF ref_file;
 546    A68_FILE *file;
 547    POP_REF (p, &ref_file);
 548    CHECK_REF (p, ref_file, M_REF_FILE);
 549    file = FILE_DEREF (&ref_file);
 550    CHECK_INIT (p, INITIALISED (file), M_FILE);
 551    if (CONNECTION (file) == NO_PGCONN) {
 552      PUSH_PRIMAL (p, -1, INT);
 553      return;
 554    }
 555    if (!IS_NIL (STRING (file))) {
 556      BUFFER str;
 557      int upb;
 558      if (PQerrorMessage (CONNECTION (file)) != NULL) {
 559        bufcpy (str, pq_edit (PQerrorMessage (CONNECTION (file))), BUFFER_SIZE);
 560        upb = (int) strlen (str);
 561        if (upb > 0 && str[upb - 1] == NEWLINE_CHAR) {
 562          str[upb - 1] = NULL_CHAR;
 563        }
 564      } else {
 565        bufcpy (str, "no error message available", BUFFER_SIZE);
 566      }
 567      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, str, DEFAULT_WIDTH);
 568      STRPOS (file) = 0;
 569      PUSH_PRIMAL (p, 0, INT);
 570    } else {
 571      PUSH_PRIMAL (p, -3, INT);
 572    }
 573  }
 574  
 575  //! @brief PROC pq resulterrormessage (REF FILE) INT 
 576  
 577  void genie_pq_resulterrormessage (NODE_T * p)
 578  {
 579    A68_REF ref_file;
 580    A68_FILE *file;
 581    POP_REF (p, &ref_file);
 582    CHECK_REF (p, ref_file, M_REF_FILE);
 583    file = FILE_DEREF (&ref_file);
 584    CHECK_INIT (p, INITIALISED (file), M_FILE);
 585    if (CONNECTION (file) == NO_PGCONN) {
 586      PUSH_PRIMAL (p, -1, INT);
 587      return;
 588    }
 589    if (RESULT (file) == NO_PGRESULT) {
 590      PUSH_PRIMAL (p, -2, INT);
 591      return;
 592    }
 593    if (!IS_NIL (STRING (file))) {
 594      BUFFER str;
 595      int upb;
 596      if (PQresultErrorMessage (RESULT (file)) != NULL) {
 597        bufcpy (str, pq_edit (PQresultErrorMessage (RESULT (file))), BUFFER_SIZE);
 598        upb = (int) strlen (str);
 599        if (upb > 0 && str[upb - 1] == NEWLINE_CHAR) {
 600          str[upb - 1] = NULL_CHAR;
 601        }
 602      } else {
 603        bufcpy (str, "no error message available", BUFFER_SIZE);
 604      }
 605      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, str, DEFAULT_WIDTH);
 606      STRPOS (file) = 0;
 607      PUSH_PRIMAL (p, 0, INT);
 608    } else {
 609      PUSH_PRIMAL (p, -3, INT);
 610    }
 611  }
 612  
 613  //! @brief PROC pq db (REF FILE) INT 
 614  
 615  void genie_pq_db (NODE_T * p)
 616  {
 617    A68_REF ref_file;
 618    A68_FILE *file;
 619    POP_REF (p, &ref_file);
 620    CHECK_REF (p, ref_file, M_REF_FILE);
 621    file = FILE_DEREF (&ref_file);
 622    CHECK_INIT (p, INITIALISED (file), M_FILE);
 623    if (CONNECTION (file) == NO_PGCONN) {
 624      PUSH_PRIMAL (p, -1, INT);
 625      return;
 626    }
 627    if (!IS_NIL (STRING (file))) {
 628      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQdb (CONNECTION (file)), DEFAULT_WIDTH);
 629      STRPOS (file) = 0;
 630      PUSH_PRIMAL (p, 0, INT);
 631    } else {
 632      PUSH_PRIMAL (p, -3, INT);
 633    }
 634  }
 635  
 636  //! @brief PROC pq user (REF FILE) INT 
 637  
 638  void genie_pq_user (NODE_T * p)
 639  {
 640    A68_REF ref_file;
 641    A68_FILE *file;
 642    POP_REF (p, &ref_file);
 643    CHECK_REF (p, ref_file, M_REF_FILE);
 644    file = FILE_DEREF (&ref_file);
 645    CHECK_INIT (p, INITIALISED (file), M_FILE);
 646    if (CONNECTION (file) == NO_PGCONN) {
 647      PUSH_PRIMAL (p, -1, INT);
 648      return;
 649    }
 650    if (!IS_NIL (STRING (file))) {
 651      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQuser (CONNECTION (file)), DEFAULT_WIDTH);
 652      STRPOS (file) = 0;
 653      PUSH_PRIMAL (p, 0, INT);
 654    } else {
 655      PUSH_PRIMAL (p, -3, INT);
 656    }
 657  }
 658  
 659  //! @brief PROC pq pass (REF FILE) INT 
 660  
 661  void genie_pq_pass (NODE_T * p)
 662  {
 663    A68_REF ref_file;
 664    A68_FILE *file;
 665    POP_REF (p, &ref_file);
 666    CHECK_REF (p, ref_file, M_REF_FILE);
 667    file = FILE_DEREF (&ref_file);
 668    CHECK_INIT (p, INITIALISED (file), M_FILE);
 669    if (CONNECTION (file) == NO_PGCONN) {
 670      PUSH_PRIMAL (p, -1, INT);
 671      return;
 672    }
 673    if (!IS_NIL (STRING (file))) {
 674      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQpass (CONNECTION (file)), DEFAULT_WIDTH);
 675      STRPOS (file) = 0;
 676      PUSH_PRIMAL (p, 0, INT);
 677    } else {
 678      PUSH_PRIMAL (p, -3, INT);
 679    }
 680  }
 681  
 682  //! @brief PROC pq host (REF FILE) INT 
 683  
 684  void genie_pq_host (NODE_T * p)
 685  {
 686    A68_REF ref_file;
 687    A68_FILE *file;
 688    POP_REF (p, &ref_file);
 689    CHECK_REF (p, ref_file, M_REF_FILE);
 690    file = FILE_DEREF (&ref_file);
 691    CHECK_INIT (p, INITIALISED (file), M_FILE);
 692    if (CONNECTION (file) == NO_PGCONN) {
 693      PUSH_PRIMAL (p, -1, INT);
 694      return;
 695    }
 696    if (!IS_NIL (STRING (file))) {
 697      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQhost (CONNECTION (file)), DEFAULT_WIDTH);
 698      STRPOS (file) = 0;
 699      PUSH_PRIMAL (p, 0, INT);
 700    } else {
 701      PUSH_PRIMAL (p, -3, INT);
 702    }
 703  }
 704  
 705  //! @brief PROC pq port (REF FILE) INT 
 706  
 707  void genie_pq_port (NODE_T * p)
 708  {
 709    A68_REF ref_file;
 710    A68_FILE *file;
 711    POP_REF (p, &ref_file);
 712    CHECK_REF (p, ref_file, M_REF_FILE);
 713    file = FILE_DEREF (&ref_file);
 714    CHECK_INIT (p, INITIALISED (file), M_FILE);
 715    if (CONNECTION (file) == NO_PGCONN) {
 716      PUSH_PRIMAL (p, -1, INT);
 717      return;
 718    }
 719    if (!IS_NIL (STRING (file))) {
 720      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQport (CONNECTION (file)), DEFAULT_WIDTH);
 721      STRPOS (file) = 0;
 722      PUSH_PRIMAL (p, 0, INT);
 723    } else {
 724      PUSH_PRIMAL (p, -3, INT);
 725    }
 726  }
 727  
 728  //! @brief PROC pq tty (REF FILE) INT 
 729  
 730  void genie_pq_tty (NODE_T * p)
 731  {
 732    A68_REF ref_file;
 733    A68_FILE *file;
 734    POP_REF (p, &ref_file);
 735    CHECK_REF (p, ref_file, M_REF_FILE);
 736    file = FILE_DEREF (&ref_file);
 737    CHECK_INIT (p, INITIALISED (file), M_FILE);
 738    if (CONNECTION (file) == NO_PGCONN) {
 739      PUSH_PRIMAL (p, -1, INT);
 740      return;
 741    }
 742    if (!IS_NIL (STRING (file))) {
 743      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQtty (CONNECTION (file)), DEFAULT_WIDTH);
 744      STRPOS (file) = 0;
 745      PUSH_PRIMAL (p, 0, INT);
 746    } else {
 747      PUSH_PRIMAL (p, -3, INT);
 748    }
 749  }
 750  
 751  //! @brief PROC pq options (REF FILE) INT 
 752  
 753  void genie_pq_options (NODE_T * p)
 754  {
 755    A68_REF ref_file;
 756    A68_FILE *file;
 757    POP_REF (p, &ref_file);
 758    CHECK_REF (p, ref_file, M_REF_FILE);
 759    file = FILE_DEREF (&ref_file);
 760    CHECK_INIT (p, INITIALISED (file), M_FILE);
 761    if (CONNECTION (file) == NO_PGCONN) {
 762      PUSH_PRIMAL (p, -1, INT);
 763      return;
 764    }
 765    if (!IS_NIL (STRING (file))) {
 766      *DEREF (A68_REF, &STRING (file)) = c_to_a_string (p, PQoptions (CONNECTION (file)), DEFAULT_WIDTH);
 767      STRPOS (file) = 0;
 768      PUSH_PRIMAL (p, 0, INT);
 769    } else {
 770      PUSH_PRIMAL (p, -3, INT);
 771    }
 772  }
 773  
 774  //! @brief PROC pq protocol version (REF FILE) INT 
 775  
 776  void genie_pq_protocolversion (NODE_T * p)
 777  {
 778    A68_REF ref_file;
 779    A68_FILE *file;
 780    POP_REF (p, &ref_file);
 781    CHECK_REF (p, ref_file, M_REF_FILE);
 782    file = FILE_DEREF (&ref_file);
 783    CHECK_INIT (p, INITIALISED (file), M_FILE);
 784    if (CONNECTION (file) == NO_PGCONN) {
 785      PUSH_PRIMAL (p, -1, INT);
 786      return;
 787    }
 788    if (!IS_NIL (STRING (file))) {
 789      PUSH_PRIMAL (p, PQprotocolVersion (CONNECTION (file)), INT);
 790    } else {
 791      PUSH_PRIMAL (p, -3, INT);
 792    }
 793  }
 794  
 795  //! @brief PROC pq server version (REF FILE) INT 
 796  
 797  void genie_pq_serverversion (NODE_T * p)
 798  {
 799    A68_REF ref_file;
 800    A68_FILE *file;
 801    POP_REF (p, &ref_file);
 802    CHECK_REF (p, ref_file, M_REF_FILE);
 803    file = FILE_DEREF (&ref_file);
 804    CHECK_INIT (p, INITIALISED (file), M_FILE);
 805    if (CONNECTION (file) == NO_PGCONN) {
 806      PUSH_PRIMAL (p, -1, INT);
 807      return;
 808    }
 809    if (!IS_NIL (STRING (file))) {
 810      PUSH_PRIMAL (p, PQserverVersion (CONNECTION (file)), INT);
 811    } else {
 812      PUSH_PRIMAL (p, -3, INT);
 813    }
 814  }
 815  
 816  //! @brief PROC pq socket (REF FILE) INT 
 817  
 818  void genie_pq_socket (NODE_T * p)
 819  {
 820    A68_REF ref_file;
 821    A68_FILE *file;
 822    POP_REF (p, &ref_file);
 823    CHECK_REF (p, ref_file, M_REF_FILE);
 824    file = FILE_DEREF (&ref_file);
 825    CHECK_INIT (p, INITIALISED (file), M_FILE);
 826    if (CONNECTION (file) == NO_PGCONN) {
 827      PUSH_PRIMAL (p, -1, INT);
 828      return;
 829    }
 830    if (!IS_NIL (STRING (file))) {
 831      PUSH_PRIMAL (p, PQsocket (CONNECTION (file)), INT);
 832    } else {
 833      PUSH_PRIMAL (p, -3, INT);
 834    }
 835  }
 836  
 837  //! @brief PROC pq backend pid (REF FILE) INT 
 838  
 839  void genie_pq_backendpid (NODE_T * p)
 840  {
 841    A68_REF ref_file;
 842    A68_FILE *file;
 843    POP_REF (p, &ref_file);
 844    CHECK_REF (p, ref_file, M_REF_FILE);
 845    file = FILE_DEREF (&ref_file);
 846    CHECK_INIT (p, INITIALISED (file), M_FILE);
 847    if (CONNECTION (file) == NO_PGCONN) {
 848      PUSH_PRIMAL (p, -1, INT);
 849      return;
 850    }
 851    if (!IS_NIL (STRING (file))) {
 852      PUSH_PRIMAL (p, PQbackendPID (CONNECTION (file)), INT);
 853    } else {
 854      PUSH_PRIMAL (p, -3, INT);
 855    }
 856  }
 857  
 858  #endif