lib/DBIx/Class/Storage/DBI/Firebird/Common.pm

   1 package DBIx::Class::Storage::DBI::Firebird::Common;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/DBIx::Class::Storage::DBI/;
   6 use mro 'c3';
   7
   8 =head1 NAME
   9
  10 DBIx::Class::Storage::DBI::Firebird::Common - Driver Base Class for the Firebird RDBMS
  11
  12 =head1 DESCRIPTION
  13
  14 This class implements autoincrements for Firebird using C<RETURNING> as well as
  15 L<auto_nextval|DBIx::Class::ResultSource/auto_nextval>, savepoints and server
  16 version detection.
  17
  18 =cut
  19
  20 # set default
  21 __PACKAGE__->_use_insert_returning (1);
  22 __PACKAGE__->sql_limit_dialect ('FirstSkip');
  23 __PACKAGE__->sql_quote_char ('"');
  24
  25 __PACKAGE__->datetime_parser_type(
  26   'DBIx::Class::Storage::DBI::InterBase::DateTime::Format'
  27 );
  28
  29 sub sqlt_type {
  30   return 'Firebird';
  31 }
  32
  33 sub _sequence_fetch {
  34   my ($self, $nextval, $sequence) = @_;
  35
  36   $self->throw_exception("Can only fetch 'nextval' for a sequence")
  37     if $nextval !~ /^nextval$/i;
  38
  39   $self->throw_exception('No sequence to fetch') unless $sequence;
  40
  41   my ($val) = $self->_get_dbh->selectrow_array(sprintf
  42     'SELECT GEN_ID(%s, 1) FROM rdb$database',
  43     $self->sql_maker->_quote($sequence)
  44   );
  45
  46   return $val;
  47 }
  48
  49 sub _dbh_get_autoinc_seq {
  50   my ($self, $dbh, $source, $col) = @_;
  51
  52   my $table_name = $source->from;
  53   $table_name    = $$table_name if ref $table_name;
  54   $table_name    = $self->sql_maker->quote_char ? $table_name : uc($table_name);
  55
  56   local $dbh->{LongReadLen} = 100000;
  57   local $dbh->{LongTruncOk} = 1;
  58
  59   my $sth = $dbh->prepare(<<'EOF');
  60 SELECT t.rdb$trigger_source
  61 FROM rdb$triggers t
  62 WHERE t.rdb$relation_name = ?
  63 AND t.rdb$system_flag = 0 -- user defined
  64 AND t.rdb$trigger_type = 1 -- BEFORE INSERT
  65 EOF
  66   $sth->execute($table_name);
  67
  68   while (my ($trigger) = $sth->fetchrow_array) {
  69     my @trig_cols = map
  70       { /^"([^"]+)/ ? $1 : uc($_) }
  71       $trigger =~ /new\.("?\w+"?)/ig
  72     ;
  73
  74     my ($quoted, $generator) = $trigger =~
  75 /(?:gen_id\s* \( \s* |next \s* value \s* for \s*)(")?(\w+)/ix;
  76
  77     if ($generator) {
  78       $generator = uc $generator unless $quoted;
  79
  80       return $generator
  81         if grep {
  82           $self->sql_maker->quote_char ? ($_ eq $col) : (uc($_) eq uc($col))
  83         } @trig_cols;
  84     }
  85   }
  86
  87   return undef;
  88 }
  89
  90 sub _exec_svp_begin {
  91   my ($self, $name) = @_;
  92
  93   $self->_dbh->do("SAVEPOINT $name");
  94 }
  95
  96 sub _exec_svp_release {
  97   my ($self, $name) = @_;
  98
  99   $self->_dbh->do("RELEASE SAVEPOINT $name");
 100 }
 101
 102 sub _exec_svp_rollback {
 103   my ($self, $name) = @_;
 104
 105   $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
 106 }
 107
 108 # http://www.firebirdfaq.org/faq223/
 109 sub _get_server_version {
 110   my $self = shift;
 111
 112   return $self->_get_dbh->selectrow_array(q{
 113 SELECT rdb$get_context('SYSTEM', 'ENGINE_VERSION') FROM rdb$database
 114   });
 115 }
 116
 117 package # hide from PAUSE
 118   DBIx::Class::Storage::DBI::InterBase::DateTime::Format;
 119
 120 my $timestamp_format = '%Y-%m-%d %H:%M:%S.%4N'; # %F %T
 121 my $date_format      = '%Y-%m-%d';
 122
 123 my ($timestamp_parser, $date_parser);
 124
 125 sub parse_datetime {
 126   shift;
 127   require DateTime::Format::Strptime;
 128   $timestamp_parser ||= DateTime::Format::Strptime->new(
 129     pattern  => $timestamp_format,
 130     on_error => 'croak',
 131   );
 132   return $timestamp_parser->parse_datetime(shift);
 133 }
 134
 135 sub format_datetime {
 136   shift;
 137   require DateTime::Format::Strptime;
 138   $timestamp_parser ||= DateTime::Format::Strptime->new(
 139     pattern  => $timestamp_format,
 140     on_error => 'croak',
 141   );
 142   return $timestamp_parser->format_datetime(shift);
 143 }
 144
 145 sub parse_date {
 146   shift;
 147   require DateTime::Format::Strptime;
 148   $date_parser ||= DateTime::Format::Strptime->new(
 149     pattern  => $date_format,
 150     on_error => 'croak',
 151   );
 152   return $date_parser->parse_datetime(shift);
 153 }
 154
 155 sub format_date {
 156   shift;
 157   require DateTime::Format::Strptime;
 158   $date_parser ||= DateTime::Format::Strptime->new(
 159     pattern  => $date_format,
 160     on_error => 'croak',
 161   );
 162   return $date_parser->format_datetime(shift);
 163 }
 164
 165 =head1 CAVEATS
 166
 167 =over 4
 168
 169 =item *
 170
 171 C<last_insert_id> support by default only works for Firebird versions 2 or
 172 greater, L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> however should
 173 work with earlier versions.
 174
 175 =back
 176
 177 =head1 FURTHER QUESTIONS?
 178
 179 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 180
 181 =head1 COPYRIGHT AND LICENSE
 182
 183 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 184 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 185 redistribute it and/or modify it under the same terms as the
 186 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 187
 188 =cut
 189
 190 1;
 191
 192 # vim:sts=2 sw=2: