return undef;

$$ LANGUAGE plperl;

SELECT perl_record_set();

ERROR: set-valued function called in context that cannot accept a set

CONTEXT: PL/Perl function "perl_record_set"

perl_record_set

-----------------

(0 rows)

SELECT * FROM perl_record_set();

ERROR: a column definition list is required for functions returning "record"

LINE 1: SELECT * FROM perl_record_set();

];

$$ LANGUAGE plperl;

SELECT perl_record_set();

ERROR:set-valuedfunction called in context that cannot accepta set

ERROR: functionreturning recordcalled in context that cannot accepttype record

CONTEXT: PL/Perl function "perl_record_set"

SELECT * FROM perl_record_set();

ERROR: a column definition list is required for functions returning "record"

];

$$ LANGUAGE plperl;

SELECT perl_record_set();

ERROR:set-valuedfunction called in context that cannot accepta set

ERROR: functionreturning recordcalled in context that cannot accepttype record

CONTEXT: PL/Perl function "perl_record_set"

SELECT * FROM perl_record_set();

ERROR: a column definition list is required for functions returning "record"

SELECT * FROM foo_set_bad();

ERROR: Perl hash contains nonexistent column "z"

CONTEXT: PL/Perl function "foo_set_bad"

CREATE DOMAIN orderedfootype AS footype CHECK ((VALUE).x <= (VALUE).y);

CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$

return {x => 3, y => 4};

$$ LANGUAGE plperl;

SELECT * FROM foo_ordered();

x | y

---+---

3 | 4

(1 row)

CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$

return {x => 5, y => 4};

$$ LANGUAGE plperl;

SELECT * FROM foo_ordered(); -- fail

ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check"

CONTEXT: PL/Perl function "foo_ordered"

CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$

return [

{x => 3, y => 4},

{x => 4, y => 7}

];

$$ LANGUAGE plperl;

SELECT * FROM foo_ordered_set();

x | y

---+---

3 | 4

4 | 7

(2 rows)

CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$

return [

{x => 3, y => 4},

{x => 9, y => 7}

];

$$ LANGUAGE plperl;

SELECT * FROM foo_ordered_set(); -- fail

ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check"

CONTEXT: PL/Perl function "foo_ordered_set"

--

-- Check passing a tuple argument

--

(1 row)

CREATE OR REPLACE FUNCTION perl_get_cfield(orderedfootype, text) RETURNS integer AS $$

return $_[0]->{$_[1]};

$$ LANGUAGE plperl;

SELECT perl_get_cfield((11,12), 'x');

perl_get_cfield

-----------------

11

(1 row)

SELECT perl_get_cfield((11,12), 'y');

perl_get_cfield

-----------------

12

(1 row)

SELECT perl_get_cfield((12,11), 'x'); -- fail

ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check"

CREATE OR REPLACE FUNCTION perl_get_rfield(record, text) RETURNS integer AS $$

return $_[0]->{$_[1]};

$$ LANGUAGE plperl;

SELECT perl_get_rfield((11,12), 'f1');

perl_get_rfield

-----------------

11

(1 row)

SELECT perl_get_rfield((11,12)::footype, 'y');

perl_get_rfield

-----------------

12

(1 row)

SELECT perl_get_rfield((11,12)::orderedfootype, 'x');

perl_get_rfield

-----------------

11

(1 row)

SELECT perl_get_rfield((12,11)::orderedfootype, 'x'); -- fail

ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check"

--

-- Test return_next

--

-- test encode_typed_literal

create type perl_foo as (a integer, b text[]);

create type perl_bar as (c perl_foo[]);

create domain perl_foo_pos as perl_foo check((value).a > 0);

create or replace function perl_encode_typed_literal() returns setof text language plperl as $$

return_next encode_typed_literal(undef, 'text');

return_next encode_typed_literal([[1,2,3],[3,2,1],[1,3,2]], 'integer[]');

return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo');

return_next encode_typed_literal({c => [{a => 9, b => ['PostgreSQL']}, {b => ['Postgres'], a => 1}]}, 'perl_bar');

return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo_pos');

$$;

select perl_encode_typed_literal();

perl_encode_typed_literal

{{1,2,3},{3,2,1},{1,3,2}}

(1,"{PL,/,Perl}")

("{""(9,{PostgreSQL})"",""(1,{Postgres})""}")

(4 rows)

(1,"{PL,/,Perl}")

(5 rows)

create or replace function perl_encode_typed_literal() returns setof text language plperl as $$

return_next encode_typed_literal({a => 0, b => ['PL','/','Perl']}, 'perl_foo_pos');

$$;

select perl_encode_typed_literal(); -- fail

ERROR: value for domain perl_foo_pos violates check constraint "perl_foo_pos_check"

CONTEXT: PL/Perl function "perl_encode_typed_literal"

{

plperl_proc_desc*prodesc;

FunctionCallInfofcinfo;

Tuplestorestate*tuple_store;

TupleDescret_tdesc;

Oidcdomain_oid;/* 0 unless returning domain-over-composite */

void*cdomain_info;

MemoryContexttmp_cxt;

}plperl_call_data;

Datumret;

TupleDesctd;

boolisdomain;

if (!type_is_rowtype(typid))

ereport(ERROR,

(errcode(ERRCODE_DATATYPE_MISMATCH),

errmsg("cannot convert Perl hash to non-composite type %s",

format_type_be(typid))));

td=lookup_rowtype_tupdesc_noerror(typid,typmod, true);

if (td==NULL)

