Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

- updated copyright statements

- Makefile fix for Mac OSX per kostas savvidis
- Added RPostgreSQL compatability functions
- Added ability to send serialized R objects to Postgres as bytea return values
- Added ability to convert bytea arguments from Postgres back into the original R object
- Added function to unserialize bytea value in order to restore object outside of R (useful for image data)
  • Loading branch information...
commit c7aa0e9ee73ce7901f11bf5475fe557834fc31fc 1 parent 2c727f3
authored
4  Makefile
@@ -5,14 +5,14 @@ r_libdir1x = ${R_HOME}/bin
5 5
 r_libdir2x = ${R_HOME}/lib
6 6
 # location of R includes
7 7
 r_includespec = ${R_HOME}/include
  8
+rhomedef = ${R_HOME}
8 9
 else
9 10
 R_HOME := $(shell pkg-config --variable=rhome libR)
10 11
 r_libdir1x := $(shell pkg-config --variable=rlibdir libR)
11 12
 r_libdir2x := $(shell pkg-config --variable=rlibdir libR)
12 13
 r_includespec := $(shell pkg-config --variable=rincludedir libR)
13  
-endif
14  
-
15 14
 rhomedef := $(shell pkg-config --variable=rhome libR)
  15
+endif
16 16
 
17 17
 ifneq (,${R_HOME})
18 18
 
2  README.plr
@@ -2,7 +2,7 @@
2 2
  * PL/R - PostgreSQL support for R as a
3 3
  *	      procedural language (PL)
4 4
  *
5  
- * Copyright (c) 2003-2007 by Joseph E. Conway
  5
+ * Copyright (c) 2003-2009 by Joseph E. Conway
6 6
  * ALL RIGHTS RESERVED
7 7
  * 
8 8
  * Joe Conway <mail@joeconway.com>
120  doc/plr.sgml
@@ -3,7 +3,7 @@
3 3
  <title>PL/R User's Guide - R Procedural Language</title>
4 4
  <bookinfo>
5 5
   <copyright>
6  
-   <year>2003-2007</year>
  6
+   <year>2003-2009</year>
7 7
    <holder>Joseph E Conway</holder>
8 8
   </copyright>
9 9
  </bookinfo>
@@ -313,12 +313,15 @@ select round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8);
313 313
     The argument values supplied to a PL/R function's script are
314 314
     the input arguments converted to a corresponding R form.
315 315
     See <xref linkend="plr-args-table">. Scalar PostgreSQL
316  
-    values become single element R vectors. One-dimensional
317  
-    PostgreSQL arrays are converted to multi-element R vectors, two-dimensional
318  
-    PostgreSQL arrays are mapped to R matrixes, and three-dimensional
319  
-    PostgreSQL arrays are converted to three-dimensional R arrays. Greater
320  
-    than three-dimensional arrays are not supported. Composite-types are
321  
-    transformed into R data.frames.
  316
+    values become single element R vectors. One exception to
  317
+    this are scalar bytea values. These are first converted to
  318
+    R raw type, and then processed by the R unserialize command.
  319
+    One-dimensional PostgreSQL arrays are converted to multi-element
  320
+    R vectors, two-dimensional PostgreSQL arrays are mapped to R
  321
+    matrixes, and three-dimensional PostgreSQL arrays are converted
  322
+    to three-dimensional R arrays. Greater than three-dimensional
  323
+    arrays are not supported. Composite-types are transformed into
  324
+    R data.frames.
322 325
    </para>
323 326
 
324 327
    <table id="plr-args-table">
@@ -350,6 +353,11 @@ select round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8);
350 353
       </row>
351 354
 
352 355
       <row>
  356
+       <entry><type>bytea</type></entry>
  357
+       <entry><type>object</type></entry>
  358
+      </row>
  359
+
  360
+      <row>
353 361
        <entry>everything else</entry>
354 362
        <entry><type>character</type></entry>
355 363
       </row>
@@ -362,6 +370,10 @@ select round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8);
362 370
     Conversely, the return values are first coerced to R character, and
363 371
     therefore anything that resolves to a string that is acceptable input
364 372
     format for the function's declared return type will produce a result.
  373
+    Again, there is an exception for scalar bytea return values. In this
  374
+    case, the R object being returned is first processed by the R
  375
+    serialize command, and then the binary result is directly mapped
  376
+    into a PostgreSQL bytea datum. 
365 377
     Similar to argument conversion, there is also a mapping between the
366 378
     dimensionality of the declared PostgreSQL return type and the type of
367 379
     R object. That mapping is shown in 
@@ -596,6 +608,9 @@ SELECT row_number(), f1 from t;
596 608
      the body of a PL/R procedure, or in support thereof:
597 609
     </para>
598 610
 
  611
+  <sect1 id="plr-spi-rsupport-funcs-normal">
  612
+   <title>Normal Support</title>
  613
+
599 614
     <variablelist>
600 615
 
