Allow args to spi_prepare to be standard type aliaes as well as those known in pg_typ...

diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index 0e2887e86a34e0c790e4f4597b2c45993ce157a4..7658f36c25d584b813ae1b0320fd0248966bf2e2 100644 (file)
--- a/src/pl/plperl/expected/plperl.out
+++ b/src/pl/plperl/expected/plperl.out
@@ -438,7 +438,7 @@ SELECT array_of_text();
 -- Test spi_prepare/spi_exec_prepared/spi_freeplan
 --
 CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
-   my $x = spi_prepare('select $1 AS a', 'INT4');
+   my $x = spi_prepare('select $1 AS a', 'INTEGER');
    my $q = spi_exec_prepared( $x, $_[0] + 1);
    spi_freeplan($x);
 return $q->{rows}->[0]->{a};
@@ -468,3 +468,37 @@ SELECT * from perl_spi_prepared_set(1,2);
                      4
 (2 rows)
 
+--
+-- Test prepare with a type with spaces
+--
+CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$
+  my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION');
+  my $q = spi_query_prepared($x,$_[0]);
+  my $result;
+  while (defined (my $y = spi_fetchrow($q))) {
+      $result = $y->{a};
+  }
+  spi_freeplan($x);
+  return $result;
+$$ LANGUAGE plperl;
+SELECT perl_spi_prepared_double(4.35) as "double precision";
+ double precision 
+------------------
+             43.5
+(1 row)
+
+--
+-- Test with a bad type
+--
+CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$
+  my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist');
+  my $q = spi_query_prepared($x,$_[0]);
+  my $result;
+  while (defined (my $y = spi_fetchrow($q))) {
+      $result = $y->{a};
+  }
+  spi_freeplan($x);
+  return $result;
+$$ LANGUAGE plperl;
+SELECT perl_spi_prepared_bad(4.35) as "double precision";
+ERROR:  error from Perl function: type "does_not_exist" does not exist at line 2.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index e0bbe8fbabf1b1d23db63ddf7e153300e1773f06..303024dd70d893300b25736579d70655a8c5fcce 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1,7 +1,7 @@
 /**********************************************************************
  * plperl.c - perl as a procedural language for PostgreSQL
  *
- *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.123 2006/11/21 16:59:02 adunstan Exp $
+ *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.124 2007/01/27 01:55:57 adunstan Exp $
  *
  **********************************************************************/
 
@@ -2128,23 +2128,23 @@ plperl_spi_prepare(char *query, int argc, SV **argv)
        PG_TRY();
        {
                /************************************************************
-                * Lookup the argument types by name in the system cache
-                * and remember the required information for input conversion
+                * Resolve argument type names and then look them up by oid 
+         * in the system cache, and remember the required information 
+         * for input conversion.
                 ************************************************************/
                for (i = 0; i < argc; i++)
                {
-                       List       *names;
-                       HeapTuple       typeTup;
-
-                       /* Parse possibly-qualified type name and look it up in pg_type */
-                       names = stringToQualifiedNameList(SvPV(argv[i], PL_na),
-                                                                                         "plperl_spi_prepare");
-                       typeTup = typenameType(NULL, makeTypeNameFromNameList(names));
-                       qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
-                       perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
+                       Oid         typId, typInput, typIOParam;
+            int32       typmod;
+
+                       parseTypeString(SvPV(argv[i], PL_na), &typId, &typmod);
+
+                       getTypeInputInfo(typId, &typInput, &typIOParam);
+
+                       qdesc->argtypes[i] = typId;
+                       perm_fmgr_info((Form_pg_type) typInput,
                                                   &(qdesc->arginfuncs[i]));
-                       qdesc->argtypioparams[i] = getTypeIOParam(typeTup);
-                       ReleaseSysCache(typeTup);
+                       qdesc->argtypioparams[i] = typIOParam;
                }
 
                /************************************************************

diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql
index e312cd24dc07eadbbbd9663256efde1657708088..4d4348a1f6af5872475c62e77b0a9b8e64b8bafb 100644 (file)
--- a/src/pl/plperl/sql/plperl.sql
+++ b/src/pl/plperl/sql/plperl.sql
@@ -316,7 +316,7 @@ SELECT array_of_text();
 -- Test spi_prepare/spi_exec_prepared/spi_freeplan
 --
 CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
-   my $x = spi_prepare('select $1 AS a', 'INT4');
+   my $x = spi_prepare('select $1 AS a', 'INTEGER');
    my $q = spi_exec_prepared( $x, $_[0] + 1);
    spi_freeplan($x);
 return $q->{rows}->[0]->{a};
@@ -337,3 +337,33 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF
 $$ LANGUAGE plperl;
 SELECT * from perl_spi_prepared_set(1,2);
 
+--
+-- Test prepare with a type with spaces
+--
+CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$
+  my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION');
+  my $q = spi_query_prepared($x,$_[0]);
+  my $result;
+  while (defined (my $y = spi_fetchrow($q))) {
+      $result = $y->{a};
+  }
+  spi_freeplan($x);
+  return $result;
+$$ LANGUAGE plperl;
+SELECT perl_spi_prepared_double(4.35) as "double precision";
+
+--
+-- Test with a bad type
+--
+CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$
+  my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist');
+  my $q = spi_query_prepared($x,$_[0]);
+  my $result;
+  while (defined (my $y = spi_fetchrow($q))) {
+      $result = $y->{a};
+  }
+  spi_freeplan($x);
+  return $result;
+$$ LANGUAGE plperl;
+SELECT perl_spi_prepared_bad(4.35) as "double precision";
+