move INSERT ... RETURNING code into ::DBI::InsertReturning component for Pg and Firebird
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage / DBI / InterBase.pm
CommitLineData
88a8d0fa 1package DBIx::Class::Storage::DBI::InterBase;
2
88a8d0fa 3use strict;
4use warnings;
be860760 5use base qw/DBIx::Class::Storage::DBI::InsertReturning/;
88a8d0fa 6use mro 'c3';
88a8d0fa 7use List::Util();
8
90489c23 9=head1 NAME
10
11DBIx::Class::Storage::DBI::InterBase - Driver for the Firebird RDBMS
12
13=head1 DESCRIPTION
14
95570280 15This class implements autoincrements for Firebird using C<RETURNING> as well as
16L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> sets the limit dialect to
17C<FIRST X SKIP X> and provides L<DBIx::Class::InflateColumn::DateTime> support.
90489c23 18
dd2109ee 19You need to use either the
20L<disable_sth_caching|DBIx::Class::Storage::DBI/disable_sth_caching> option or
21L</connect_call_use_softcommit> (see L</CAVEATS>) for your code to function
47ec67c3 22correctly with this driver. Otherwise you will likely get bizarre error messages
d1fc96c7 23such as C<no statement executing>. The alternative is to use the
24L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird> driver, which is more suitable
25for long running processes such as under L<Catalyst>.
90489c23 26
c5827074 27To turn on L<DBIx::Class::InflateColumn::DateTime> support, see
28L</connect_call_datetime_setup>.
32323fc2 29
90489c23 30=cut
31
e1958268 32sub _sequence_fetch {
33 my ($self, $nextval, $sequence) = @_;
34
35 if ($nextval ne 'nextval') {
36 $self->throw_exception("Can only fetch 'nextval' for a sequence");
37 }
38
39 $self->throw_exception('No sequence to fetch') unless $sequence;
40
41 my ($val) = $self->_get_dbh->selectrow_array(
42'SELECT GEN_ID(' . $self->sql_maker->_quote($sequence) .
43', 1) FROM rdb$database');
44
45 return $val;
46}
47
48sub _dbh_get_autoinc_seq {
49 my ($self, $dbh, $source, $col) = @_;
50
51 my $table_name = $source->from;
52 $table_name = $$table_name if ref $table_name;
53 $table_name = $self->sql_maker->quote_char ? $table_name : uc($table_name);
54
55 local $dbh->{LongReadLen} = 100000;
56 local $dbh->{LongTruncOk} = 1;
57
58 my $sth = $dbh->prepare(<<'EOF');
59SELECT t.rdb$trigger_source
60FROM rdb$triggers t
61WHERE t.rdb$relation_name = ?
62AND t.rdb$system_flag = 0 -- user defined
63AND t.rdb$trigger_type = 1 -- BEFORE INSERT
64EOF
65 $sth->execute($table_name);
66
67 while (my ($trigger) = $sth->fetchrow_array) {
68 my @trig_cols = map {
69 /^"([^"]+)/ ? $1 : uc($1)
70 } $trigger =~ /new\.("?\w+"?)/ig;
71
72 my ($quoted, $generator) = $trigger =~
73/(?:gen_id\s* \( \s* |next \s* value \s* for \s*)(")?(\w+)/ix;
74
75 if ($generator) {
76 $generator = uc $generator unless $quoted;
77
78 return $generator
79 if List::Util::first {
80 $self->sql_maker->quote_char ? ($_ eq $col) : (uc($_) eq uc($col))
81 } @trig_cols;
82 }
83 }
84
85 return undef;
86}
87
145b2a3d 88# this sub stolen from DB2
88a8d0fa 89
145b2a3d 90sub _sql_maker_opts {
91 my ( $self, $opts ) = @_;
92
93 if ( $opts ) {
94 $self->{_sql_maker_opts} = { %$opts };
95 }
96
97 return { limit_dialect => 'FirstSkip', %{$self->{_sql_maker_opts}||{}} };
98}
99
32323fc2 100sub _svp_begin {
101 my ($self, $name) = @_;
102
103 $self->_get_dbh->do("SAVEPOINT $name");
104}
105
106sub _svp_release {
107 my ($self, $name) = @_;
108
109 $self->_get_dbh->do("RELEASE SAVEPOINT $name");
110}
111
112sub _svp_rollback {
113 my ($self, $name) = @_;
114
115 $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
116}
117
118sub _ping {
119 my $self = shift;
120
121 my $dbh = $self->_dbh or return 0;
122
123 local $dbh->{RaiseError} = 1;
ecdf1ac8 124 local $dbh->{PrintError} = 0;
32323fc2 125
126 eval {
127 $dbh->do('select 1 from rdb$database');
128 };
129
130 return $@ ? 0 : 1;
131}
132
9633951d 133# We want dialect 3 for new features and quoting to work, DBD::InterBase uses
134# dialect 1 (interbase compat) by default.
135sub _init {
136 my $self = shift;
137 $self->_set_sql_dialect(3);
138}
139
140sub _set_sql_dialect {
141 my $self = shift;
142 my $val = shift || 3;
143
144 my $dsn = $self->_dbi_connect_info->[0];
145
146 return if ref($dsn) eq 'CODE';
147
148 if ($dsn !~ /ib_dialect=/) {
149 $self->_dbi_connect_info->[0] = "$dsn;ib_dialect=$val";
150 my $connected = defined $self->_dbh;
151 $self->disconnect;
152 $self->ensure_connected if $connected;
153 }
154}
155
dd2109ee 156=head2 connect_call_use_softcommit
157
158Used as:
159
160 on_connect_call => 'use_softcommit'
161
162In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the
163L<DBD::InterBase> C<ib_softcommit> option.
164
165You need either this option or C<< disable_sth_caching => 1 >> for
47ec67c3 166L<DBIx::Class> code to function correctly (otherwise you may get C<no statement
d1fc96c7 167executing> errors.) Or use the L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird>
168driver.
dd2109ee 169
170The downside of using this option is that your process will B<NOT> see UPDATEs,
171INSERTs and DELETEs from other processes for already open statements.
172
173=cut
174
175sub connect_call_use_softcommit {
a499b173 176 my $self = shift;
177
178 $self->_dbh->{ib_softcommit} = 1;
a499b173 179}
180
32323fc2 181=head2 connect_call_datetime_setup
9cd0b325 182
32323fc2 183Used as:
9cd0b325 184
32323fc2 185 on_connect_call => 'datetime_setup'
186
f0f8ac86 187In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the date and
188timestamp formats using:
32323fc2 189
190 $dbh->{ib_time_all} = 'ISO';
191
192See L<DBD::InterBase> for more details.
193
194The C<TIMESTAMP> data type supports up to 4 digits after the decimal point for
195second precision. The full precision is used.
196
c5827074 197The C<DATE> data type stores the date portion only, and it B<MUST> be declared
198with:
199
200 data_type => 'date'
201
202in your Result class.
203
204Timestamp columns can be declared with either C<datetime> or C<timestamp>.
205
32323fc2 206You will need the L<DateTime::Format::Strptime> module for inflation to work.
207
208For L<DBIx::Class::Storage::DBI::ODBC::Firebird>, this is a noop and sub-second
209precision is not currently available.
210
211=cut
212
213sub connect_call_datetime_setup {
214 my $self = shift;
215
216 $self->_get_dbh->{ib_time_all} = 'ISO';
9cd0b325 217}
218
c5827074 219sub datetime_parser_type {
220 'DBIx::Class::Storage::DBI::InterBase::DateTime::Format'
221}
32323fc2 222
c5827074 223package # hide from PAUSE
224 DBIx::Class::Storage::DBI::InterBase::DateTime::Format;
32323fc2 225
c5827074 226my $timestamp_format = '%Y-%m-%d %H:%M:%S.%4N'; # %F %T
227my $date_format = '%Y-%m-%d';
228
229my ($timestamp_parser, $date_parser);
230
231sub parse_datetime {
232 shift;
233 require DateTime::Format::Strptime;
234 $timestamp_parser ||= DateTime::Format::Strptime->new(
235 pattern => $timestamp_format,
236 on_error => 'croak',
237 );
238 return $timestamp_parser->parse_datetime(shift);
239}
240
241sub format_datetime {
242 shift;
243 require DateTime::Format::Strptime;
244 $timestamp_parser ||= DateTime::Format::Strptime->new(
245 pattern => $timestamp_format,
246 on_error => 'croak',
247 );
248 return $timestamp_parser->format_datetime(shift);
249}
250
251sub parse_date {
252 shift;
253 require DateTime::Format::Strptime;
254 $date_parser ||= DateTime::Format::Strptime->new(
255 pattern => $date_format,
256 on_error => 'croak',
257 );
258 return $date_parser->parse_datetime(shift);
259}
260
261sub format_date {
262 shift;
263 require DateTime::Format::Strptime;
264 $date_parser ||= DateTime::Format::Strptime->new(
265 pattern => $date_format,
32323fc2 266 on_error => 'croak',
267 );
c5827074 268 return $date_parser->format_datetime(shift);
9cd0b325 269}
270
145b2a3d 2711;
90489c23 272
273=head1 CAVEATS
274
275=over 4
276
277=item *
278
dd2109ee 279with L</connect_call_use_softcommit>, you will not be able to see changes made
280to data in other processes. If this is an issue, use
47ec67c3 281L<disable_sth_caching|DBIx::Class::Storage::DBI/disable_sth_caching> as a
282workaround for the C<no statement executing> errors, this of course adversely
283affects performance.
dd2109ee 284
d1fc96c7 285Alternately, use the L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird> driver.
286
dd2109ee 287=item *
288
e1958268 289C<last_insert_id> support by default only works for Firebird versions 2 or
290greater, L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> however should
291work with earlier versions.
90489c23 292
47ec67c3 293=item *
294
d1fc96c7 295Sub-second precision for TIMESTAMPs is not currently available when using the
296L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird> driver.
47ec67c3 297
90489c23 298=back
299
300=head1 AUTHOR
301
302See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
303
304=head1 LICENSE
305
306You may distribute this code under the same terms as Perl itself.
307
308=cut