601 616
      <varlistentry>
@@ -851,7 +866,7 @@ cursor_obj <- pg.spi.cursor_open('my_cursor',plan);
851 866
         <programlisting>
852 867
 plan <- pg.spi.prepare('SELECT * FROM pg_class');
853 868
 cursor_obj <- pg.spi.cursor_open('my_cursor',plan);
854  
-data <- pg.spi.cursor_forward(cursor_obj,TRUE,10);
  869
+data <- pg.spi.cursor_fetch(cursor_obj,TRUE,as.integer(10));
855 870
         </programlisting>
856 871
        </para>
857 872
        <para>
@@ -951,8 +966,73 @@ pg.spi.cursor_close(cursor_obj);
951 966
        </para>
952 967
       </listitem>
953 968
      </varlistentry>
  969
+    </variablelist>
  970
+  </sect1>
  971
+  <sect1 id="plr-spi-rsupport-funcs-compat">
  972
+   <title>RPostgreSQL Compatibility Support</title>
954 973
 
  974
+    <variablelist>
  975
+     <varlistentry>
  976
+      <listitem>
  977
+       <para>
  978
+        The following functions are intended to provide some level of compatibility between
  979
+        PL/R and RPostgreSQL (PostgreSQL DBI package). This allows, for example, a function
  980
+        to be first prototyped using an R client, and then easily moved to PL/R for
  981
+        production use.
  982
+       </para>
  983
+      </listitem>
  984
+
  985
+      <term><function>dbDriver</function>
  986
+           (<type>character</type> <replaceable>dvr_name</replaceable>)
  987
+      </term>
  988
+      <term><function>dbConnect</function>
  989
+           (<type>DBIDriver</type> <replaceable>drv</replaceable>,
  990
+            <type>character</type> <replaceable>user</replaceable>,
  991
+            <type>character</type> <replaceable>password</replaceable>,
  992
+            <type>character</type> <replaceable>host</replaceable>,
  993
+            <type>character</type> <replaceable>dbname</replaceable>,
  994
+            <type>character</type> <replaceable>port</replaceable>,
  995
+            <type>character</type> <replaceable>tty</replaceable>,
  996
+            <type>character</type> <replaceable>options</replaceable>)
  997
+      </term>
  998
+      <term><function>dbSendQuery</function>
  999
+           (<type>DBIConnection</type> <replaceable>conn</replaceable>,
  1000
+            <type>character</type> <replaceable>sql</replaceable>)
  1001
+      </term>
  1002
+      <term><function>fetch</function>
  1003
+           (<type>DBIResult</type> <replaceable>rs</replaceable>,
  1004
+            <type>integer</type> <replaceable>num_rows</replaceable>)
  1005
+      </term>
  1006
+      <term><function>dbClearResult</function>
  1007
+           (<type>DBIResult</type> <replaceable>rs</replaceable>)
  1008
+      </term>
  1009
+      <term><function>dbGetQuery</function>
  1010
+           (<type>DBIConnection</type> <replaceable>conn</replaceable>,
  1011
+            <type>character</type> <replaceable>sql</replaceable>)
  1012
+      </term>
  1013
+      <term><function>dbReadTable</function>
  1014
+           (<type>DBIConnection</type> <replaceable>conn</replaceable>,
  1015
+            <type>character</type> <replaceable>name</replaceable>)
  1016
+      </term>
  1017
+      <term><function>dbDisconnect</function>
  1018
+           (<type>DBIConnection</type> <replaceable>conn</replaceable>)
  1019
+      </term>
  1020
+      <term><function>dbUnloadDriver</function>
  1021
+           (<type>DBIDriver</type> <replaceable>drv</replaceable>)
  1022
+      </term>
  1023
+
  1024
+      <listitem>
  1025
+       <para>
  1026
+        These functions nominally work like their RPostgreSQL counterparts
  1027
+        except that all queries are performed in the current database.
  1028
+        Therefore all driver and connection related parameters are
  1029
+        ignored, and dbDriver, dbConnect, dbDisconnect, and dbUnloadDriver
  1030
+        are no-ops.
  1031
+       </para>
  1032
+      </listitem>
  1033
+     </varlistentry>
955 1034
     </variablelist>
  1035
+  </sect1>
956 1036
  </chapter>
957 1037
 
958 1038
  <chapter id="plr-pgsql-support-funcs">
@@ -1119,6 +1199,30 @@ select plr_array_accum('{23,35}', 42);
1119 1199
       </listitem>
1120 1200
      </varlistentry>
1121 1201
 
  1202
+     <varlistentry>
  1203
+      <term><function>plr_set_display</function>(<type>text</type> <replaceable>display</replaceable>)</term>
  1204
+      <listitem>
  1205
+       <para>
  1206
+        Sets the DISPLAY environment vaiable under which the Postmaster is currently
  1207
+        running. This may be useful if using R to plot to a virtual frame buffer.
  1208
