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