Now we are able to CREATE PROCEDURAL LANGUAGE (Thanks, Jan).

src/backend/commands/Makefile

@@ -4,7 +4,7 @@
 #    Makefile for commands
 #
 # IDENTIFICATION
-#    $Header: /cvsroot/pgsql/src/backend/commands/Makefile,v 1.4 1997/08/31 11:40:12 vadim Exp $
+#    $Header: /cvsroot/pgsql/src/backend/commands/Makefile,v 1.5 1997/10/28 14:54:43 vadim Exp $
 #
 #-------------------------------------------------------------------------
 
@@ -19,7 +19,7 @@ CFLAGS+=$(INCLUDE_OPT)
 
 OBJS = async.o creatinh.o command.o copy.o defind.o define.o \
        purge.o remove.o rename.o vacuum.o version.o view.o cluster.o \
-       recipe.o explain.o sequence.o trigger.o
+       recipe.o explain.o sequence.o trigger.o proclang.o
 
 all: SUBSYS.o
 

src/backend/commands/define.c

@@ -9,7 +9,7 @@
  *
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/backend/commands/define.c,v 1.16 1997/09/08 21:42:38 momjian Exp $
+ *	  $Header: /cvsroot/pgsql/src/backend/commands/define.c,v 1.17 1997/10/28 14:54:46 vadim Exp $
  *
  * DESCRIPTION
  *	  The "DefineFoo" routines take the parse tree and pick out the
@@ -45,6 +45,7 @@
 #include <catalog/pg_operator.h>
 #include <catalog/pg_proc.h>
 #include <catalog/pg_type.h>
+#include <catalog/pg_language.h>
 #include <utils/syscache.h>
 #include <fmgr.h>				/* for fmgr */
 #include <utils/builtins.h>		/* prototype for textin() */
@@ -239,6 +240,8 @@ CreateFunction(ProcedureStmt *stmt, CommandDest dest)
 	bool		canCache;
 	bool		returnsSet;
 
+	bool		lanisPL = false;
+
 	/* The function returns a set of values, as opposed to a singleton. */
 
 