+        This function is installed with EXECUTE permission revoked from PUBLIC.
  1209
+       </para>
  1210
+      </listitem>
  1211
+     </varlistentry>
  1212
+
  1213
+     <varlistentry>
  1214
+      <term><function>plr_get_raw</function>(<type>bytea</type> <replaceable>serialized_object</replaceable>)</term>
  1215
+      <listitem>
  1216
+       <para>
  1217
+        By default, when R objects are returned as type <type>bytea</type>, the
  1218
+        R object is serialized using an internal R function prior to sending to PostgreSQL.
  1219
+        This function unserializes the R object using another internal R function, and
  1220
+        returns the pure raw bytes to PostgreSQL. This is useful, for example, if the R
  1221
+        object being returned is a JPEG or PNG graphic for use outside of R.
  1222
+       </para>
  1223
+      </listitem>
  1224
+     </varlistentry>
  1225
+
1122 1226
     </variablelist>
1123 1227
  </chapter>
1124 1228
 
20  expected/plr.out
@@ -95,7 +95,7 @@ select reval('a <- sd(c(1,2,3)); b <- mean(c(1,2,3)); a + b');
95 95
 
96 96
 create or replace function "commandArgs"() returns text[] as '' language 'plr';
97 97
 select "commandArgs"();
98  
-        commandArgs        
  98
+              commandArgs               
99 99
 ----------------------------------------
100 100
  {PL/R,--silent,--no-save,--no-restore}
101 101
 (1 row)
@@ -868,3 +868,21 @@ SELECT * FROM cursor_fetch_test_arg(3);
868 868
                      3
869 869
 (3 rows)
870 870
 
  871
+--Test bytea arguments and return values: serialize/unserialize
  872
+create or replace function test_serialize(text)
  873
+returns bytea as '
  874
+ mydf <- pg.spi.exec(arg1)
  875
+ return (mydf)
  876
+' language 'plr';
  877
+create or replace function restore_df(bytea)
  878
+returns setof record as '
  879
+ return (arg1)
  880
+' language 'plr';
  881
+select * from restore_df((select test_serialize('select oid, typname from pg_type where typname in (''oid'',''name'',''int4'')'))) as t(oid oid, typname name);
  882
+ oid | typname 
  883
+-----+---------
  884
+  19 | name
  885
+  23 | int4
  886
+  26 | oid
  887
+(3 rows)
  888
+
2  pg_backend_support.c
@@ -2,7 +2,7 @@
2 2
  * PL/R - PostgreSQL support for R as a
3 3
  *	      procedural language (PL)
4 4
  *
5  
- * Copyright (c) 2003-2007 by Joseph E. Conway
  5
+ * Copyright (c) 2003-2009 by Joseph E. Conway
6 6
  * ALL RIGHTS RESERVED
7 7
  * 
8 8
  * Joe Conway <mail@joeconway.com>
158  pg_conversion.c
@@ -2,7 +2,7 @@
2 2
  * PL/R - PostgreSQL support for R as a
3 3
  *	      procedural language (PL)
4 4
  *
5  
- * Copyright (c) 2003-2007 by Joseph E. Conway
  5
+ * Copyright (c) 2003-2009 by Joseph E. Conway
6 6
  * ALL RIGHTS RESERVED
7 7
  * 
8 8
  * Joe Conway <mail@joeconway.com>
@@ -67,6 +67,8 @@ static Tuplestorestate *get_generic_tuplestore(SEXP rval,
67 67
 											 MemoryContext per_query_ctx,
68 68
 											 bool retset);
69 69
 
  70
+extern char *last_R_error_msg;
  71
+
70 72
 /*
71 73
  * given a scalar pg value, convert to a one row R vector
72 74
  */
@@ -74,20 +76,58 @@ SEXP
74 76
 pg_scalar_get_r(Datum dvalue, Oid arg_typid, FmgrInfo arg_out_func)
