[Catalyst] Adding Functionality to Class::DBI::Sweet for Oracle

[Anthony Lee]

Appologies if this is going to the wrong mailing list,

I've subclassed Catalyst::Model::CDBI::Sweet to support Oracle paging. I am
not entirely sure this works, but wondered how I can get this into the main
distribution if it does work. I've tried to make paging work in Oracle via a
subselect like (see code below):-

 select __ESSENTIAL__ FROM
	( SELECT ROWNUM N, C.* FROM __TABLE__ C WHERE ROWNUM <= ($rownum+$offset)
AND $sql )
 WHERE N > $offset

Does this make sense ??

Secondly, can somebody tell me if the caching in CDBI::Sweet, works with
HAS_A relationships. I presume the Cache::FastMmap only stores the
individual deflated object, and when I call the relationship method the
foreign object is inflated via a cache ( and everything just works ??)
e.g

package MyApp::COMP;
use base qw[Class::DBI::Sweet];

__PACKAGE__->table('component');
__PACKAGE__->columns(Essential=>qw/componentid componentname parentid/);
__PACKAGE__->cache(Cache::FastMmap->new());
__PACKAGE__->has_a(parent=>'MyApp::COMP');

=====================

use MyApp::COMP;

$obj=MyApp::COMP->retrieve($id);
while ($obj && $obj->parentid->id != 0) {
 print $obj->componentname;
 $obj=$obj->parentid;
}

I have something very similar above, except $obj->parentid doesn't always
seem to return a blessed object. However when I remove the
__PACKAGE__->cache statement my app code always seems to work.

Any comments much appreciated.

Anthony


<<CODE FOR SUPPORTING ORACLE within CDBI::Sweet>>


package <PACKAGE>::SweetOracle;
use strict;
use base qw[Class::DBI::Sweet Catalyst::Base];
our $VERSION = '0.01';

*new = \&Catalyst::Base::new;

__PACKAGE__->set_sql( SweetOracleRetrieve => <<'SQL' );
SELECT __ESSENTIAL__
FROM   %s
WHERE  %s
SQL

sub search {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my ( $criteria, $attributes ) = $class->_search_args(@_);

    my ( $sql, $columns, $values, $table ) = $proto->_search( $criteria,
$attributes );
    my $sth = $class->sql_SweetOracleRetrieve($table,$sql);
    $class->_bind_param( $sth, $columns );
    my $iterator = $class->sth_to_objects( $sth, $values );

    # If RDBM is not ROWS/OFFSET supported, slice iterator
    if ( $attributes->{rows} && $iterator->count > $attributes->{rows} ) {
        my $rows   = $attributes->{rows};
        my $offset = $attributes->{offset} || 0;

        $iterator = $iterator->slice( $offset, $offset + $rows - 1 );
    }
    return map $class->construct($_), $iterator->data if wantarray;
    return $iterator;
}



sub _search {
    my $proto      = shift;
    my $criteria   = shift;
    my $attributes = shift;
    my $class      = ref($proto) || $proto;

    # Valid SQL::Abstract params
    my %params = map { $_ => $attributes->{$_} } qw(case cmp convert logic);
    my $table=$class->table;

    # Overide bindtype, we need all columns and values for deflating
    my $abstract = SQL::Abstract->new( %params, bindtype => 'columns' );

    my ( $sql, @bind ) = $abstract->where( $criteria,
$attributes->{order_by} );

    my ( @columns, @values, %cache );

    while ( my $bind = shift(@bind) ) {

        my $col    = shift(@$bind);
        my $column = $cache{$col};

        unless ($column) {

            $column = $class->find_column($col)
              || ( List::Util::first { $_->accessor eq $col }
$class->columns )
              || $class->_croak("$col is not a column of $class");

            $cache{$col} = $column;
        }

        while ( my $value = shift(@$bind) ) {
            push( @columns, $column );
            push( @values, $class->_deflated_column( $column, $value ) );
        }
    }

    unless ($attributes->{rows} ) {
        # If paging is not required.
        unless ( $sql =~ /^\s*WHERE/i ) {
                $sql = "WHERE 1=1 $sql"
        }
    } else {

        my $rows   = $attributes->{rows};
        my $offset = $attributes->{offset} || 0;
        my $driver = $class->db_Main->{Driver}->{Name};

        if ( $driver =~ /^Oracle$/ ) {
            unless ( $sql =~ /^\s*WHERE/i ) {
                $table = qq/( SELECT ROWNUM N, C.* FROM $table C WHERE
ROWNUM <= ? $sql )/;
                push( @columns,'__ROWS');
                push( @values, $offset + $rows);
            } else {
                $sql =~s|WHERE||;
                $table = qq/( SELECT ROWNUM N, C.* FROM $table C WHERE
ROWNUM <= ? AND $sql )/;
                unshift( @columns,'__ROWS');
                unshift( @values, $offset + $rows);
            }
            $sql = "WHERE N > ?";
            push (@columns,'__OFFSET');
            push (@values,$offset);
        } else {
                # Original Logic to Add WHERE CONDITION
                unless ( $sql =~ /^\s*WHERE/i ) {
                        $sql = "WHERE 1=1 $sql"
                }
        }
        if ( $driver =~ /^(maxdb|mysql|mysqlpp)$/ ) {
            $sql .= ' LIMIT ?, ?';
            push( @columns, '__OFFSET', '__ROWS' );
            push( @values, $offset, $rows );
        }

        if ( $driver =~ /^(pg|pgpp|sqlite|sqlite2)$/ ) {
            $sql .= ' LIMIT ?, OFFSET ?';
            push( @columns, '__ROWS', '__OFFSET' );
            push( @values, $rows, $offset );
        }

        if ( $driver =~ /^(interbase)$/ ) {
            $sql .= ' ROWS ? TO ?';
            push( @columns, '__ROWS', '__OFFSET' );
            push( @values, $rows, $offset + $rows );
        }
    }

    $sql =~ s/^\s*(WHERE)\s*//i;
    return ( $sql, \@columns, \@values ,$table);
}


1;