td=lookup_rowtype_tupdesc_domain(typid,typmod, true);

if (td!=NULL)

{

if (fcinfo==NULL||

get_call_result_type(fcinfo,NULL,&td)!=TYPEFUNC_COMPOSITE)

isdomain= (typid!=td->tdtypeid);

}

{

TypeFuncClassfuncclass;

if (fcinfo)

funcclass=get_call_result_type(fcinfo,&typid,&td);

funcclass=TYPEFUNC_OTHER;

if (funcclass!=TYPEFUNC_COMPOSITE&&

funcclass!=TYPEFUNC_COMPOSITE_DOMAIN)

ereport(ERROR,

(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),

errmsg("function returning record called in context "

"that cannot accept type record")));

Assert(td);

isdomain= (funcclass==TYPEFUNC_COMPOSITE_DOMAIN);

}

ret=plperl_hash_to_datum(sv,td);

if (isdomain)

domain_check(ret, false,typid,NULL,NULL);

ReleaseTupleDesc(td);

{

if (!rsi|| !IsA(rsi,ReturnSetInfo)||

(rsi->allowedModes&SFRM_Materialize)==0||

rsi->expectedDesc==NULL)

(rsi->allowedModes&SFRM_Materialize)==0)

ereport(ERROR,

(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),

errmsg("set-valued function called in context that "

if (!is_trigger&& !is_event_trigger)

{

ObjectIdGetDatum(procStruct->prorettype));

typeTup=SearchSysCache1(TYPEOID,ObjectIdGetDatum(rettype));

if (!HeapTupleIsValid(typeTup))

elog(ERROR,"cache lookup failed for type %u",

procStruct->prorettype);

elog(ERROR,"cache lookup failed for type %u",rettype);

typeStruct= (Form_pg_type)GETSTRUCT(typeTup);

if (typeStruct->typtype==TYPTYPE_PSEUDO)

{

if (procStruct->prorettype==VOIDOID||

procStruct->prorettype==RECORDOID)

if (rettype==VOIDOID||

rettype==RECORDOID)

/* okay */ ;

elseif (procStruct->prorettype==TRIGGEROID||

procStruct->prorettype==EVTTRIGGEROID)

elseif (rettype==TRIGGEROID||

rettype==EVTTRIGGEROID)

ereport(ERROR,

(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),

errmsg("trigger functions can only be called "

ereport(ERROR,

(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),

errmsg("PL/Perl functions cannot return type %s",

format_type_be(procStruct->prorettype))));

format_type_be(rettype))));

}

prodesc->result_oid=procStruct->prorettype;

prodesc->result_oid=rettype;

prodesc->fn_retisset=procStruct->proretset;

prodesc->fn_retistuple= (procStruct->prorettype==RECORDOID||

typeStruct->typtype==TYPTYPE_COMPOSITE);

prodesc->fn_retistuple=type_is_rowtype(rettype);

(typeStruct->typlen==-1&&typeStruct->typelem);

for (i=0;i<prodesc->nargs;i++)

{

typeTup=SearchSysCache1(TYPEOID,

ObjectIdGetDatum(procStruct->proargtypes.values[i]));

Oidargtype=procStruct->proargtypes.values[i];

typeTup=SearchSysCache1(TYPEOID,ObjectIdGetDatum(argtype));

if (!HeapTupleIsValid(typeTup))

elog(ERROR,"cache lookup failed for type %u",

procStruct->proargtypes.values[i]);

elog(ERROR,"cache lookup failed for type %u",argtype);

typeStruct= (Form_pg_type)GETSTRUCT(typeTup);

if (typeStruct->typtype==TYPTYPE_PSEUDO&&

procStruct->proargtypes.values[i]!=RECORDOID)

argtype!=RECORDOID)

ereport(ERROR,

(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),

errmsg("PL/Perl functions cannot accept type %s",

format_type_be(procStruct->proargtypes.values[i]))));

format_type_be(argtype))));

if (typeStruct->typtype==TYPTYPE_COMPOSITE||

procStruct->proargtypes.values[i]==RECORDOID)

if (type_is_rowtype(argtype))

prodesc->arg_is_rowtype[i]= true;

{

proc_cxt);

}

if (typeStruct->typelem!=0&&typeStruct->typlen==-1)

prodesc->arg_arraytype[i]=procStruct->proargtypes.values[i];

prodesc->arg_arraytype[i]=argtype;

prodesc->arg_arraytype[i]=InvalidOid;

if (prodesc->fn_retistuple)

(void)get_call_result_type(fcinfo,NULL,&tupdesc);

{

TypeFuncClassfuncclass;

Oidtypid;

funcclass=get_call_result_type(fcinfo,&typid,&tupdesc);

if (funcclass!=TYPEFUNC_COMPOSITE&&

funcclass!=TYPEFUNC_COMPOSITE_DOMAIN)

ereport(ERROR,

(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),

errmsg("function returning record called in context "

"that cannot accept type record")));

if (funcclass==TYPEFUNC_COMPOSITE_DOMAIN)

current_call_data->cdomain_oid=typid;

}

{

tupdesc=rsi->expectedDesc;

tuple=plperl_build_tuple_result((HV*)SvRV(sv),

current_call_data->ret_tdesc);

if (OidIsValid(current_call_data->cdomain_oid))

domain_check(HeapTupleGetDatum(tuple), false,

current_call_data->cdomain_oid,

&current_call_data->cdomain_info,

rsi->econtext->ecxt_per_query_memory);

tuplestore_puttuple(current_call_data->tuple_store,tuple);

}