mirror of https://github.com/postgres/postgres
Attached is a uuencoded tarball that contains
3 new files and two patches for the plperl subdir. These changes add the ability for plperl functions to call 'elog'. It also sets up the frame work to allow me to add access to the SPI functions. -- Mark Hollomon
This commit is contained in:
parent
1380921e65
commit
c5b02a7a26
|
@ -47,6 +47,11 @@ print MAKEFILE <<_STATIC_;
|
|||
SRCDIR= ../../../src
|
||||
include \$(SRCDIR)/Makefile.global
|
||||
|
||||
EXTDIR= $Config{privlib}/ExtUtils
|
||||
|
||||
XSUBPP= \$(EXTDIR)/xsubpp
|
||||
|
||||
TYPEMAP= -typemap \$(EXTDIR)/typemap
|
||||
|
||||
# use the same compiler as perl did
|
||||
CC= $Config{cc}
|
||||
|
@ -95,12 +100,16 @@ endif
|
|||
#
|
||||
all: plperl
|
||||
|
||||
plperl : plperl.o
|
||||
\$(CC) -o plperl.so plperl.o \$(SHLIB_EXTRA_LIBS) \$(LDADD) \$(LDFLAGS)
|
||||
plperl : plperl.o SPI.o
|
||||
\$(CC) -o plperl.so plperl.o SPI.o \$(SHLIB_EXTRA_LIBS) \$(LDADD) \$(LDFLAGS)
|
||||
|
||||
%.o : %.c
|
||||
\$(CC) -c \$(CFLAGS) \$<
|
||||
|
||||
%.o : %.xs
|
||||
\$(XSUBPP} \$(TYPEMAP) \$< > xtmp.c
|
||||
\$(CC) -c \$(CFLAGS) -o \$@ xtmp.c
|
||||
|
||||
|
||||
#
|
||||
# Clean
|
||||
|
|
|
@ -0,0 +1,74 @@
|
|||
/* system stuff */
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdarg.h>
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
#include <string.h>
|
||||
#include <setjmp.h>
|
||||
|
||||
/* postgreSQL stuff */
|
||||
#include "executor/spi.h"
|
||||
#include "commands/trigger.h"
|
||||
#include "utils/elog.h"
|
||||
#include "utils/builtins.h"
|
||||
#include "fmgr.h"
|
||||
#include "access/heapam.h"
|
||||
|
||||
#include "tcop/tcopprot.h"
|
||||
#include "utils/syscache.h"
|
||||
#include "catalog/pg_proc.h"
|
||||
#include "catalog/pg_type.h"
|
||||
|
||||
/* perl stuff */
|
||||
/*
|
||||
* Evil Code Alert
|
||||
*
|
||||
* both posgreSQL and perl try to do 'the right thing'
|
||||
* and provide union semun if the platform doesn't define
|
||||
* it in a system header.
|
||||
* psql uses HAVE_UNION_SEMUN
|
||||
* perl uses HAS_UNION_SEMUN
|
||||
* together, they cause compile errors.
|
||||
* If we need it, the psql headers above will provide it.
|
||||
* So we tell perl that we have it.
|
||||
*/
|
||||
#ifndef HAS_UNION_SEMUN
|
||||
#define HAS_UNION_SEMUN
|
||||
#endif
|
||||
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
|
||||
#include "eloglvl.h"
|
||||
|
||||
|
||||
|
||||
MODULE = SPI PREFIX = elog_
|
||||
|
||||
PROTOTYPES: ENABLE
|
||||
VERSIONCHECK: DISABLE
|
||||
|
||||
void
|
||||
elog_elog(level, message)
|
||||
int level
|
||||
char* message
|
||||
CODE:
|
||||
if (level > 0)
|
||||
return;
|
||||
else
|
||||
elog(level, message);
|
||||
|
||||
|
||||
int
|
||||
elog_NOIND()
|
||||
|
||||
int
|
||||
elog_DEBUG()
|
||||
|
||||
int
|
||||
elog_ERROR()
|
||||
|
||||
int
|
||||
elog_NOTICE()
|
|
@ -0,0 +1,25 @@
|
|||
#include "utils/elog.h"
|
||||
|
||||
/*
|
||||
* This kludge is necessary because of the conflicting
|
||||
* definitions of 'DEBUG' between postgres and perl.
|
||||
* we'll live.
|
||||
*/
|
||||
|
||||
#include "eloglvl.h"
|
||||
|
||||
int elog_DEBUG(void) {
|
||||
return DEBUG;
|
||||
}
|
||||
|
||||
int elog_ERROR(void) {
|
||||
return ERROR;
|
||||
}
|
||||
|
||||
int elog_NOIND(void) {
|
||||
return NOIND;
|
||||
}
|
||||
|
||||
int elog_NOTICE(void) {
|
||||
return NOTICE;
|
||||
}
|
|
@ -0,0 +1,8 @@
|
|||
|
||||
int elog_DEBUG(void) ;
|
||||
|
||||
int elog_ERROR(void) ;
|
||||
|
||||
int elog_NOIND(void) ;
|
||||
|
||||
int elog_NOTICE(void);
|
|
@ -218,7 +218,7 @@ static void
|
|||
plperl_init_safe_interp(void)
|
||||
{
|
||||
|
||||
char *embedding[] = { "", "-e", "BEGIN { use DynaLoader; require Safe;}", "0" };
|
||||
char *embedding[] = { "", "-e", "use DynaLoader; require Safe; SPI::bootstrap()", "0" };
|
||||
|
||||
plperl_safe_interp = perl_alloc();
|
||||
if (!plperl_safe_interp)
|
||||
|
@ -235,10 +235,6 @@ plperl_init_safe_interp(void)
|
|||
************************* ***********************************/
|
||||
plperl_proc_hash = newHV();
|
||||
|
||||
/************************************************************
|
||||
* Install the commands for SPI support in the safe interpreter
|
||||
* Someday.
|
||||
************************************************************/
|
||||
}
|
||||
|
||||
|
||||
|
@ -356,6 +352,7 @@ plperl_create_sub(SV *s) {
|
|||
|
||||
extern void boot_DynaLoader _((CV* cv));
|
||||
extern void boot_Opcode _((CV* cv));
|
||||
extern void boot_SPI _((CV* cv));
|
||||
|
||||
extern void
|
||||
plperl_init_shared_libs(void)
|
||||
|
@ -363,6 +360,7 @@ plperl_init_shared_libs(void)
|
|||
char *file = __FILE__;
|
||||
newXS("DynaLoader::bootstrap", boot_DynaLoader, file);
|
||||
newXS("Opcode::bootstrap", boot_Opcode, file);
|
||||
newXS("SPI::bootstrap", boot_SPI, file);
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
|
@ -574,6 +572,7 @@ plperl_func_handler(FmgrInfo *proinfo,
|
|||
proc_internal_def = newSVpvf(
|
||||
"$::x = new Safe;"
|
||||
"$::x->permit_only(':default');"
|
||||
"$::x->share(qw[&elog &DEBUG &NOTICE &NOIND &ERROR]);"
|
||||
"use strict;"
|
||||
"return $::x->reval( q[ sub { %s } ]);", proc_source);
|
||||
|
||||
|
|
Loading…
Reference in New Issue