Thread: Reprise of Oracle decode functionality...now with nifty plperlu (and two cupholders)
Reprise of Oracle decode functionality...now with nifty plperlu (and two cupholders)
From
Mike Adams
Date:
I've been lurking on the pgsql-* lists for about a month now and have
decided to quit being a "wall flower".
Looking through the achives, I've noticed a fair number of threads about
Oracle compatibility functions: predominantly for decode(). I've even
seen and (quickly) looked at one implemented in C as an extension.
I've decided to toss my perl hat into the ring.
I use multiple schema to hold my procs:
schema usage
------ -----
pl plperl,plperlu procedures
java pljava,pljavau procedures
sql pgSQL,SQL procedures
Comments? Suggestions? Testimonials?
Enjoy:
(OBLIGATORY BLURB)
Code is presented AS IS, with NO WARRANTY of fitness for purpose. May
cause data loss, hair loss, may contain nuts.
/******************************************************************/
CREATE OR REPLACE FUNCTION pl.decode(selector text, clauses text)
RETURNS text AS
$BODY$
use Safe;
my $vault;
# get / setup a safe "vault" from / in %_SHARED to reduce function
# start up time on a per session level
if ( exists( $_SHARED{pl_vault} ) && defined( $_SHARED{pl_vault} ) ){
$vault = $_SHARED{pl_vault};
#elog( NOTICE , "plperlu: Preloaded safety vault being used." );
}
else {
# setup a safe vault using the same parameters as the SAFE_OK
# macro in postgresql's
# http://developer.postgresql.org/cvsweb.cgi/
# pgsql/src/pl/plperl/plperl.c?rev=1.105
$vault = Safe->new;
$vault->permit_only( qw/ :default
:base_math
!:base_io
time
sort
/ );
$_SHARED{pl_vault} = $vault;
#elog( NOTICE , "plperlu: Setting up session safety vault.");
}
my $selector = $_[0];
my @in_clauses = split( /,,/ , $_[1] );
# reject @in_clauses argument if it doesn't contain an odd number of
# entries: ie -
# ( '>10' , 'return#1' , 'final else' ) or
# ( '>10' , 'return#1' , '<10' , 'return#2' , 'final else' )
# is OK
# ( '>10' , 'return#1' ) is not
die( "pl.decode(): invalid clause argument,"
. " the number of entries was not odd.\n")
unless ( scalar( @in_clauses ) % 2 );
my $final_else = pop @in_clauses;
my $retval = undef;
my $have_match = undef;
ITERATIONS:
while ( @in_clauses ){
my $match_clause = shift @in_clauses;
my $then_clause = shift @in_clauses;
my $result = $vault->reval( $selector . $match_clause );
if ( my $error = $@ ){
# safe reval error...clean up the error message then
# elog() and ignore it, then move on and try the next
# set of match/result clauses...
$error =~ s/ at line.+//;
$error =~ s/trapped.+/deemed unsafe/;
chomp $error;
elog( NOTICE , "pl.decode(): potentially dangerous "
. "operation found, "
. $error
. ", skipping clause..."
);
next ITERATIONS;
}
if ( $result ){
# we have the winner...set $retval and bail out...
# we only grab the first true result...
$retval = $then_clause;
$have_match = "yes";
last ITERATIONS;
}
# no $result? oh well try the next set...
}
if ( defined( $have_match ) ){
# last check to see if we've matched anything...
# and if so return it...accounting for the case where
# the wanted return is NULL...
if ( $retval =~ m/^ (?: null || undef ) \( \) $ /ix ) {
$retval=undef;
}
return $retval;
}
# if we get here we are returning the "default" result value
return $final_else;
$BODY$
LANGUAGE 'plperlu' IMMUTABLE SECURITY DEFINER;
COMMENT ON FUNCTION pl.decode(selector text, clauses text) IS '
#############################################
## decode( selector text , clauses text )
## plperlu rendition of Oracle''s decode() function. Takes 2 args:
## the item to check, and a double comma (,,) separated string
## listing of items to match and items to return if the match is
## successful. The last entry in the string is the final "else"
## return value. The match sections may include boolean
## operations.
##
## USE DOLLAR QUOTING to setup the test/result string, it WILL save
## you much hair pulling.
##
## If you want a return item to be NULL for an option, use one of the
## following (case INSENSITVE) return values:
## null() or
## undef()
##
## provides its own Safe.pm compartment for the reevalution of the
## match clauses
##
#############################################
';
Ack! Should at least pull the current version from the database:
This version also correctly checks the "default" return value for a
possible return of a wanted NULL value. (The part just ahead of "return
$final_else;".
/*******************************************************************/
CREATE OR REPLACE FUNCTION pl.decode(selector text, clauses text)
RETURNS text AS
$BODY$
use Safe;
my $vault;
# get / setup a safe "vault" from / in %_SHARED to reduce function
start up time on a per session level
if ( exists( $_SHARED{pl_vault} ) && defined( $_SHARED{pl_vault} ) ){
$vault = $_SHARED{pl_vault};
#elog( NOTICE , "plperlu: Preloaded safety vault being used." );
}
else {
# setup a safe vault using the same parameters as the SAFE_OK macro in
postgresql's
#
http://developer.postgresql.org/cvsweb.cgi/pgsql/src/pl/plperl/plperl.c?rev=1.105
$vault = Safe->new;
$vault->permit_only( qw/ :default :base_math !:base_io time sort / );
$_SHARED{pl_vault} = $vault;
#elog( NOTICE , "plperlu: Setting up session safety vault.");
}
my $selector = $_[0];
my @in_clauses = split( /,,/ , $_[1] );
#reject @in_clauses argument if it doesn't contain an odd number of
entries: ie -
# ( '>10' , 'return#1' , 'final else' ) or ( '>10' ,
'return#1' , '<10' , 'return#2' , 'final else' ) is OK
# ( '>10' , 'return#1' ) is not
die "pl.decode(): invalid clause argument, the number of entries was
not odd.\n"
unless ( scalar( @in_clauses ) % 2 );
my $final_else = pop @in_clauses;
my $retval = undef;
my $have_match = undef;
ITERATIONS:
while ( @in_clauses ){
my $match_clause = shift @in_clauses;
my $then_clause = shift @in_clauses;
my $result = $vault->reval( $selector . $match_clause );
if ( my $error = $@ ){
# safe reval error...clean up the error message then elog() and ignore
it, then move on and try the next set of match/result clauses...
$error =~ s/ at line.+//;
$error =~ s/trapped.+/deemed unsafe/;
chomp $error;
elog( NOTICE , "pl.decode(): potentially dangerous operation found, "
. $error
. ", skipping clause..."
);
next ITERATIONS;
}
if ( $result ){ # we have the winner...set $retval and bail out...we
only grab the first true result...
$retval = $then_clause;
$have_match = "yes";
last ITERATIONS;
}
# no $result? oh well try the next set...
}
if ( defined( $have_match ) ){
# last check to see if we've matched anything...
# and if so return it...accounting for the case where
# the wanted return is NULL...
if ( $retval =~ m/^ (?: null || undef ) \( \) $ /ix ) {
$retval=undef;
}
return $retval;
}
# if we get here we are returning the "default" result value
# also accounting for the case where the wanted return is NULL...
if ( $final_else =~ m/^ (?: null || undef ) \( \) $ /ix ) {
$final_else=undef;
}
return $final_else;
$BODY$
LANGUAGE 'plperlu' IMMUTABLE SECURITY DEFINER;
COMMENT ON FUNCTION pl.decode(selector text, clauses text) IS '
#############################################
## decode( selector text , clauses text )
## plperlu rendition of Oracle''s decode()
function. Takes 2 args:
## the item to check, and a double comma (,,)
separated string
## listing of items to match and items to return
if the match is successful.
## The last entry in the string is the final
"else" return value. The match
## sections may include boolean operations. USE
DOLLAR
## QUOTING to setup the test/result string, it
WILL save you much hair pulling.
##
## If you want a return item to be NULL for an
option, use one of the
## following (case INSENSITVE) return values:
## null() or
## undef()
##
## provides its own Safe.pm compartment for the reevalution of the
match clauses
##
#############################################
';