Reprise of Oracle decode functionality...now with nifty plperlu (and two cupholders) - Mailing list pgsql-general

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
##
#############################################
';