75 77
 {
76 78
 	SEXP		result;
77  
-	char	   *value;
78 79
 
79  
-	value = DatumGetCString(FunctionCall3(&arg_out_func,
80  
-										  dvalue,
81  
-							 			  (Datum) 0,
82  
-										  Int32GetDatum(-1)));
  80
+	/* add our value to it */
  81
+	if (arg_typid != BYTEAOID)
  82
+	{
  83
+		char	   *value;
83 84
 
84  
-	/* get new vector of the appropriate type, length 1 */
85  
-	PROTECT(result = get_r_vector(arg_typid, 1));
  85
+		value = DatumGetCString(FunctionCall3(&arg_out_func,
  86
+											  dvalue,
  87
+								 			  (Datum) 0,
  88
+											  Int32GetDatum(-1)));
86 89
 
87  
-	/* add our value to it */
88  
-	pg_get_one_r(value, arg_typid, &result, 0);
  90
+		/* get new vector of the appropriate type, length 1 */
  91
+		PROTECT(result = get_r_vector(arg_typid, 1));
  92
+		pg_get_one_r(value, arg_typid, &result, 0);
  93
+		UNPROTECT(1);
  94
+	}
  95
+	else
  96
+	{
  97
+		SEXP 	s, t, obj;
  98
+		int		status;
89 99
 
90  
-	UNPROTECT(1);
  100
+		PROTECT(obj = get_r_vector(arg_typid, VARSIZE((bytea *) dvalue)));
  101
+		memcpy((char *) RAW(obj),
  102
+			   VARDATA((bytea *) dvalue),
  103
+			   VARSIZE((bytea *) dvalue));
  104
+
  105
+		/*
  106
+		 * Need to construct a call to
  107
+		 * unserialize(rval)
  108
+		 */
  109
+		PROTECT(t = s = allocList(2));
  110
+		SET_TYPEOF(s, LANGSXP);
  111
+		SETCAR(t, install("unserialize")); t = CDR(t);
  112
+		SETCAR(t, obj);
  113
+
  114
+		PROTECT(result = R_tryEval(s, R_GlobalEnv, &status));
  115
+		if(status != 0)
  116
+		{
  117
+			if (last_R_error_msg)
  118
+				ereport(ERROR,
  119
+						(errcode(ERRCODE_DATA_EXCEPTION),
  120
+						 errmsg("R interpreter expression evaluation error"),
  121
+						 errdetail("%s", last_R_error_msg)));
  122
+			else
  123
+				ereport(ERROR,
  124
+						(errcode(ERRCODE_DATA_EXCEPTION),
  125
+						 errmsg("R interpreter expression evaluation error"),
  126
+						 errdetail("R expression evaluation error caught in \"unserialize\".")));
  127
+		}
  128
+
  129
+		UNPROTECT(2);
  130
+	}
91 131
 
92 132
 	return result;
93 133
 }
@@ -370,6 +410,9 @@ get_r_vector(Oid typtype, int numels)
370 410
 		case BOOLOID:
371 411
 			PROTECT(result = NEW_LOGICAL(numels));
372 412
 			break;
  413
+		case BYTEAOID:
  414
+			PROTECT(result = NEW_RAW(numels));
  415
+			break;
373 416
 		default:
374 417
 			/* Everything else is defaulted to string */
375 418
 			PROTECT(result = NEW_CHARACTER(numels));
@@ -449,7 +492,7 @@ r_get_pg(SEXP rval, plr_function *function, FunctionCallInfo fcinfo)
449 492
 		}
450 493
 
451 494
 		if (function->result_elem == 0)
452  
-			result = get_scalar_datum(rval, function->result_in_func, function->result_elem, &isnull);
  495
+			result = get_scalar_datum(rval, function->result_typid, function->result_in_func, &isnull);
453 496
 		else
454 497
 			result = get_array_datum(rval, function, 0, &isnull);
455 498
 
@@ -718,38 +761,88 @@ get_tuplestore(SEXP rval, plr_function *function, FunctionCallInfo fcinfo, bool
718 761
 }
719 762
 
720 763
 Datum
721  
-get_scalar_datum(SEXP rval, FmgrInfo result_in_func, Oid result_elem, bool *isnull)
  764