@@ -262,19 +265,59 @@ CreateFunction(ProcedureStmt *stmt, CommandDest dest)
 	}
 	else
 	{
-		elog(WARN,
+		HeapTuple		languageTuple;
+		Form_pg_language	languageStruct;
+
+	        /* Lookup the language in the system cache */
+		languageTuple = SearchSysCacheTuple(LANNAME,
+			PointerGetDatum(languageName),
+			0, 0, 0);
+		
+		if (!HeapTupleIsValid(languageTuple)) {
+
+		    elog(WARN,
 			 "Unrecognized language specified in a CREATE FUNCTION: "
-			 "'%s'.  Recognized languages are sql, C, and internal.",
+			 "'%s'.  Recognized languages are sql, C, internal "
+			 "and the created procedural languages.",
 			 languageName);
+		}
+
+		/* Check that this language is a PL */
+		languageStruct = (Form_pg_language) GETSTRUCT(languageTuple);
+		if (!(languageStruct->lanispl)) {
+		    elog(WARN,
+		    	"Language '%s' isn't defined as PL", languageName);
+		}
+
+		/*
+		 * Functions in untrusted procedural languages are
+		 * restricted to be defined by postgres superusers only
+		 */
+		if (languageStruct->lanpltrusted == false && !superuser()) {
+		    elog(WARN, "Only users with Postgres superuser privilege "
+		    	"are permitted to create a function in the '%s' "
+			"language.",
+			languageName);
+		}
+
+		lanisPL = true;
+
+		/*
+		 * These are meaningless
+		 */
+		perbyte_cpu = percall_cpu = 0;
+		byte_pct = outin_ratio = 100;
+		canCache = false;
 	}
 
 	interpret_AS_clause(languageName, stmt->as, &prosrc_str, &probin_str);
 
-	if (strcmp(languageName, "sql") != 0 && !superuser())
+	if (strcmp(languageName, "sql") != 0 && lanisPL == false && !superuser())
 		elog(WARN,
 			 "Only users with Postgres superuser privilege are permitted "
 			 "to create a function "
-			 "in the '%s' language.  Others may use the 'sql' language.",
+			 "in the '%s' language.  Others may use the 'sql' language "
+			 "or the created procedural languages.",
 			 languageName);
 	/* Above does not return. */
 	else

src/backend/commands/proclang.c

+/*-------------------------------------------------------------------------
+ *
+ * proclang.c--
+ *	  PostgreSQL PROCEDURAL LANGUAGE support code.
+ *
+ *-------------------------------------------------------------------------
+ */
+#include <ctype.h>
+#include <string.h>
+#include "postgres.h"
+
+#include "access/heapam.h"
+#include "catalog/catname.h"
+#include "catalog/pg_user.h"
+#include "catalog/pg_proc.h"
+#include "catalog/pg_language.h"
+#include "utils/syscache.h"
+#include "commands/proclang.h"
+#include "fmgr.h"
+
+
+static void
+case_translate_language_name(const char *input, char *output)
+{
+/*-------------------------------------------------------------------------
+  Translate the input language name to lower case, except if it's C,
+  translate to upper case.
+--------------------------------------------------------------------------*/
+	int			i;
+
+	for (i = 0; i < NAMEDATALEN && input[i] != '\0'; ++i)
+		output[i] = tolower(input[i]);
+
+	output[i] = '\0';
+
+	if (strcmp(output, "c") == 0)
+		output[0] = 'C';
+}
+
+
+/* ---------------------------------------------------------------------
+ * CREATE PROCEDURAL LANGUAGE
+ * ---------------------------------------------------------------------
+ */
+void
+CreateProceduralLanguage(CreatePLangStmt * stmt)
+{
+	char		languageName[NAMEDATALEN];
+	HeapTuple	langTup;
+	HeapTuple	procTup;
+
+	Oid			typev[8];
+	char		nulls[Natts_pg_language];
+	Datum		values[Natts_pg_language];
+	Relation	rdesc;
+	HeapTuple	tup;
+	TupleDesc	tupDesc;
+
+	int			i;
+
+	/* ----------------
+	 * Check permission
+	 * ----------------
+	 */
+	if (!superuser())
+	{
+		elog(WARN, "Only users with Postgres superuser privilege are "
+			 "permitted to create procedural languages");
+	}
+
+	/* ----------------
+	 * Translate the language name and check that
+	 * this language doesn't already exist
+	 * ----------------
+	 */
+	case_translate_language_name(stmt->plname, languageName);
+
+	langTup = SearchSysCacheTuple(LANNAME,
+								  PointerGetDatum(languageName),
+								  0, 0, 0);
+	if (HeapTupleIsValid(langTup))
+	{
+		elog(WARN, "Language %s already exists", languageName);
+	}
+
+	/* ----------------
+	 * Lookup the PL handler function and check that it is
+	 * of return type Opaque
+	 * ----------------
+	 */
+	memset(typev, 0, sizeof(typev));
+	procTup = SearchSysCacheTuple(PRONAME,
+								  PointerGetDatum(stmt->plhandler),
+								  UInt16GetDatum(0),
+								  PointerGetDatum(typev),
+								  0);
+	if (!HeapTupleIsValid(procTup))
+	{
+		elog(WARN, "PL handler function %s() doesn't exist",
+			 stmt->plhandler);
+	}
+	if (((Form_pg_proc) GETSTRUCT(procTup))->prorettype != InvalidOid)
+	{
+		elog(WARN, "PL handler function %s() isn't of return type Opaque",
+			 stmt->plhandler);
+	}
+
+	/* ----------------
+	 * Insert the new language into pg_language
+	 * ----------------
+	 */
+	for (i = 0; i < Natts_pg_language; i++)
+	{
+		nulls[i] = ' ';
+		values[i] = (Datum) NULL;
+	}
+
+	i = 0;
+	values[i++] = PointerGetDatum(languageName);
+	values[i++] = Int8GetDatum((bool) 1);
+	values[i++] = Int8GetDatum(stmt->pltrusted);
+	values[i++] = ObjectIdGetDatum(procTup->t_oid);
+	values[i++] = (Datum) fmgr(TextInRegProcedure, stmt->plcompiler);
+
+	rdesc = heap_openr(LanguageRelationName);
+
+	tupDesc = rdesc->rd_att;
+	tup = heap_formtuple(tupDesc, values, nulls);
+
+	heap_insert(rdesc, tup);
+
+	heap_close(rdesc);
+	return;
+}
+
+
+/* ---------------------------------------------------------------------
+ * DROP PROCEDURAL LANGUAGE
+ * ---------------------------------------------------------------------
+ */
+void
+DropProceduralLanguage(DropPLangStmt * stmt)
+{
+	char		languageName[NAMEDATALEN];
+	HeapTuple	langTup;
+
+	Relation	rdesc;
+	HeapScanDesc scanDesc;
+	ScanKeyData scanKeyData;
+	HeapTuple	tup;
+
+	/* ----------------
+	 * Check permission
+	 * ----------------
+	 */
+	if (!superuser())
+	{
+		elog(WARN, "Only users with Postgres superuser privilege are "
+			 "permitted to drop procedural languages");
+	}
+
+	/* ----------------
+	 * Translate the language name, check that
+	 * this language exist and is a PL
+	 * ----------------
+	 */
+	case_translate_language_name(stmt->plname, languageName);
+
+	langTup = SearchSysCacheTuple(LANNAME,
+								  PointerGetDatum(languageName),
+								  0, 0, 0);
+	if (!HeapTupleIsValid(langTup))
+	{
+		elog(WARN, "Language %s doesn't exist", languageName);
+	}
+
+	if (!((Form_pg_language) GETSTRUCT(langTup))->lanispl)
+	{
+		elog(WARN, "Language %s isn't a created procedural language",
+			 languageName);
+	}
+
+	/* ----------------
+	 * Now scan pg_language and delete the PL tuple
+	 * ----------------
+	 */
+	rdesc = heap_openr(LanguageRelationName);
+
+	ScanKeyEntryInitialize(&scanKeyData, 0, Anum_pg_language_lanname,
+						   F_NAMEEQ, PointerGetDatum(languageName));
+
+	scanDesc = heap_beginscan(rdesc, 0, NowTimeQual, 1, &scanKeyData);
+
+	tup = heap_getnext(scanDesc, 0, (Buffer *) NULL);
+
+	if (!HeapTupleIsValid(tup))
+	{
+		elog(WARN, "Language with name '%s' not found", languageName);
+	}
+
+	heap_delete(rdesc, &(tup->t_ctid));
+
+	heap_endscan(scanDesc);
+	heap_close(rdesc);
+}

src/backend/commands/trigger.c

@@ -26,11 +26,11 @@
 #include "utils/mcxt.h"
 #include "utils/inval.h"
 #include "utils/builtins.h"
+#include "utils/syscache.h"
 
 #ifndef NO_SECURITY
 #include "miscadmin.h"
 #include "utils/acl.h"
-#include "utils/syscache.h"
 #endif
 
 TriggerData *CurrentTriggerData = NULL;
@@ -87,8 +87,8 @@ CreateTrigger(CreateTrigStmt * stmt)
 	if (stmt->row)
 		TRIGGER_SETT_ROW(tgtype);
 	else
-		elog (WARN, "CreateTrigger: STATEMENT triggers are unimplemented, yet");
-	
+		elog(WARN, "CreateTrigger: STATEMENT triggers are unimplemented, yet");
+
 	for (i = 0; i < 3 && stmt->actions[i]; i++)
 	{
 		switch (stmt->actions[i])
@@ -142,7 +142,22 @@ CreateTrigger(CreateTrigStmt * stmt)
 		elog(WARN, "CreateTrigger: function %s () does not exist", stmt->funcname);
 
 	if (((Form_pg_proc) GETSTRUCT(tuple))->prolang != ClanguageId)
-		elog(WARN, "CreateTrigger: only C functions are supported");
+	{
+		HeapTuple	langTup;
+
+		langTup = SearchSysCacheTuple(LANOID,
+			ObjectIdGetDatum(((Form_pg_proc) GETSTRUCT(tuple))->prolang),
+									  0, 0, 0);
+		if (!HeapTupleIsValid(langTup))
+		{
+			elog(WARN, "CreateTrigger: cache lookup for PL failed");
+		}
+
+		if (((Form_pg_language) GETSTRUCT(langTup))->lanispl == false)
+		{
+			elog(WARN, "CreateTrigger: only C and PL functions are supported");
+		}
+	}
 
 	MemSet(nulls, ' ', Natts_pg_trigger * sizeof(char));
 
@@ -159,10 +174,10 @@ CreateTrigger(CreateTrigStmt * stmt)
 
 		foreach(le, stmt->args)
 		{
-			char   *ar = (char *) lfirst(le);
+			char	   *ar = (char *) lfirst(le);
 
 			len += strlen(ar) + 4;
-			for ( ; *ar; ar++)
+			for (; *ar; ar++)
 			{
 				if (*ar == '\\')
 					len++;
@@ -172,9 +187,9 @@ CreateTrigger(CreateTrigStmt * stmt)
 		args[0] = 0;
 		foreach(le, stmt->args)
 		{
-			char   *s = (char *) lfirst(le);
-			char   *d = args + strlen(args);
-			
+			char	   *s = (char *) lfirst(le);
+			char	   *d = args + strlen(args);
+
 			while (*s)
 			{
 				if (*s == '\\')
@@ -399,6 +414,7 @@ RelationBuildTriggers(Relation relation)
 		build->tgname = nameout(&(pg_trigger->tgname));
 		build->tgfoid = pg_trigger->tgfoid;
 		build->tgfunc = NULL;
+		build->tgplfunc = NULL;
 		build->tgtype = pg_trigger->tgtype;
 		build->tgnargs = pg_trigger->tgnargs;
 		memcpy(build->tgattr, &(pg_trigger->tgattr), 8 * sizeof(int16));
@@ -578,6 +594,54 @@ DescribeTrigger(TriggerDesc * trigdesc, Trigger * trigger)
 
 }
 
+static HeapTuple
+ExecCallTriggerFunc(Trigger * trigger)
+{
+
+	if (trigger->tgfunc != NULL)
+	{
+		return (HeapTuple) ((*(trigger->tgfunc)) ());
+	}
+
+	if (trigger->tgplfunc == NULL)
+	{
+		HeapTuple	procTuple;
+		HeapTuple	langTuple;
+		Form_pg_proc procStruct;
+		Form_pg_language langStruct;
+		int			nargs;
+
+		procTuple = SearchSysCacheTuple(PROOID,
+										ObjectIdGetDatum(trigger->tgfoid),
+										0, 0, 0);
+		if (!HeapTupleIsValid(procTuple))
+		{
+			elog(WARN, "ExecCallTriggerFunc(): Cache lookup for proc %ld failed",
+				 ObjectIdGetDatum(trigger->tgfoid));
+		}
+		procStruct = (Form_pg_proc) GETSTRUCT(procTuple);
+
+		langTuple = SearchSysCacheTuple(LANOID,
+								   ObjectIdGetDatum(procStruct->prolang),
+										0, 0, 0);
+		if (!HeapTupleIsValid(langTuple))
+		{
+			elog(WARN, "ExecCallTriggerFunc(): Cache lookup for language %ld failed",
+				 ObjectIdGetDatum(procStruct->prolang));
+		}
+		langStruct = (Form_pg_language) GETSTRUCT(langTuple);
+
+		if (langStruct->lanispl == false)
+		{
+			fmgr_info(trigger->tgfoid, &(trigger->tgfunc), &nargs);
+			return (HeapTuple) ((*(trigger->tgfunc)) ());
+		}
+		fmgr_info(langStruct->lanplcallfoid, &(trigger->tgplfunc), &nargs);
+	}
+
+	return (HeapTuple) ((*(trigger->tgplfunc)) (trigger->tgfoid));
+}
+
 HeapTuple
 ExecBRInsertTriggers(Relation rel, HeapTuple trigtuple)
 {
@@ -586,7 +650,6 @@ ExecBRInsertTriggers(Relation rel, HeapTuple trigtuple)
 	Trigger   **trigger = rel->trigdesc->tg_before_row[TRIGGER_EVENT_INSERT];
 	HeapTuple	newtuple = trigtuple;
 	HeapTuple	oldtuple;
-	int			nargs;
 	int			i;
 
 	SaveTriggerData = (TriggerData *) palloc(sizeof(TriggerData));
@@ -599,9 +662,7 @@ ExecBRInsertTriggers(Relation rel, HeapTuple trigtuple)
 		CurrentTriggerData = SaveTriggerData;
 		CurrentTriggerData->tg_trigtuple = oldtuple = newtuple;
 		CurrentTriggerData->tg_trigger = trigger[i];
-		if (trigger[i]->tgfunc == NULL)
-			fmgr_info(trigger[i]->tgfoid, &(trigger[i]->tgfunc), &nargs);
-		newtuple = (HeapTuple) ((*(trigger[i]->tgfunc)) ());
+		newtuple = ExecCallTriggerFunc(trigger[i]);
 		if (newtuple == NULL)
 			break;
 		else if (oldtuple != newtuple && oldtuple != trigtuple)
@@ -618,7 +679,6 @@ ExecARInsertTriggers(Relation rel, HeapTuple trigtuple)
 	TriggerData *SaveTriggerData;
 	int			ntrigs = rel->trigdesc->n_after_row[TRIGGER_EVENT_INSERT];
 	Trigger   **trigger = rel->trigdesc->tg_after_row[TRIGGER_EVENT_INSERT];
-	int			nargs;
 	int			i;
 
 	SaveTriggerData = (TriggerData *) palloc(sizeof(TriggerData));
@@ -630,9 +690,7 @@ ExecARInsertTriggers(Relation rel, HeapTuple trigtuple)
 		CurrentTriggerData = SaveTriggerData;
 		CurrentTriggerData->tg_trigtuple = trigtuple;
 		CurrentTriggerData->tg_trigger = trigger[i];
-		if (trigger[i]->tgfunc == NULL)
-			fmgr_info(trigger[i]->tgfoid, &(trigger[i]->tgfunc), &nargs);
-		(void) ((*(trigger[i]->tgfunc)) ());
+		ExecCallTriggerFunc(trigger[i]);
 	}
 	CurrentTriggerData = NULL;
 	pfree(SaveTriggerData);
@@ -647,7 +705,6 @@ ExecBRDeleteTriggers(Relation rel, ItemPointer tupleid)
 	Trigger   **trigger = rel->trigdesc->tg_before_row[TRIGGER_EVENT_DELETE];
 	HeapTuple	trigtuple;
 	HeapTuple	newtuple = NULL;
-	int			nargs;
 	int			i;
 
 	trigtuple = GetTupleForTrigger(rel, tupleid, true);
@@ -664,9 +721,7 @@ ExecBRDeleteTriggers(Relation rel, ItemPointer tupleid)
 		CurrentTriggerData = SaveTriggerData;
 		CurrentTriggerData->tg_trigtuple = trigtuple;
 		CurrentTriggerData->tg_trigger = trigger[i];
-		if (trigger[i]->tgfunc == NULL)
-			fmgr_info(trigger[i]->tgfoid, &(trigger[i]->tgfunc), &nargs);
-		newtuple = (HeapTuple) ((*(trigger[i]->tgfunc)) ());
+		newtuple = ExecCallTriggerFunc(trigger[i]);
 		if (newtuple == NULL)
 			break;
 	}
@@ -684,7 +739,6 @@ ExecARDeleteTriggers(Relation rel, ItemPointer tupleid)
 	int			ntrigs = rel->trigdesc->n_after_row[TRIGGER_EVENT_DELETE];
 	Trigger   **trigger = rel->trigdesc->tg_after_row[TRIGGER_EVENT_DELETE];
 	HeapTuple	trigtuple;
-	int			nargs;
 	int			i;
 
 	trigtuple = GetTupleForTrigger(rel, tupleid, false);
@@ -700,9 +754,7 @@ ExecARDeleteTriggers(Relation rel, ItemPointer tupleid)
 		CurrentTriggerData = SaveTriggerData;
 		CurrentTriggerData->tg_trigtuple = trigtuple;
 		CurrentTriggerData->tg_trigger = trigger[i];
-		if (trigger[i]->tgfunc == NULL)
-			fmgr_info(trigger[i]->tgfoid, &(trigger[i]->tgfunc), &nargs);
-		(void) ((*(trigger[i]->tgfunc)) ());
+		ExecCallTriggerFunc(trigger[i]);
 	}
 	CurrentTriggerData = NULL;
 	pfree(SaveTriggerData);
@@ -719,7 +771,6 @@ ExecBRUpdateTriggers(Relation rel, ItemPointer tupleid, HeapTuple newtuple)
 	HeapTuple	trigtuple;
 	HeapTuple	oldtuple;
 	HeapTuple	intuple = newtuple;
-	int			nargs;
 	int			i;
 
 	trigtuple = GetTupleForTrigger(rel, tupleid, true);
@@ -736,9 +787,7 @@ ExecBRUpdateTriggers(Relation rel, ItemPointer tupleid, HeapTuple newtuple)
 		CurrentTriggerData->tg_trigtuple = trigtuple;
 		CurrentTriggerData->tg_newtuple = oldtuple = newtuple;
 		CurrentTriggerData->tg_trigger = trigger[i];
-		if (trigger[i]->tgfunc == NULL)
-			fmgr_info(trigger[i]->tgfoid, &(trigger[i]->tgfunc), &nargs);
-		newtuple = (HeapTuple) ((*(trigger[i]->tgfunc)) ());
+		newtuple = ExecCallTriggerFunc(trigger[i]);
 		if (newtuple == NULL)
 			break;
 		else if (oldtuple != newtuple && oldtuple != intuple)
@@ -757,7 +806,6 @@ ExecARUpdateTriggers(Relation rel, ItemPointer tupleid, HeapTuple newtuple)
 	int			ntrigs = rel->trigdesc->n_after_row[TRIGGER_EVENT_UPDATE];
 	Trigger   **trigger = rel->trigdesc->tg_after_row[TRIGGER_EVENT_UPDATE];
 	HeapTuple	trigtuple;
-	int			nargs;
 	int			i;
 
 	trigtuple = GetTupleForTrigger(rel, tupleid, false);
@@ -773,9 +821,7 @@ ExecARUpdateTriggers(Relation rel, ItemPointer tupleid, HeapTuple newtuple)
 		CurrentTriggerData->tg_trigtuple = trigtuple;
 		CurrentTriggerData->tg_newtuple = newtuple;
 		CurrentTriggerData->tg_trigger = trigger[i];
-		if (trigger[i]->tgfunc == NULL)
-			fmgr_info(trigger[i]->tgfoid, &(trigger[i]->tgfunc), &nargs);
-		(void) ((*(trigger[i]->tgfunc)) ());
+		ExecCallTriggerFunc(trigger[i]);
 	}
 	CurrentTriggerData = NULL;
 	pfree(SaveTriggerData);

src/backend/parser/gram.y

@@ -10,7 +10,7 @@
  *
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/backend/parser/gram.y,v 1.58 1997/10/25 05:56:41 thomas Exp $
+ *	  $Header: /cvsroot/pgsql/src/backend/parser/gram.y,v 1.59 1997/10/28 14:56:08 vadim Exp $
  *
  * HISTORY
  *	  AUTHOR			DATE			MAJOR EVENT
@@ -109,6 +109,7 @@ static char *FlattenStringList(List *list);
 		AddAttrStmt, ClosePortalStmt,
 		CopyStmt, CreateStmt, CreateSeqStmt, DefineStmt, DestroyStmt,
 		ExtendStmt, FetchStmt,	GrantStmt, CreateTrigStmt, DropTrigStmt,
+		CreatePLangStmt, DropPLangStmt,
 		IndexStmt, ListenStmt, OptimizableStmt,
 		ProcedureStmt, PurgeStmt,
 		RecipeStmt, RemoveAggrStmt, RemoveOperStmt, RemoveFuncStmt, RemoveStmt,
@@ -119,7 +120,7 @@ static char *FlattenStringList(List *list);
 
 %type <node>	SubSelect
 %type <str>		join_expr, join_outer, join_spec
-%type <boolean> TriggerActionTime, TriggerForSpec
+%type <boolean> TriggerActionTime, TriggerForSpec, PLangTrusted
 
 %type <str>		TriggerEvents, TriggerFuncArg
 
@@ -225,9 +226,9 @@ static char *FlattenStringList(List *list);
 /* Keywords (in SQL92 reserved words) */
 %token	ACTION, ADD, ALL, ALTER, AND, AS, ASC,
 		BEGIN_TRANS, BETWEEN, BOTH, BY,
-		CASCADE, CAST, CHAR, CHARACTER, CHECK, CLOSE,
-		COLLATE, COLUMN, COMMIT, CONSTRAINT, CREATE, CROSS,
-		CURRENT, CURRENT_DATE, CURRENT_TIME, CURRENT_TIMESTAMP, CURRENT_USER, CURSOR,
+		CASCADE, CAST, CHAR, CHARACTER, CHECK, CLOSE, COLLATE, COLUMN, COMMIT, 
+		CONSTRAINT, CREATE, CROSS, CURRENT, CURRENT_DATE, CURRENT_TIME, 
+		CURRENT_TIMESTAMP, CURRENT_USER, CURSOR,
 		DAY_P, DECIMAL, DECLARE, DEFAULT, DELETE, DESC, DISTINCT, DOUBLE, DROP,
 		END_TRANS, EXECUTE, EXISTS, EXTRACT,
 		FETCH, FLOAT, FOR, FOREIGN, FROM, FULL,
@@ -256,12 +257,12 @@ static char *FlattenStringList(List *list);
 		APPEND, ARCHIVE, ARCH_STORE,
 		BACKWARD, BEFORE, BINARY, CHANGE, CLUSTER, COPY,
 		DATABASE, DELIMITERS, DO, EXPLAIN, EXTEND,
-		FORWARD, FUNCTION, HEAVY,
+		FORWARD, FUNCTION, HANDLER, HEAVY,
 		INDEX, INHERITS, INSTEAD, ISNULL,
-		LIGHT, LISTEN, LOAD, MERGE, MOVE,
-		NEW, NONE, NOTHING, OIDS, OPERATOR, PURGE,
+		LANCOMPILER, LIGHT, LISTEN, LOAD, MERGE, MOVE,
+		NEW, NONE, NOTHING, OIDS, OPERATOR, PROCEDURAL, PURGE,
 		RECIPE, RENAME, REPLACE, RESET, RETRIEVE, RETURNS, RULE,
-		SEQUENCE, SETOF, SHOW, STDIN, STDOUT, STORE,
+		SEQUENCE, SETOF, SHOW, STDIN, STDOUT, STORE, TRUSTED, 
 		VACUUM, VERBOSE, VERSION
 
 /* Special keywords, not in the query language - see the "lex" file */
@@ -318,10 +319,12 @@ stmt :	  AddAttrStmt
 		| CopyStmt
 		| CreateStmt
 		| CreateSeqStmt
+		| CreatePLangStmt
 		| CreateTrigStmt
 		| ClusterStmt
 		| DefineStmt
 		| DestroyStmt
+		| DropPLangStmt
 		| DropTrigStmt
 		| ExtendStmt
 		| ExplainStmt
@@ -857,6 +860,36 @@ OptSeqElem:		IDENT NumConst
 				}
 		;
 
+/*****************************************************************************
+ *
+ *		QUERIES :
+ *				CREATE PROCEDURAL LANGUAGE ...
+ *				DROP PROCEDURAL LANGUAGE ...
+ *
+ *****************************************************************************/
+
+CreatePLangStmt: CREATE PLangTrusted PROCEDURAL LANGUAGE Sconst 
+			HANDLER def_name LANCOMPILER Sconst
+			{
+				CreatePLangStmt *n = makeNode(CreatePLangStmt);
+				n->plname = $5;
+				n->plhandler = $7;
+				n->plcompiler = $9;
+				n->pltrusted = $2;
+				$$ = (Node *)n;
+			}
+		;
+
+PLangTrusted:		TRUSTED { $$ = TRUE; }
+			|	{ $$ = FALSE; }
+
+DropPLangStmt: DROP PROCEDURAL LANGUAGE Sconst
+			{
+				DropPLangStmt *n = makeNode(DropPLangStmt);
+				n->plname = $4;
+				$$ = (Node *)n;
+			}
+		;
 
 /*****************************************************************************
  *

src/backend/parser/keywords.c

@@ -7,7 +7,7 @@
  *
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/backend/parser/keywords.c,v 1.20 1997/10/25 05:44:11 thomas Exp $
+ *	  $Header: /cvsroot/pgsql/src/backend/parser/keywords.c,v 1.21 1997/10/28 14:56:10 vadim Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -104,6 +104,7 @@ static ScanKeyword ScanKeywords[] = {
 	{"function", FUNCTION},
 	{"grant", GRANT},
 	{"group", GROUP},
+	{"handler", HANDLER},
 	{"having", HAVING},
 	{"heavy", HEAVY},
 	{"hour", HOUR_P},
@@ -119,6 +120,7 @@ static ScanKeyword ScanKeywords[] = {
 	{"isnull", ISNULL},
 	{"join", JOIN},
 	{"key", KEY},
+	{"lancompiler", LANCOMPILER},
 	{"language", LANGUAGE},
 	{"leading", LEADING},
 	{"left", LEFT},
@@ -156,6 +158,7 @@ static ScanKeyword ScanKeywords[] = {
 	{"precision", PRECISION},
 	{"primary", PRIMARY},
 	{"privileges", PRIVILEGES},
+	{"procedural", PROCEDURAL},
 	{"procedure", PROCEDURE},
 	{"public", PUBLIC},
 	{"purge", PURGE},
@@ -188,6 +191,7 @@ static ScanKeyword ScanKeywords[] = {
 	{"trigger", TRIGGER},
 	{"trim", TRIM},
 	{"true", TRUE_P},
+	{"trusted", TRUSTED},
 	{"type", TYPE_P},
 	{"union", UNION},
 	{"unique", UNIQUE},

src/backend/tcop/utility.c

@@ -9,7 +9,7 @@
  *
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/backend/tcop/utility.c,v 1.26 1997/10/25 05:34:07 thomas Exp $
+ *	  $Header: /cvsroot/pgsql/src/backend/tcop/utility.c,v 1.27 1997/10/28 14:57:24 vadim Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -35,6 +35,7 @@
 #include "commands/recipe.h"
 #include "commands/explain.h"
 #include "commands/trigger.h"
+#include "commands/proclang.h"
 
 #include "nodes/parsenodes.h"
 #include "../backend/parser/parse.h"
@@ -75,7 +76,7 @@
  * ----------------
  */
 void
-ProcessUtility(Node *parsetree,
+ProcessUtility(Node * parsetree,
 			   CommandDest dest)
 {
 	char	   *commandTag = NULL;
@@ -149,8 +150,8 @@ ProcessUtility(Node *parsetree,
 				 */
 
 				count = stmt->howMany;
-				PerformPortalFetch(portalName, forward, count, commandTag, 
-					(stmt->ismove) ? None : dest);	/* /dev/null for MOVE */
+				PerformPortalFetch(portalName, forward, count, commandTag,
+								   (stmt->ismove) ? None : dest);		/* /dev/null for MOVE */
 			}
 			break;
 
@@ -718,6 +719,23 @@ ProcessUtility(Node *parsetree,
 			DropTrigger((DropTrigStmt *) parsetree);
 			break;
 
+			/*
+			 * ************* PROCEDURAL LANGUAGE statements *****************
+			 */
+		case T_CreatePLangStmt:
+			commandTag = "CREATE";
+			CHECK_IF_ABORTED();
+
+			CreateProceduralLanguage((CreatePLangStmt *) parsetree);
+			break;
+
+		case T_DropPLangStmt:
+			commandTag = "DROP";
+			CHECK_IF_ABORTED();
+
+			DropProceduralLanguage((DropPLangStmt *) parsetree);
+			break;
+
 			/*
 			 * ******************************** default ********************************
 			 *

src/backend/utils/Gen_fmgrtab.sh.in

@@ -8,7 +8,7 @@
 #
 #
 # IDENTIFICATION
-#    $Header: /cvsroot/pgsql/src/backend/utils/Attic/Gen_fmgrtab.sh.in,v 1.4 1997/07/28 00:55:41 momjian Exp $
+#    $Header: /cvsroot/pgsql/src/backend/utils/Attic/Gen_fmgrtab.sh.in,v 1.5 1997/10/28 15:02:24 vadim Exp $
 #
 # NOTES
 #    Passes any -D options on to cpp prior to generating the list
@@ -81,7 +81,7 @@ cat > $HFILE <<FuNkYfMgRsTuFf
  *
  * Copyright (c) 1994, Regents of the University of California
  *
- * $Id: Gen_fmgrtab.sh.in,v 1.4 1997/07/28 00:55:41 momjian Exp $
+ * $Id: Gen_fmgrtab.sh.in,v 1.5 1997/10/28 15:02:24 vadim Exp $
  *
  * NOTES
  *	******************************
@@ -114,6 +114,8 @@ typedef struct {
 /*
  * defined in fmgr.c
  */
+extern char *fmgr_pl(Oid func_id, int n_arguments, FmgrValues *values,
+	bool *isNull);
 extern char *fmgr_c(func_ptr user_fn, Oid func_id, int n_arguments,
 	FmgrValues *values, bool *isNull);
 extern void fmgr_info(Oid procedureId, func_ptr *function, int *nargs);
@@ -175,7 +177,7 @@ cat > $TABCFILE <<FuNkYfMgRtAbStUfF
  *
  *
  * IDENTIFICATION
- *    $Header: /cvsroot/pgsql/src/backend/utils/Attic/Gen_fmgrtab.sh.in,v 1.4 1997/07/28 00:55:41 momjian Exp $
+ *    $Header: /cvsroot/pgsql/src/backend/utils/Attic/Gen_fmgrtab.sh.in,v 1.5 1997/10/28 15:02:24 vadim Exp $
  *
  * NOTES
  *

src/backend/utils/cache/syscache.c

@@ -7,7 +7,7 @@
  *
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/backend/utils/cache/syscache.c,v 1.9 1997/09/18 20:22:25 momjian Exp $
+ *	  $Header: /cvsroot/pgsql/src/backend/utils/cache/syscache.c,v 1.10 1997/10/28 15:03:06 vadim Exp $
  *
  * NOTES
  *	  These routines allow the parser/planner/executor to perform
@@ -57,7 +57,7 @@ extern bool AMI_OVERRIDE;		/* XXX style */
 #include "utils/syscache.h"
 #include "catalog/indexing.h"
 
-typedef HeapTuple (*ScanFunc) ();
+typedef		HeapTuple(*ScanFunc) ();
 
 /* ----------------
  *		Warning:  cacheinfo[] below is changed, then be sure and
@@ -179,7 +179,7 @@ static struct cachedesc cacheinfo[] = {
 			0,
 			0,
 		0},
-		offsetof(TypeTupleFormData, typalign) +sizeof(char),
+		offsetof(TypeTupleFormData, typalign) + sizeof(char),
 		TypeNameIndex,
 	TypeNameIndexScan},
 	{TypeRelationName,			/* TYPOID */
@@ -316,7 +316,16 @@ static struct cachedesc cacheinfo[] = {
 		0},
 		sizeof(FormData_pg_opclass),
 		NULL,
-	(ScanFunc) NULL}
+	(ScanFunc) NULL},
+	{LanguageRelationName,		/* LANOID */
+		1,
+		{ObjectIdAttributeNumber,
+			0,
+			0,
+		0},
+		offsetof(FormData_pg_language, lancompiler),
+		NULL,
+	NULL}
 };
 
 static struct catcache *SysCache[
@@ -383,7 +392,7 @@ InitCatalogCache()
  * XXX The tuple that is returned is NOT supposed to be pfree'd!
  */
 HeapTuple
-SearchSysCacheTuple(int cacheId,/* cache selection code */
+SearchSysCacheTuple(int cacheId,		/* cache selection code */
 					Datum key1,
 					Datum key2,
 					Datum key3,
@@ -562,7 +571,7 @@ SearchSysCacheGetAttribute(int cacheId,
 		: attributeLength;		/* fixed length */
 
 		tmp = (char *) palloc(size);
-		memmove(tmp, (void *)attributeValue, size);
+		memmove(tmp, (void *) attributeValue, size);
 		returnValue = (void *) tmp;
 	}
 

src/backend/utils/fmgr/fmgr.c

@@ -7,7 +7,7 @@
  *
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/backend/utils/fmgr/fmgr.c,v 1.6 1997/09/08 21:49:07 momjian Exp $
+ *	  $Header: /cvsroot/pgsql/src/backend/utils/fmgr/fmgr.c,v 1.7 1997/10/28 15:05:32 vadim Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -28,13 +28,69 @@
 
 #include "utils/elog.h"
 
+#include "nodes/parsenodes.h"
+#include "commands/trigger.h"
+
+
+char	   *
+fmgr_pl(Oid func_id,
+		int n_arguments,
+		FmgrValues * values,
+		bool * isNull)
+{
+	HeapTuple	procedureTuple;
+	HeapTuple	languageTuple;
+	Form_pg_proc procedureStruct;
+	Form_pg_language languageStruct;
+	func_ptr	plcall_fn;
+	int			plcall_nargs;
+
+	/* Fetch the pg_proc tuple from the syscache */
+	procedureTuple = SearchSysCacheTuple(PROOID,
+										 ObjectIdGetDatum(func_id),
+										 0, 0, 0);
+	if (!HeapTupleIsValid(procedureTuple))
+	{
+		elog(WARN, "fmgr_pl(): Cache lookup of procedure %ld failed.",
+			 ObjectIdGetDatum(func_id));
+	}
+	procedureStruct = (Form_pg_proc) GETSTRUCT(procedureTuple);
+
+	/* Fetch the pg_language tuple from the syscache */
+	languageTuple = SearchSysCacheTuple(LANOID,
+							  ObjectIdGetDatum(procedureStruct->prolang),
+										0, 0, 0);
+	if (!HeapTupleIsValid(languageTuple))
+	{
+		elog(WARN, "fmgr_pl(): Cache lookup of language %ld for procedure %ld failed.",
+			 ObjectIdGetDatum(procedureStruct->prolang),
+			 ObjectIdGetDatum(func_id));
+	}
+	languageStruct = (Form_pg_language) GETSTRUCT(languageTuple);
+
+	/* Get the function pointer for the PL call handler */
+	fmgr_info(languageStruct->lanplcallfoid, &plcall_fn, &plcall_nargs);
+	if (plcall_fn == NULL)
+	{
+		elog(WARN, "fmgr_pl(): failed to load PL handler for procedure %ld.",
+			 ObjectIdGetDatum(func_id));
+	}
+
+	/* Call the PL handler */
+	CurrentTriggerData = NULL;
+	return (*plcall_fn) (func_id,
+						 n_arguments,
+						 values,
+						 isNull);
+}
+
 
 char	   *
 fmgr_c(func_ptr user_fn,
 	   Oid func_id,
 	   int n_arguments,
-	   FmgrValues *values,
-	   bool *isNull)
+	   FmgrValues * values,
+	   bool * isNull)
 {
 	char	   *returnValue = (char *) NULL;
 
@@ -43,11 +99,11 @@ fmgr_c(func_ptr user_fn,
 	{
 
 		/*
-		 * a NULL func_ptr denotes untrusted function (in postgres 4.2).
-		 * Untrusted functions have very limited use and is clumsy. We
-		 * just get rid of it.
+		 * a NULL func_ptr denotet untrusted function (in postgres 4.2).
+		 * Untrusted functions have very limited use and is clumsy. We now
+		 * use this feature for procedural languages.
 		 */
-		elog(WARN, "internal error: untrusted function not supported.");
+		return fmgr_pl(func_id, n_arguments, values, isNull);
 	}
 
 	switch (n_arguments)
@@ -115,12 +171,14 @@ fmgr_c(func_ptr user_fn,
 }
 
 void
-fmgr_info(Oid procedureId, func_ptr *function, int *nargs)
+fmgr_info(Oid procedureId, func_ptr * function, int *nargs)
 {
 	func_ptr	user_fn = NULL;
 	FmgrCall   *fcp;
 	HeapTuple	procedureTuple;
 	FormData_pg_proc *procedureStruct;
+	HeapTuple	languageTuple;
+	Form_pg_language languageStruct;
 	Oid			language;
 
 	if (!(fcp = fmgr_isbuiltin(procedureId)))
@@ -158,8 +216,35 @@ fmgr_info(Oid procedureId, func_ptr *function, int *nargs)
 				*nargs = procedureStruct->pronargs;
 				break;
 			default:
-				elog(WARN, "fmgr_info: function %d: unknown language %d",
-					 procedureId, language);
+
+				/*
+				 * Might be a created procedural language Lookup the
+				 * syscache for the language and check the lanispl flag If
+				 * this is the case, we return a NULL function pointer and
+				 * the number of arguments from the procedure.
+				 */
+				languageTuple = SearchSysCacheTuple(LANOID,
+							  ObjectIdGetDatum(procedureStruct->prolang),
+													0, 0, 0);
+				if (!HeapTupleIsValid(languageTuple))
+				{
+					elog(WARN, "fmgr_info: %s %ld",
+						 "Cache lookup for language %d failed",
+						 ObjectIdGetDatum(procedureStruct->prolang));
+				}
+				languageStruct = (Form_pg_language)
+					GETSTRUCT(languageTuple);
+				if (languageStruct->lanispl)
+				{
+					user_fn = (func_ptr) NULL;
+					*nargs = procedureStruct->pronargs;
+				}
+				else
+				{
+					elog(WARN, "fmgr_info: function %d: unknown language %d",
+						 procedureId, language);
+				}
+				break;
 		}
 	}
 	else
@@ -252,7 +337,7 @@ fmgr_ptr(func_ptr user_fn, Oid func_id,...)
  * to fmgr_c().
  */
 char	   *
-fmgr_array_args(Oid procedureId, int nargs, char *args[], bool *isNull)
+fmgr_array_args(Oid procedureId, int nargs, char *args[], bool * isNull)
 {
 	func_ptr	user_fn;
 	int			true_arguments;

src/include/catalog/pg_language.h

@@ -7,7 +7,7 @@
  *
  * Copyright (c) 1994, Regents of the University of California
  *
- * $Id: pg_language.h,v 1.4 1997/09/08 02:35:16 momjian Exp $
+ * $Id: pg_language.h,v 1.5 1997/10/28 15:08:05 vadim Exp $
  *
  * NOTES
  *	  the genbki.sh script reads this file and generates .bki
@@ -33,6 +33,9 @@
 CATALOG(pg_language)
 {
 	NameData	lanname;
+	bool		lanispl;		/* Is a procedural language */
+	bool		lanpltrusted;	/* PL is trusted */
+	Oid			lanplcallfoid;	/* Call handler for PL */
 	text		lancompiler;	/* VARIABLE LENGTH FIELD */
 } FormData_pg_language;
 
@@ -47,21 +50,24 @@ typedef FormData_pg_language *Form_pg_language;
  *		compiler constants for pg_language
  * ----------------
  */
-#define Natts_pg_language				2
+#define Natts_pg_language				5
 #define Anum_pg_language_lanname		1
-#define Anum_pg_language_lancompiler	2
+#define Anum_pg_language_lanispl		2
+#define Anum_pg_language_lanpltrusted		3
+#define Anum_pg_language_lanplcallfoid		4
+#define Anum_pg_language_lancompiler		5
 
 /* ----------------
  *		initial contents of pg_language
  * ----------------
  */
 
-DATA(insert OID = 11 ( internal "n/a" ));
+DATA(insert OID = 11 ( internal f 0 0 "n/a" ));
 #define INTERNALlanguageId 11
-DATA(insert OID = 12 ( lisp "/usr/ucb/liszt" ));
-DATA(insert OID = 13 ( "C" "/bin/cc" ));
+DATA(insert OID = 12 ( lisp f 0 0 "/usr/ucb/liszt" ));
+DATA(insert OID = 13 ( "C" f 0 0 "/bin/cc" ));
 #define ClanguageId 13
-DATA(insert OID = 14 ( "sql" "postgres"));
+DATA(insert OID = 14 ( "sql" f 0 0 "postgres"));
 #define SQLlanguageId 14
 
 

src/include/commands/proclang.h

+/*-------------------------------------------------------------------------
+ *
+ * proclang.h--
+ *	  prototypes for proclang.c.
+ *
+ *
+ *-------------------------------------------------------------------------
+ */
+#ifndef PROCLANG_H
+#define PROCLANG_H
+
+#include <nodes/parsenodes.h>
+
+extern void CreateProceduralLanguage(CreatePLangStmt * stmt);
+extern void DropProceduralLanguage(DropPLangStmt * stmt);
+
+#endif							/* PROCLANG_H */

src/include/nodes/nodes.h

@@ -6,7 +6,7 @@
  *
  * Copyright (c) 1994, Regents of the University of California
  *
- * $Id: nodes.h,v 1.15 1997/09/29 06:01:44 vadim Exp $
+ * $Id: nodes.h,v 1.16 1997/10/28 15:10:37 vadim Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -185,6 +185,8 @@ typedef enum NodeTag
 	T_VariableResetStmt,
 	T_CreateTrigStmt,
 	T_DropTrigStmt,
+	T_CreatePLangStmt,
+	T_DropPLangStmt,
 
 	T_A_Expr = 700,
 	T_Attr,

src/include/utils/rel.h

@@ -6,7 +6,7 @@
  *
  * Copyright (c) 1994, Regents of the University of California
  *
- * $Id: rel.h,v 1.12 1997/09/08 21:55:16 momjian Exp $
+ * $Id: rel.h,v 1.13 1997/10/28 15:11:43 vadim Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -25,6 +25,7 @@ typedef struct Trigger
 	char	   *tgname;
 	Oid			tgfoid;
 	func_ptr	tgfunc;
+	func_ptr	tgplfunc;
 	int16		tgtype;
 	int16		tgnargs;
 	int16		tgattr[8];

src/include/utils/syscache.h

@@ -6,7 +6,7 @@
  *
  * Copyright (c) 1994, Regents of the University of California
  *
- * $Id: syscache.h,v 1.7 1997/09/08 21:55:17 momjian Exp $
+ * $Id: syscache.h,v 1.8 1997/10/28 15:11:45 vadim Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -59,6 +59,7 @@
 #define REWRITENAME		25
 #define PROSRC			26
 #define CLADEFTYPE		27
+#define LANOID			28
 
 /* ----------------
  *		struct cachedesc:		information needed for a call to InitSysCache()