src/pl/plperl/SPI.xs

   1 /* this must be first: */
   2 #include "postgres.h"
   3 /* Defined by Perl */
   4 #undef _
   5
   6 /* perl stuff */
   7 #include "plperl.h"
   8
   9
  10 /*
  11  * Implementation of plperl's elog() function
  12  *
  13  * If the error level is less than ERROR, we'll just emit the message and
  14  * return.  When it is ERROR, elog() will longjmp, which we catch and
  15  * turn into a Perl croak().  Note we are assuming that elog() can't have
  16  * any internal failures that are so bad as to require a transaction abort.
  17  *
  18  * This is out-of-line to suppress "might be clobbered by longjmp" warnings.
  19  */
  20 static void
  21 do_spi_elog(int level, char *message)
  22 {
  23         MemoryContext oldcontext = CurrentMemoryContext;
  24
  25         PG_TRY();
  26         {
  27                 elog(level, "%s", message);
  28         }
  29         PG_CATCH();
  30         {
  31                 ErrorData  *edata;
  32
  33                 /* Must reset elog.c's state */
  34                 MemoryContextSwitchTo(oldcontext);
  35                 edata = CopyErrorData();
  36                 FlushErrorState();
  37
  38                 /* Punt the error to Perl */
  39                 croak("%s", edata->message);
  40         }
  41         PG_END_TRY();
  42 }
  43
  44 /*
  45  * Interface routine to catch ereports and punt them to Perl
  46  */
  47 static void
  48 do_plperl_return_next(SV *sv)
  49 {
  50         MemoryContext oldcontext = CurrentMemoryContext;
  51
  52         PG_TRY();
  53         {
  54                 plperl_return_next(sv);
  55         }
  56         PG_CATCH();
  57         {
  58                 ErrorData  *edata;
  59
  60                 /* Must reset elog.c's state */
  61                 MemoryContextSwitchTo(oldcontext);
  62                 edata = CopyErrorData();
  63                 FlushErrorState();
  64
  65                 /* Punt the error to Perl */
  66                 croak("%s", edata->message);
  67         }
  68         PG_END_TRY();
  69 }
  70
  71
  72 MODULE = SPI PREFIX = spi_
  73
  74 PROTOTYPES: ENABLE
  75 VERSIONCHECK: DISABLE
  76
  77 void
  78 spi_elog(level, message)
  79         int level
  80         char* message
  81         CODE:
  82                 if (level > ERROR)              /* no PANIC allowed thanks */
  83                         level = ERROR;
  84                 if (level < DEBUG5)
  85                         level = DEBUG5;
  86                 do_spi_elog(level, message);
  87
  88 int
  89 spi_DEBUG()
  90
  91 int
  92 spi_LOG()
  93
  94 int
  95 spi_INFO()
  96
  97 int
  98 spi_NOTICE()
  99
 100 int
 101 spi_WARNING()
 102
 103 int
 104 spi_ERROR()
 105
 106 SV*
 107 spi_spi_exec_query(query, ...)
 108         char* query;
 109         PREINIT:
 110                 HV *ret_hash;
 111                 int limit = 0;
 112         CODE:
 113                 if (items > 2)
 114                         croak("Usage: spi_exec_query(query, limit) "
 115                                   "or spi_exec_query(query)");
 116                 if (items == 2)
 117                         limit = SvIV(ST(1));
 118                 ret_hash = plperl_spi_exec(query, limit);
 119                 RETVAL = newRV_noinc((SV*) ret_hash);
 120         OUTPUT:
 121                 RETVAL
 122
 123 void
 124 spi_return_next(rv)
 125         SV *rv;
 126         CODE:
 127                 do_plperl_return_next(rv);
 128
 129 SV *
 130 spi_spi_query(query)
 131         char *query;
 132         CODE:
 133                 RETVAL = plperl_spi_query(query);
 134         OUTPUT:
 135                 RETVAL
 136
 137 SV *
 138 spi_spi_fetchrow(cursor)
 139         char *cursor;
 140         CODE:
 141                 RETVAL = plperl_spi_fetchrow(cursor);
 142         OUTPUT:
 143                 RETVAL
 144
 145 SV*
 146 spi_spi_prepare(query, ...)
 147         char* query;
 148         CODE:
 149                 int i;
 150                 SV** argv;
 151                 if (items < 1)
 152                         Perl_croak(aTHX_ "Usage: spi_prepare(query, ...)");
 153                 argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
 154                 for ( i = 1; i < items; i++)
 155                         argv[i - 1] = ST(i);
 156                 RETVAL = plperl_spi_prepare(query, items - 1, argv);
 157                 pfree( argv);
 158         OUTPUT:
 159                 RETVAL
 160
 161 SV*
 162 spi_spi_exec_prepared(query, ...)
 163         char * query;
 164         PREINIT:
 165                 HV *ret_hash;
 166         CODE:
 167                 HV *attr = NULL;
 168                 int i, offset = 1, argc;
 169                 SV ** argv;
 170                 if ( items < 1)
 171                         Perl_croak(aTHX_ "Usage: spi_exec_prepared(query, [\\%%attr,] "
 172                                            "[\\@bind_values])");
 173                 if ( items > 1 && SvROK( ST( 1)) && SvTYPE( SvRV( ST( 1))) == SVt_PVHV)
 174                 {
 175                         attr = ( HV*) SvRV(ST(1));
 176                         offset++;
 177                 }
 178                 argc = items - offset;
 179                 argv = ( SV**) palloc( argc * sizeof(SV*));
 180                 for ( i = 0; offset < items; offset++, i++)
 181                         argv[i] = ST(offset);
 182                 ret_hash = plperl_spi_exec_prepared(query, attr, argc, argv);
 183                 RETVAL = newRV_noinc((SV*)ret_hash);
 184                 pfree( argv);
 185         OUTPUT:
 186                 RETVAL
 187
 188 SV*
 189 spi_spi_query_prepared(query, ...)
 190         char * query;
 191         CODE:
 192                 int i;
 193                 SV ** argv;
 194                 if ( items < 1)
 195                         Perl_croak(aTHX_ "Usage: spi_query_prepared(query, "
 196                                            "[\\@bind_values])");
 197                 argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
 198                 for ( i = 1; i < items; i++)
 199                         argv[i - 1] = ST(i);
 200                 RETVAL = plperl_spi_query_prepared(query, items - 1, argv);
 201                 pfree( argv);
 202         OUTPUT:
 203                 RETVAL
 204
 205 void
 206 spi_spi_freeplan(query)
 207         char *query;
 208         CODE:
 209                 plperl_spi_freeplan(query);
 210
 211 void
 212 spi_spi_cursor_close(cursor)
 213         char *cursor;
 214         CODE:
 215                 plperl_spi_cursor_close(cursor);
 216
 217
 218 BOOT:
 219     items = 0;  /* avoid 'unused variable' warning */