I wrote:
Tom Lane wrote:

I think parseTypeString() may be the thing to use.  It's what plpgsql
uses...


OK, I'll see what I can do.


see attached patch. If this is OK I will apply it and also fix pltcl and plpython similarly, mutatis mutandis.

cheers

andrew
Index: src/pl/plperl/plperl.c
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.123
diff -c -r1.123 plperl.c
*** src/pl/plperl/plperl.c	21 Nov 2006 16:59:02 -0000	1.123
--- src/pl/plperl/plperl.c	26 Jan 2007 15:13:05 -0000
***************
*** 2128,2145 ****
  	PG_TRY();
  	{
  		/************************************************************
! 		 * Lookup the argument types by name 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,
  						   &(qdesc->arginfuncs[i]));
--- 2128,2152 ----
  	PG_TRY();
  	{
  		/************************************************************
! 		 * 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++)
  		{
! 			Oid         typeId;
!             int32       typmod;
  			HeapTuple	typeTup;
  
! 			parseTypeString(SvPV(argv[i], PL_na), &typeId, &typmod);
! 
! 			typeTup = SearchSysCache(TYPEOID,
! 									 ObjectIdGetDatum(typeId),
! 									 0,0,0);
! 			if (!HeapTupleIsValid(typeTup))
! 				elog(ERROR, "cache lookup failed for type %u", typeId);
! 
! 			
  			qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
  			perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
  						   &(qdesc->arginfuncs[i]));
Index: src/pl/plperl/expected/plperl.out
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/expected/plperl.out,v
retrieving revision 1.9
diff -c -r1.9 plperl.out
*** src/pl/plperl/expected/plperl.out	13 Aug 2006 17:31:10 -0000	1.9
--- src/pl/plperl/expected/plperl.out	26 Jan 2007 15:13:05 -0000
***************
*** 438,444 ****
  -- 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 $q = spi_exec_prepared( $x, $_[0] + 1);
     spi_freeplan($x);
  return $q->{rows}->[0]->{a};
--- 438,444 ----
  -- 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', 'INTEGER');
     my $q = spi_exec_prepared( $x, $_[0] + 1);
     spi_freeplan($x);
  return $q->{rows}->[0]->{a};
***************
*** 468,470 ****
--- 468,504 ----
                       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.
Index: src/pl/plperl/sql/plperl.sql
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/sql/plperl.sql,v
retrieving revision 1.11
diff -c -r1.11 plperl.sql
*** src/pl/plperl/sql/plperl.sql	13 Aug 2006 17:31:10 -0000	1.11
--- src/pl/plperl/sql/plperl.sql	26 Jan 2007 15:13:05 -0000
***************
*** 316,322 ****
  -- 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 $q = spi_exec_prepared( $x, $_[0] + 1);
     spi_freeplan($x);
  return $q->{rows}->[0]->{a};
--- 316,322 ----
  -- 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', 'INTEGER');
     my $q = spi_exec_prepared( $x, $_[0] + 1);
     spi_freeplan($x);
  return $q->{rows}->[0]->{a};
***************
*** 337,339 ****
--- 337,369 ----
  $$ 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";
+ 
---------------------------(end of broadcast)---------------------------
TIP 2: Don't 'kill -9' the postmaster

Reply via email to