lib/DBIx/Class/Storage/DBI/InterBase.pm

   1 package DBIx::Class::Storage::DBI::InterBase;
   2
   3 # partly stolen from DBIx::Class::Storage::DBI::MSSQL
   4
   5 use strict;
   6 use warnings;
   7 use base qw/DBIx::Class::Storage::DBI/;
   8 use mro 'c3';
   9 use List::Util();
  10
  11 __PACKAGE__->mk_group_accessors(simple => qw/
  12   _fb_auto_incs
  13 /);
  14
  15 sub _prep_for_execute {
  16   my $self = shift;
  17   my ($op, $extra_bind, $ident, $args) = @_;
  18
  19   my ($sql, $bind) = $self->next::method (@_);
  20
  21   if ($op eq 'insert') {
  22     my $quote_char = $self->sql_maker->quote_char || '"';
  23
  24     my @auto_inc_cols =
  25       grep $ident->column_info($_)->{is_auto_increment}, $ident->columns;
  26
  27     if (@auto_inc_cols) {
  28       my $auto_inc_cols =
  29         join ', ',
  30 # XXX quoting the columns breaks ODBC
  31 #      map qq{${quote_char}${_}${quote_char}},
  32         @auto_inc_cols;
  33
  34       $sql .= " RETURNING ($auto_inc_cols)";
  35
  36       $self->_fb_auto_incs([]);
  37       $self->_fb_auto_incs->[0] = \@auto_inc_cols;
  38     }
  39   }
  40
  41   return ($sql, $bind);
  42 }
  43
  44 sub _execute {
  45   my $self = shift;
  46   my ($op) = @_;
  47
  48   my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
  49
  50   if ($op eq 'insert') {
  51     local $@;
  52     my (@auto_incs) = eval {
  53       local $SIG{__WARN__} = sub {};
  54       $sth->fetchrow_array
  55     };
  56     $self->_fb_auto_incs->[1] = \@auto_incs;
  57     $sth->finish;
  58   }
  59
  60   return wantarray ? ($rv, $sth, @bind) : $rv;
  61 }
  62
  63 sub last_insert_id {
  64   my ($self, $source, @cols) = @_;
  65   my @result;
  66
  67   my %auto_incs;
  68   @auto_incs{ @{ $self->_fb_auto_incs->[0] } } =
  69     @{ $self->_fb_auto_incs->[1] };
  70
  71   push @result, $auto_incs{$_} for @cols;
  72
  73   return @result;
  74 }
  75
  76 # this sub stolen from DB2
  77
  78 sub _sql_maker_opts {
  79   my ( $self, $opts ) = @_;
  80
  81   if ( $opts ) {
  82     $self->{_sql_maker_opts} = { %$opts };
  83   }
  84
  85   return { limit_dialect => 'FirstSkip', %{$self->{_sql_maker_opts}||{}} };
  86 }
  87
  88 1;