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   _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 @pk = $ident->primary_columns;
  23     my %pk;
  24     @pk{@pk} = ();
  25
  26     my @auto_inc_cols = grep {
  27       my $inserting = $args->[0]{$_};
  28
  29       ($ident->column_info($_)->{is_auto_increment}
  30         || exists $pk{$_})
  31       && (
  32         (not defined $inserting)
  33         ||
  34         (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
  35       )
  36     } $ident->columns;
  37
  38     if (@auto_inc_cols) {
  39       my $auto_inc_cols =
  40         join ', ',
  41         map $self->_quote_column_for_returning($_), @auto_inc_cols;
  42
  43       $sql .= " RETURNING ($auto_inc_cols)";
  44
  45       $self->_auto_incs([]);
  46       $self->_auto_incs->[0] = \@auto_inc_cols;
  47     }
  48   }
  49
  50   return ($sql, $bind);
  51 }
  52
  53 sub _quote_column_for_returning {
  54   my ($self, $col) = @_;
  55
  56   return $self->sql_maker->_quote($col);
  57 }
  58
  59 sub _execute {
  60   my $self = shift;
  61   my ($op) = @_;
  62
  63   my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
  64
  65   if ($op eq 'insert' && $self->_auto_incs) {
  66     local $@;
  67     my (@auto_incs) = eval {
  68       local $SIG{__WARN__} = sub {};
  69       $sth->fetchrow_array
  70     };
  71     $self->_auto_incs->[1] = \@auto_incs;
  72     $sth->finish;
  73   }
  74
  75   return wantarray ? ($rv, $sth, @bind) : $rv;
  76 }
  77
  78 sub last_insert_id {
  79   my ($self, $source, @cols) = @_;
  80   my @result;
  81
  82   my %auto_incs;
  83   @auto_incs{ @{ $self->_auto_incs->[0] } } =
  84     @{ $self->_auto_incs->[1] };
  85
  86   push @result, $auto_incs{$_} for @cols;
  87
  88   return @result;
  89 }
  90
  91 # this sub stolen from DB2
  92
  93 sub _sql_maker_opts {
  94   my ( $self, $opts ) = @_;
  95
  96   if ( $opts ) {
  97     $self->{_sql_maker_opts} = { %$opts };
  98   }
  99
 100   return { limit_dialect => 'FirstSkip', %{$self->{_sql_maker_opts}||{}} };
 101 }
 102
 103 sub datetime_parser_type { __PACKAGE__ }
 104
 105 my ($datetime_parser, $datetime_formatter);
 106
 107 sub parse_datetime {
 108     shift;
 109     require DateTime::Format::Strptime;
 110     $datetime_parser ||= DateTime::Format::Strptime->new(
 111         pattern => '%a %d %b %Y %r',
 112 # there should be a %Z (TZ) on the end, but it's ambiguous and not parsed
 113         on_error => 'croak',
 114     );
 115     $datetime_parser->parse_datetime(shift);
 116 }
 117
 118 sub format_datetime {
 119     shift;
 120     require DateTime::Format::Strptime;
 121     $datetime_formatter ||= DateTime::Format::Strptime->new(
 122         pattern => '%F %H:%M:%S.%4N',
 123         on_error => 'croak',
 124     );
 125     $datetime_formatter->format_datetime(shift);
 126 }
 127
 128 1;