Permalink
Browse files

v2.07: new class Statement::Oracle, support for scrollable cursors

       using new SQLA::More API for insert/update/delete,
  • Loading branch information...
1 parent 8cf7024 commit a18523bed0ed4eeac01fdb099cdd68a79d7065d0 @damil committed Dec 16, 2011
Showing with 185 additions and 5 deletions.
  1. +2 −0 Changes
  2. +1 −0 MANIFEST
  3. +1 −1 lib/DBIx/DataModel.pm
  4. +5 −3 lib/DBIx/DataModel/Statement.pm
  5. +174 −0 lib/DBIx/DataModel/Statement/Oracle.pm
  6. +2 −1 t/00-load.t
View
@@ -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()
View
@@ -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
View
@@ -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;
@@ -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 }
@@ -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<DBIx::DataModel::Statement> in order to take advantage
+of L<DBD::Oracle/"Scrollable Cursor Methods">.
+
+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, E<lt>laurent.dami AT etat ge chE<gt>, 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.
View
@@ -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" );

0 comments on commit a18523b

Please sign in to comment.