From a18523bed0ed4eeac01fdb099cdd68a79d7065d0 Mon Sep 17 00:00:00 2001 From: Laurent Dami Date: Fri, 16 Dec 2011 18:35:30 +0100 Subject: [PATCH] v2.07: new class Statement::Oracle, support for scrollable cursors using new SQLA::More API for insert/update/delete, --- Changes | 2 + MANIFEST | 1 + lib/DBIx/DataModel.pm | 2 +- lib/DBIx/DataModel/Statement.pm | 8 +- lib/DBIx/DataModel/Statement/Oracle.pm | 174 +++++++++++++++++++++++++ t/00-load.t | 3 +- 6 files changed, 185 insertions(+), 5 deletions(-) create mode 100644 lib/DBIx/DataModel/Statement/Oracle.pm diff --git a/Changes b/Changes index 1289c9f..045eea2 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,8 @@ Revision history for Perl extension DBIx::DataModel. +v2.07 16.12.2011 - using new SQLA::More API for insert/update/delete + - new class Statement::Oracle, support for scrollable cursors v2.06 07.12.2011 - new method Path::opposite() diff --git a/MANIFEST b/MANIFEST index 949f81c..bfbaf0e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -29,6 +29,7 @@ lib/DBIx/DataModel/Source/Join.pm lib/DBIx/DataModel/Source/Table.pm lib/DBIx/DataModel/Statement.pm lib/DBIx/DataModel/Statement/JDBC.pm +lib/DBIx/DataModel/Statement/Oracle.pm MANIFEST This list of files META.json META.yml diff --git a/lib/DBIx/DataModel.pm b/lib/DBIx/DataModel.pm index 8718d84..452e3a4 100644 --- a/lib/DBIx/DataModel.pm +++ b/lib/DBIx/DataModel.pm @@ -8,7 +8,7 @@ use warnings; use strict; use MRO::Compat (); # don't want to call MRO::Compat::import() -our $VERSION = '2.06'; +our $VERSION = '2.07'; # compatibility setting : see import(); for the moment, automatic compat 1.0 our $COMPATIBILITY = 1.0; diff --git a/lib/DBIx/DataModel/Statement.pm b/lib/DBIx/DataModel/Statement.pm index 2fcefab..28778b9 100644 --- a/lib/DBIx/DataModel/Statement.pm +++ b/lib/DBIx/DataModel/Statement.pm @@ -11,7 +11,7 @@ use List::MoreUtils qw/firstval any/; use Scalar::Util qw/weaken refaddr reftype dualvar/; use Storable qw/dclone freeze/; use Params::Validate qw/validate ARRAYREF HASHREF/; -use POSIX qw/INT_MAX/; +use POSIX qw/LONG_MAX/; use Acme::Damn qw/damn/; use DBIx::DataModel; @@ -338,7 +338,9 @@ sub prepare { my $method = $self->{args}{-dbi_prepare_method} || $self->schema->dbi_prepare_method; my @prepare_args = ($self->{sql}); - push @prepare_args, $self->{prepare_attrs} if $self->{prepare_attrs}; + if (my $prepare_attrs = $self->{args}{-prepare_attrs}) { + push @prepare_args, $prepare_attrs; + } $self->{sth} = $dbh->$method(@prepare_args); # new status and return @@ -583,7 +585,7 @@ sub all { } -sub page_size { shift->{args}{-page_size} || POSIX::INT_MAX } +sub page_size { shift->{args}{-page_size} || POSIX::LONG_MAX } sub page_index { shift->{args}{-page_index} || 1 } sub offset { shift->{offset} || 0 } diff --git a/lib/DBIx/DataModel/Statement/Oracle.pm b/lib/DBIx/DataModel/Statement/Oracle.pm new file mode 100644 index 0000000..d5ce585 --- /dev/null +++ b/lib/DBIx/DataModel/Statement/Oracle.pm @@ -0,0 +1,174 @@ +#---------------------------------------------------------------------- +package DBIx::DataModel::Statement::Oracle; +#---------------------------------------------------------------------- +use strict; +use warnings; +no strict 'refs'; + +use parent qw/DBIx::DataModel::Statement/; +use mro qw/c3/; +use DBD::Oracle qw/:ora_fetch_orient :ora_exe_modes/; +use Carp; +use POSIX qw/LONG_MAX/; + +sub sqlize { + my ($self, @args) = @_; + + # merge new args into $self->{args} + $self->refine(@args) if @args; + + # remove -limit and -offset from args; they will be handled later in + # prepare() and execute(), see below + $self->{_ora_limit} = delete $self->{args}{-limit}; + $self->{offset} = delete $self->{args}{-offset}; + $self->{offset} = 0 if defined $self->{_ora_limit} + && ! defined $self->{offset}; + $self->refine(-prepare_attrs => {ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY}) + if defined $self->{offset}; + + $self->next::method(); +} + +sub execute { + my ($self, @args) = @_; + $self->next::method(@args); + + if (my $offset = $self->{offset}) { + $self->{sth}->ora_fetch_scroll(OCI_FETCH_ABSOLUTE, $offset+1) + } + + return $self; +} + + + +sub next { + my ($self, $n_rows) = @_; + + # execute the statement + $self->execute if $self->{status} < DBIx::DataModel::Statement::EXECUTED; + + # fallback to regular handling if didn't use -limit/-offset + return $self->next::method($n_rows) if ! defined $self->{offset}; + + # how many rows to retrieve + $n_rows //= 1; # if undef, user wants 1 row + $n_rows > 0 or croak "->next() : invalid argument, $n_rows"; + if ($self->{_ora_limit}) { + my $row_num = $self->row_num; + my $max = $self->{_ora_limit} - ($row_num - $self->offset); + $n_rows = $max if $max < $n_rows; + } + + # various data for generating rows + my $sth = $self->{sth} or croak "absent sth in statement"; + my $hash_key_name = $sth->{FetchHashKeyName} || 'NAME'; + my $cols = $sth->{$hash_key_name}; + my @rows; + + # fetch the rows + ROW: + while ($n_rows--) { + # build a data row + my %row; + my $old_pos = $self->{row_num} || 0; + @row{@$cols} = @{$sth->ora_fetch_scroll(OCI_FETCH_NEXT, 0)}; + + # only way to know if this row was fresh : ask for the cursor position + my $new_pos = $sth->ora_scroll_position(); + if ($new_pos == $old_pos) { + $self->{row_count} = $new_pos; + last ROW; + } + + # here we really got a fresh row, so add it to results + push @rows, \%row; + $self->{row_num} += 1; + } + + my $callback = $self->{row_callback} or croak "absent callback in statement"; + $callback->($_) foreach @rows; + return \@rows; +} + + +sub all { + my ($self) = @_; + + # just call next() with a huge number + return $self->next(POSIX::LONG_MAX); +} + + +sub row_count { + my ($self) = @_; + + # execute the statement + $self->execute if $self->{status} < DBIx::DataModel::Statement::EXECUTED; + + # fallback to regular handling if didn't use -limit/-offset + return $self->next::method() if ! defined $self->{offset}; + + if (! exists $self->{row_count}) { + my $sth = $self->{sth}; + # remember current position + my $current_pos = $sth->ora_scroll_position(); + + # goto last position and get the line number + $sth->ora_fetch_scroll(OCI_FETCH_LAST, 0); + $self->{row_count} = $sth->ora_scroll_position(); + + # back to previous position (hack: first line must be 1, not 0) + $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE, $current_pos || 1); + } + + return $self->{row_count}; +} + +1; + +__END__ + +=head1 NAME + +DBIx::DataModel::Statement::Oracle - Statement for interacting with DBD::Oracle + +=head1 SYNOPSIS + + DBIx::DataModel->Schema("MySchema", + statement_class => "DBIx::DataModel::Statement::Oracle", + ); + + my $statement = $source->select( + ..., + -limit => 50, + -offset => 200, + -result_as => 'statement, + ); + my $total_rows = $statement->row_count; + my $row_slice = $statement->all; + +=head1 DESCRIPTION + +This subclass redefines some parent methods +from L in order to take advantage +of L. + +This is interesting for applications that need to do pagination +within result sets, because Oracle has no support for LIMIT/OFFSET in SQL. +So here we use some special methods of the Oracle driver to retrieve +the total number of rows in a resultset, or to extract a given +slice of rows. + +The API is exactly the same as other, regular DBIx::DataModel implementations. + +=head1 AUTHOR + +Laurent Dami, Elaurent.dami AT etat ge chE, Dec 2011. + +=head1 COPYRIGHT AND LICENSE + +Copyright 2011 by Laurent Dami. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. diff --git a/t/00-load.t b/t/00-load.t index d528935..eb1f433 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -1,6 +1,6 @@ #!perl -T -use Test::More tests => 16; +use Test::More tests => 17; BEGIN { use_ok( 'DBIx::DataModel', -compatibility => undef ); @@ -19,6 +19,7 @@ BEGIN { use_ok( 'DBIx::DataModel::Source::Table' ); use_ok( 'DBIx::DataModel::Statement' ); use_ok( 'DBIx::DataModel::Statement::JDBC' ); + use_ok( 'DBIx::DataModel::Statement::Oracle' ); } diag( "Testing DBIx::DataModel $DBIx::DataModel::VERSION, Perl $], $^X" );