+get_scalar_datum(SEXP rval, Oid result_typid, FmgrInfo result_in_func, bool *isnull)
722 765
 {
723 766
 	Datum		dvalue;
724 767
 	SEXP		obj;
725 768
 	const char *value;
726 769
 
727 770
 	/*
728  
-	 * if the element type is zero, we don't have an array,
729  
-	 * so coerce to string and take the first element as a scalar
  771
+	 * Element type is zero, we don't have an array, so coerce to string
  772
+	 * and take the first element as a scalar
  773
+	 *
  774
+	 * Exception: if result type is BYTEA, we want to return the whole
  775
+	 * object in serialized form
730 776
 	 */
731  
-	PROTECT(obj = AS_CHARACTER(rval));
732  
-	value = CHAR(STRING_ELT(obj, 0));
733  
-
734  
-	if (STRING_ELT(obj, 0) == NA_STRING)
735  
-	{
736  
-		*isnull = true;
737  
-		dvalue = (Datum) 0;
738  
-	}
739  
-	else if (value != NULL)
  777
+	if (result_typid != BYTEAOID)
740 778
 	{
741  
-		dvalue = FunctionCall3(&result_in_func,
742  
-								CStringGetDatum(value),
743  
-								ObjectIdGetDatum(result_elem),
744  
-								Int32GetDatum(-1));
  779
+		PROTECT(obj = AS_CHARACTER(rval));
  780
+		if (STRING_ELT(obj, 0) == NA_STRING)
  781
+		{
  782
+			UNPROTECT(1);
  783
+			*isnull = true;
  784
+			dvalue = (Datum) 0;
  785
+			return dvalue;
  786
+		}
  787
+		value = CHAR(STRING_ELT(obj, 0));
  788
+		UNPROTECT(1);
  789
+		
  790
+		if (value != NULL)
  791
+		{
  792
+			dvalue = FunctionCall3(&result_in_func,
  793
+									CStringGetDatum(value),
  794
+									ObjectIdGetDatum(0),
  795
+									Int32GetDatum(-1));
  796
+		}
  797
+		else
  798
+		{
  799
+			*isnull = true;
  800
+			dvalue = (Datum) 0;
  801
+		}
745 802
 	}
746 803
 	else
747 804
 	{
748  
-		*isnull = true;
749  
-		dvalue = (Datum) 0;
750  
-	}
  805
+		SEXP 	s, t;
  806
+		int		len, rsize, status;
  807
+		bytea  *result;
  808
+		char   *rptr;
751 809
 
752  
-	UNPROTECT(1);
  810
+		/*
  811
+		 * Need to construct a call to
  812
+		 * serialize(rval, NULL)
  813
+		 */
  814
+		PROTECT(t = s = allocList(3));
  815
+		SET_TYPEOF(s, LANGSXP);
  816
+		SETCAR(t, install("serialize")); t = CDR(t);
  817
+		SETCAR(t, rval); t = CDR(t);
  818
+		SETCAR(t, R_NilValue);
  819
+
  820
+		PROTECT(obj = R_tryEval(s, R_GlobalEnv, &status));
  821
+		if(status != 0)
  822
+		{
  823
+			if (last_R_error_msg)
  824
+				ereport(ERROR,
  825
+						(errcode(ERRCODE_DATA_EXCEPTION),
  826
+						 errmsg("R interpreter expression evaluation error"),
  827
+						 errdetail("%s", last_R_error_msg)));
  828
+			else
  829
+				ereport(ERROR,
  830
+						(errcode(ERRCODE_DATA_EXCEPTION),
  831
+						 errmsg("R interpreter expression evaluation error"),
  832
+						 errdetail("R expression evaluation error caught in \"serialize\".")));
  833
+		}
  834
+		len = LENGTH(obj);
  835
+
  836
+		rsize = VARHDRSZ + len;
  837
+		result = (bytea *) palloc(rsize);
  838
+		SET_VARSIZE(result, rsize);
  839
+		rptr = VARDATA(result);
  840
+		memcpy(rptr, (char *) RAW(obj), rsize - VARHDRSZ);
  841
+
  842
+		UNPROTECT(2);
  843
+
  844
+		dvalue = PointerGetDatum(result);
  845
+	}
753 846
 
754 847
 	return dvalue;
755 848
 }
@@ -1414,4 +1507,3 @@ get_generic_tuplestore(SEXP rval,
1414 1507
 
1415 1508
 	return tupstore;
1416 1509
 }
1417  
-
11  pg_rsupport.c
@@ -2,7 +2,7 @@
2 2
  * PL/R - PostgreSQL support for R as a
3 3
  *	      procedural language (PL)
4 4
  *
5  
- * Copyright (c) 2003-2007 by Joseph E. Conway
  5
+ * Copyright (c) 2003-2009 by Joseph E. Conway
6 6
  * ALL RIGHTS RESERVED
7 7
  * 
8 8
  * Joe Conway <mail@joeconway.com>
@@ -455,7 +455,7 @@ plr_SPI_execp(SEXP rsaved_plan, SEXP rargvalues)
455 455
 	saved_plan_desc	   *plan_desc = (saved_plan_desc *) R_ExternalPtrAddr(rsaved_plan);
456 456
 	void			   *saved_plan = plan_desc->saved_plan;
457 457
 	int					nargs = plan_desc->nargs;
458  
-	Oid				   *typelems = plan_desc->typelems;
  458
+	Oid				   *typeids = plan_desc->typeids;
459 459
 	FmgrInfo		   *typinfuncs = plan_desc->typinfuncs;
460 460
 	int					i;
461 461
 	Datum			   *argvalues = NULL;
