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