extproc_perl 2.0 Examples

Example 1: Hello world!

The classic "Hello world" example, except that the hello() function takes a name as an argument.

sub hello
{
     my $name = shift;
     return "Hello, $name!";
}

__END__

FUNCTION hello(name IN VARCHAR2) RETURN VARCHAR2

SQL> select hello('Jeff') as response from dual;

RESPONSE
-------------------------------------------------------
Hello, Jeff!

Example 2: MD5 checksum

This function uses the Digest::MD5 module from CPAN to return the MD5 checksum of a string.

use Digest::MD5 qw(md5_hex);

sub md5
{
	return md5_hex($_[0]);
}

__END__

FUNCTION md5(data IN VARCHAR2) RETURN VARCHAR2

SQL> select md5('foobar') from dual;

MD5('FOOBAR')
-------------------------------------------
3858f62230ac3c915f300c664312c63f

Example 3: Stock Quote

This retrieves a live stock quote from Yahoo. It accepts the stock symbol as an argument. If you run this several times during normal trading hours on an active stock, the value may change with each query, as the quote is retrieved from the internet each time.

use Finance::Quote;

sub quote
{
        my $sym = shift;
        my $q = Finance::Quote->new();
        my %h = $q->yahoo($sym);
        return $h{$sym,'price'};
}

__END__

FUNCTION quote(symbol IN VARCHAR2) RETURN REAL

SQL> select quote('ORCL') from dual;

QUOTE('ORCL')
--------------------------------------------------------------------------------
12.29

SQL> /

QUOTE('ORCL')
--------------------------------------------------------------------------------
12.271

Example 4: Phone Number Trigger

Here we create a trigger on a phone number column that normalizes updated numbers into a common format of (XXX) XXX-XXXX. The ExtProc module is used so we can raise an Oracle exception if the initial format of the phone number is invalid. We also use an IN OUT parameter to both pass the value to Perl and return a result; note how $phone is a reference to a scalar. Perl's superior string handling shines through in this short but powerful example.

use ExtProc qw(ora_exception);

sub normalize_phone
{
        my $phone = shift;
        my ($a,$p,$n);
        if (${$phone} =~ /\(*(\d{3})\)*[\s\-\.]+(\d{3})\s*[\.\-]\s*(\d{4})/) {
                ($a,$p,$n) = ($1,$2,$3);
                ${$phone} = "($a) $p-$n";
        }
        ora_exception('invalid phone number');
}

__END__

PROCEDURE normalize_phone(phone IN OUT VARCHAR2)

SQL> create or replace trigger phoneval
  2>   before insert or update of phone
  3>    on contact
  4>   for each row
  5>   BEGIN
  6>     normalize_phone(:new.phone);
  7>   END;

Trigger created.

SQL> insert into contact (name,phone) values('John Doe','610.555.1212');

1 row created.

SQL> select * from contact;

NAME                                PHONE
----------------------------------- --------------
John Doe                            (610) 555-1212

SQL> insert into contact (name,phone) values('John Doe','610-ABC');
insert into contact (name,phone) values('John Doe','610-ABC')
            *
ERROR at line 1:
ORA-20100: PERL EXTPROC ERROR: invalid phone number
ORA-06512: at "JEFF.NORMALIZE_PHONE", line 0
ORA-06512: at "JEFF.PHONEVAL", line 2
ORA-04088: error during execution of trigger 'JEFF.PHONEVAL'

Example 5: Calculate the width of an image LOB in the database

The width() function below takes an ID as an argument which is used to query a table containing image data. The function uses the dbi_connect method provided by the ExtProc module to connect back to the calling database, and then retrieves the image LOB using standard DBI methods. The GD module is used to calculate the width of the image and the result is returned to the caller. Any errors encountered along the way are handled with Oracle exceptions.

use DBI;
use ExtProc qw(ora_exception);
use GD;

sub width
{
        my ($id) = @_;
        if ($id =~ /([\w\._\-]+)/) {
                $id = $1;
        }
        else {
                ora_exception("bad id format");
                return undef;
        }
        my $e = ExtProc->new;
        my $dbh = $e->dbi_connect();
        unless ($dbh) {
                ora_exception("DBI error=".DBI->errstr);
                return undef;
        }
        local $dbh->{LongReadLen} = 65536;
        my $sth = $dbh->prepare('select data from images where id = ?');
        unless ($sth) {
                ora_exception("DBI error=".DBI->errstr);
                return undef;
        }
        $sth->execute($id);
        my ($data) = $sth->fetchrow_array;
        $dbh->{LongReadLen} = 80;
        $sth->finish;
        my $image = GD::Image->new($data);
        my ($width) = $image->getBounds;
        return $width;
}

__END__

FUNCTION width(id IN VARCHAR2) RETURN PLS_INTEGER

SQL> describe images;
Name                                      Null?    Type
----------------------------------------- -------- ----------------------------
ID                                                 VARCHAR2(255)
DATA                                               BLOB

SQL> select width('apache_pb.png') from dual;

WIDTH('APACHE_PB.PNG')
--------------------------------------------------------------------------------
259