@@ -492,7 +492,7 @@ plr_SPI_execp(SEXP rsaved_plan, SEXP rargvalues)
492 492
 	{
493 493
 		PROTECT(obj = VECTOR_ELT(rargvalues, i));
494 494
 
495  
-		argvalues[i] = get_scalar_datum(obj, typinfuncs[i], typelems[i], &isnull);
  495
+		argvalues[i] = get_scalar_datum(obj, typeids[i], typinfuncs[i], &isnull);
496 496
 		if (!isnull)
497 497
 			nulls[i] = ' ';
498 498
 		else
@@ -615,7 +615,7 @@ plr_SPI_cursor_open(SEXP cursor_name_arg,SEXP rsaved_plan, SEXP rargvalues)
615 615
 	saved_plan_desc	   *plan_desc = (saved_plan_desc *) R_ExternalPtrAddr(rsaved_plan);
616 616
 	void			   *saved_plan = plan_desc->saved_plan;
617 617
 	int					nargs = plan_desc->nargs;
618  
-	Oid				   *typelems = plan_desc->typelems;
  618
+	Oid				   *typeids = plan_desc->typeids;
619 619
 	FmgrInfo		   *typinfuncs = plan_desc->typinfuncs;
620 620
 	int					i;
621 621
 	Datum			   *argvalues = NULL;
@@ -649,7 +649,7 @@ plr_SPI_cursor_open(SEXP cursor_name_arg,SEXP rsaved_plan, SEXP rargvalues)
649 649
 	{
650 650
 		PROTECT(obj = VECTOR_ELT(rargvalues, i));
651 651
 
652  
-		argvalues[i] = get_scalar_datum(obj, typinfuncs[i], typelems[i], &isnull);
  652
+		argvalues[i] = get_scalar_datum(obj, typeids[i], typinfuncs[i], &isnull);
653 653
 		if (!isnull)
654 654
 			nulls[i] = ' ';
655 655
 		else
@@ -819,3 +819,4 @@ rsupport_error_callback(void *arg)
819 819
 	if (arg)
820 820
 		errcontext("In R support function %s", (char *) arg);
821 821
 }
  822
+
90  pg_userfuncs.c
@@ -2,7 +2,7 @@
2 2
  * PL/R - PostgreSQL support for R as a
3 3
  *	      procedural language (PL)
4 4
  *
5  
- * Copyright (c) 2003-2007 by Joseph E. Conway
  5
+ * Copyright (c) 2003-2009 by Joseph E. Conway
6 6
  * ALL RIGHTS RESERVED
7 7
  * 
8 8
  * Joe Conway <mail@joeconway.com>
@@ -407,3 +407,91 @@ plr_unset_rhome(PG_FUNCTION_ARGS)
407 407
 
408 408
 	PG_RETURN_TEXT_P(PG_STR_GET_TEXT("OK"));
409 409
 }
  410
+
  411
+/*-----------------------------------------------------------------------------
  412
+ * plr_set_display :
  413
+ *		utility function to set the DISPLAY environment variable under
  414
+ *		which the postmaster is running.
  415
+ *----------------------------------------------------------------------------
  416
+ */
  417
+PG_FUNCTION_INFO_V1(plr_set_display);
  418
+Datum
  419
+plr_set_display(PG_FUNCTION_ARGS)
  420
+{
  421
+	char		   *display = PG_TEXT_GET_STR(PG_GETARG_TEXT_P(0));
  422
+	size_t			d_len = strlen(display);
  423
+
  424
+	if (d_len)
  425
+	{
  426
+		char			   *denv;
  427
+		MemoryContext		oldcontext;
  428
+
  429
+		/* Needs to live until/unless we explicitly delete it */
  430
+		oldcontext = MemoryContextSwitchTo(TopMemoryContext);
  431
+		denv = palloc(9 + d_len);
  432
+		MemoryContextSwitchTo(oldcontext);
  433
+
  434
+		sprintf(denv, "DISPLAY=%s", display);
  435
+		putenv(denv);
  436
+	}
  437
+
  438
+	PG_RETURN_TEXT_P(PG_STR_GET_TEXT("OK"));
  439
+}
  440
+
  441
+/*-----------------------------------------------------------------------------
  442
+ * plr_get_raw :
  443
+ *		utility function to ...
  444
+ *----------------------------------------------------------------------------
  445
+ */
  446
+extern char *last_R_error_msg;
  447
+ 
  448
+PG_FUNCTION_INFO_V1(plr_get_raw);
  449
+Datum
  450
+plr_get_raw(PG_FUNCTION_ARGS)
  451
+{
  452
+	SEXP	result;
  453
+	SEXP 	s, t, obj;
  454
+	int		status;
  455
+	bytea  *bvalue = PG_GETARG_BYTEA_P(0);
  456
+	int		len, rsize;
  457
+	bytea  *bresult;
  458
+	char   *brptr;
  459
+
  460
+	PROTECT(obj = NEW_RAW(VARSIZE(bvalue)));
  461
+	memcpy((char *) RAW(obj), VARDATA(bvalue), VARSIZE(bvalue));
  462
+
  463
+	/*
  464
+	 * Need to construct a call to
  465
+	 * unserialize(rval)
  466
+	 */
  467
+	PROTECT(t = s = allocList(2));
  468
+	SET_TYPEOF(s, LANGSXP);
  469
+	SETCAR(t, install("unserialize")); t = CDR(t);
  470
+	SETCAR(t, obj);
  471
+
  472
+	PROTECT(result = R_tryEval(s, R_GlobalEnv, &status));
  473
+	if(status != 0)
  474
+	{
  475
+		if (last_R_error_msg)
  476
+			ereport(ERROR,
  477
+					(errcode(ERRCODE_DATA_EXCEPTION),
  478
+					 errmsg("R interpreter expression evaluation error"),
  479
+					 errdetail("%s", last_R_error_msg)));
  480
+		else
  481
+			ereport(ERROR,
  482
+					(errcode(ERRCODE_DATA_EXCEPTION),
  483
+					 errmsg("R interpreter expression evaluation error"),
  484
+					 errdetail("R expression evaluation error caught in \"unserialize\".")));
  485
+	}
  486
+
  487
+	len = LENGTH(result);
  488
+	rsize = VARHDRSZ + len;
  489
+	bresult = (bytea *) palloc(rsize);
  490
+	SET_VARSIZE(bresult, rsize);
  491
+	brptr = VARDATA(bresult);
  492
+	memcpy(brptr, (char *) RAW(result), rsize - VARHDRSZ);
  493
+
  494
+	UNPROTECT(2);
  495
+
  496
+	PG_RETURN_BYTEA_P(bresult);
  497
+}
48  plr.c
@@ -2,7 +2,7 @@
2 2
  * PL/R - PostgreSQL support for R as a
