view release on metacpan or  search on metacpan

lib/PostgreSQL/PLPerl/Call.pm  view on Meta::CPAN

sub call {
    my $sig = shift;

    my $arity = scalar @_; # argument count to handle variadic subs

    my $how = $sig_cache{"$sig.$arity"} ||= do {

        # get a normalized signature to recheck the cache with
        # and also extract the SP name and argument types
        my ($stdsig, $fullspname, $spname, $arg_types) = _parse_signature($sig, $arity)
            or croak "Can't parse '$sig'";
        warn "parsed call($sig) => $stdsig\n"
            if $debug;

        # recheck the cache with with the normalized signature
        $sig_cache{"$stdsig.$arity"} ||= [ # else a new entry (for both caches)
            $spname,     # is name of column for single column results
            scalar _mk_process_args($arg_types),
            scalar _mk_process_call($fullspname, $arity, $arg_types),
            $fullspname, # is name used in SQL to make the call
            $stdsig,
        ];
    };

    my ($spname, $prepargs, $callsub) = @$how;

    my $rv = $callsub->( $prepargs ? $prepargs->(@_) : @_ );

    my $rows = $rv->{rows};
    my $row1 = $rows->[0] # peek at first row
        or return;        # no row: undef in scalar context else empty list

lib/PostgreSQL/PLPerl/Call.pm  view on Meta::CPAN

    # the full name is what's left in sig
    my $fullspname = $sig;

    # extract the function name and un-escape it to get the column name
    (my $spname = $fullspname) =~ s/.*\.//; # remove schema, if any
    if ($spname =~ s/^"(.*)"$/$1/) { # unescape
        $spname =~ s/""/"/;
    }

    # compose a normalized signature
    my $stdsig = "$fullspname".
        ($arg_types ? "(".join(",",@$arg_types).")" : "");

    return ($stdsig, $fullspname, $spname, $arg_types);
}


sub _mk_process_args {
    my ($arg_types) = @_;

    return undef unless $arg_types;

    # return a closure that pre-processes the arguments of the call
    # else undef if no argument pre-processing is required