3 3
  *	      procedural language (PL)
4 4
  *
5  
- * Copyright (c) 2003-2007 by Joseph E. Conway
  5
+ * Copyright (c) 2003-2009 by Joseph E. Conway
6 6
  * ALL RIGHTS RESERVED
7 7
  * 
8 8
  * Joe Conway <mail@joeconway.com>
@@ -107,6 +107,43 @@ static Oid plr_nspOid = InvalidOid;
107 107
 #define SPI_LASTOID_CMD \
108 108
 			"pg.spi.lastoid <-function() " \
109 109
 			"{.Call(\"plr_SPI_lastoid\")}"
  110
+#define SPI_DBDRIVER_CMD \
  111
+			"dbDriver <-function(db_name)\n" \
  112
+			"{return(NA)}"
  113
+#define SPI_DBCONN_CMD \
  114
+			"dbConnect <- function(drv,user=\"\",password=\"\",host=\"\",dbname=\"\",port=\"\",tty =\"\",options=\"\")\n" \
  115
+			"{return(NA)}"
  116
+#define SPI_DBSENDQUERY_CMD \
  117
+			"dbSendQuery <- function(conn, sql) {\n" \
  118
+			"plan <- pg.spi.prepare(sql)\n" \
  119
+			"cursor_obj <- pg.spi.cursor_open(\"plr_cursor\",plan)\n" \
  120
+			"return(cursor_obj)\n" \
  121
+			"}"
  122
+#define SPI_DBFETCH_CMD \
  123
+			"fetch <- function(rs,n) {\n" \
  124
+			"data <- pg.spi.cursor_fetch(rs, TRUE, as.integer(n))\n" \
  125
+			"return(data)\n" \
  126
+			"}"
  127
+#define SPI_DBCLEARRESULT_CMD \
  128
+			"dbClearResult <- function(rs) {\n" \
  129
+			"pg.spi.cursor_close(rs)\n" \
  130
+			"}"
  131
+#define SPI_DBGETQUERY_CMD \
  132
+			"dbGetQuery <-function(conn, sql) {\n" \
  133
+			"data <- pg.spi.exec(sql)\n" \
  134
+			"return(data)\n" \
  135
+			"}"
  136
+#define SPI_DBREADTABLE_CMD \
  137
+			"dbReadTable <- function(con, name, row.names = \"row_names\", check.names = TRUE) {\n" \
  138
+			"data <- dbGetQuery(con, paste(\"SELECT * from\", name))\n" \
  139
+			"return(data)\n" \
  140
+			"}"
  141
+#define SPI_DBDISCONN_CMD \
  142
+			"dbDisconnect <- function(con)\n" \
  143
+			"{return(NA)}"
  144
+#define SPI_DBUNLOADDRIVER_CMD \
  145
+			"dbUnloadDriver <-function(drv)\n" \
  146
+			"{return(NA)}"
110 147
 #define SPI_FACTOR_CMD \
111 148
 			"pg.spi.factor <- function(arg1) {\n" \
112 149
 			"  for (col in 1:ncol(arg1)) {\n" \
@@ -405,6 +442,15 @@ plr_load_builtins(Oid funcid)
405 442
 		SPI_CURSOR_MOVE_CMD,
406 443
 		SPI_CURSOR_CLOSE_CMD,
407 444
 		SPI_LASTOID_CMD,
  445
+		SPI_DBDRIVER_CMD,
  446
+		SPI_DBCONN_CMD,
  447
+		SPI_DBSENDQUERY_CMD,
  448
+		SPI_DBFETCH_CMD,
  449
+		SPI_DBCLEARRESULT_CMD,
  450
+		SPI_DBGETQUERY_CMD,
  451
+		SPI_DBREADTABLE_CMD,
  452
+		SPI_DBDISCONN_CMD,
  453
+		SPI_DBUNLOADDRIVER_CMD,
408 454
 		SPI_FACTOR_CMD,
409 455
 
410 456
 		/* handy predefined R functions */
8  plr.h
@@ -2,7 +2,7 @@
2 2
  * PL/R - PostgreSQL support for R as a
3 3
  *	      procedural language (PL)
4 4
  *
5  
- * Copyright (c) 2003-2007 by Joseph E. Conway
  5
+ * Copyright (c) 2003-2009 by Joseph E. Conway
6 6
  * ALL RIGHTS RESERVED
7 7
  * 
8 8
  * Joe Conway <mail@joeconway.com>
@@ -58,7 +58,7 @@
58 58
 #endif
59 59
 #include "Rinternals.h"
60 60
 #include "Rdefines.h"
61  
-#if (R_VERSION < 133120) /* R_VERSION >= 2.8.0 */
  61
+#if (R_VERSION < 133120) /* R_VERSION < 2.8.0 */
62 62
 #include "Rdevices.h"
63 63
 #endif
64 64
 
@@ -452,7 +452,7 @@ extern SEXP pg_scalar_get_r(Datum dvalue, Oid arg_typid, FmgrInfo arg_out_func);
452 452
 extern SEXP pg_array_get_r(Datum dvalue, FmgrInfo out_func, int typlen, bool typbyval, char typalign);
453 453
 extern SEXP pg_tuple_get_r_frame(int ntuples, HeapTuple *tuples, TupleDesc tupdesc);
454 454
 extern Datum r_get_pg(SEXP rval, plr_function *function, FunctionCallInfo fcinfo);
455  
-extern Datum get_scalar_datum(SEXP rval, FmgrInfo result_in_func, Oid result_elem, bool *isnull);
  455
+extern Datum get_scalar_datum(SEXP rval, Oid result_typ, FmgrInfo result_in_func, bool *isnull);
456 456
 
457 457
 /* Postgres support functions installed into the R interpreter */
458 458
 extern void throw_pg_notice(const char **msg);
@@ -477,6 +477,8 @@ extern Datum plr_array_accum(PG_FUNCTION_ARGS);
477 477
 extern Datum plr_environ(PG_FUNCTION_ARGS);
478 478
 extern Datum plr_set_rhome(PG_FUNCTION_ARGS);
479 479
 extern Datum plr_unset_rhome(PG_FUNCTION_ARGS);
  480
+extern Datum plr_set_display(PG_FUNCTION_ARGS);
  481
+extern Datum plr_get_raw(PG_FUNCTION_ARGS);
480 482
 
481 483
 /* Postgres backend support functions */
482 484
 extern void compute_function_hashkey(FunctionCallInfo fcinfo,
12  plr.sql.in
@@ -81,3 +81,15 @@ RETURNS text
81 81
 AS 'MODULE_PATHNAME','plr_unset_rhome'
82 82
 LANGUAGE 'C';
83 83
 REVOKE EXECUTE ON FUNCTION plr_unset_rhome () FROM PUBLIC;
  84
+
  85
+CREATE OR REPLACE FUNCTION plr_set_display (text)
  86
+RETURNS text
  87
+AS 'MODULE_PATHNAME','plr_set_display'
  88
+LANGUAGE 'C' WITH (isstrict);
  89
+REVOKE EXECUTE ON FUNCTION plr_set_display (text) FROM PUBLIC;
  90
+
  91
+CREATE OR REPLACE FUNCTION plr_get_raw (bytea)
  92
+RETURNS bytea
  93
+AS 'MODULE_PATHNAME','plr_get_raw'
  94
+LANGUAGE 'C' WITH (isstrict);
  95
+
13  sql/plr.sql
@@ -372,3 +372,16 @@ SELECT * FROM cursor_direction_test();
372 372
 CREATE OR REPLACE FUNCTION cursor_fetch_test_arg(integer) RETURNS SETOF integer AS 'plan<-pg.spi.prepare("SELECT * FROM generate_series(1,$1)",c(INT4OID)); cursor<-pg.spi.cursor_open("curs",plan,list(arg1)); dat<-pg.spi.cursor_fetch(cursor,TRUE,arg1); pg.spi.cursor_close(cursor); return (dat);' language 'plr';
373 373
 SELECT * FROM cursor_fetch_test_arg(3);
374 374
 
  375
+--Test bytea arguments and return values: serialize/unserialize
  376
+create or replace function test_serialize(text)
  377
+returns bytea as '
  378
+ mydf <- pg.spi.exec(arg1)
  379
+ return (mydf)
  380
+' language 'plr';
  381
+
  382
+create or replace function restore_df(bytea)
  383
+returns setof record as '
  384
+ return (arg1)
  385
+' language 'plr';
  386
+
  387
+select * from restore_df((select test_serialize('select oid, typname from pg_type where typname in (''oid'',''name'',''int4'')'))) as t(oid oid, typname name);

0 notes on commit c7aa0e9

Please sign in to comment.
Something went wrong with that request. Please try again.