I was wrong about 2d12a809 - the crash is real
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / InterBase.pm
1 package DBIx::Class::Storage::DBI::InterBase;
2
3 use strict;
4 use warnings;
5 use base qw/DBIx::Class::Storage::DBI::Firebird::Common/;
6 use mro 'c3';
7 use Try::Tiny;
8 use namespace::clean;
9
10 =head1 NAME
11
12 DBIx::Class::Storage::DBI::InterBase - Driver for the Firebird RDBMS via
13 L<DBD::InterBase>
14
15 =head1 DESCRIPTION
16
17 This driver is a subclass of L<DBIx::Class::Storage::DBI::Firebird::Common> for
18 use with L<DBD::InterBase>, see that driver for general details.
19
20 You need to use either the
21 L<disable_sth_caching|DBIx::Class::Storage::DBI/disable_sth_caching> option or
22 L</connect_call_use_softcommit> (see L</CAVEATS>) for your code to function
23 correctly with this driver. Otherwise you will likely get bizarre error messages
24 such as C<no statement executing>. The alternative is to use the
25 L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird> driver, which is more suitable
26 for long running processes such as under L<Catalyst>.
27
28 To turn on L<DBIx::Class::InflateColumn::DateTime> support, see
29 L</connect_call_datetime_setup>.
30
31 =cut
32
33 __PACKAGE__->datetime_parser_type(
34   'DBIx::Class::Storage::DBI::InterBase::DateTime::Format'
35 );
36
37 sub _ping {
38   my $self = shift;
39
40   my $dbh = $self->_dbh or return 0;
41
42   local $dbh->{RaiseError} = 1;
43   local $dbh->{PrintError} = 0;
44
45   return try {
46     $dbh->do('select 1 from rdb$database');
47     1;
48   } catch {
49     0;
50   };
51 }
52
53 # We want dialect 3 for new features and quoting to work, DBD::InterBase uses
54 # dialect 1 (interbase compat) by default.
55 sub _init {
56   my $self = shift;
57   $self->_set_sql_dialect(3);
58 }
59
60 sub _set_sql_dialect {
61   my $self = shift;
62   my $val  = shift || 3;
63
64   my $dsn = $self->_dbi_connect_info->[0];
65
66   return if ref($dsn) eq 'CODE';
67
68   if ($dsn !~ /ib_dialect=/) {
69     $self->_dbi_connect_info->[0] = "$dsn;ib_dialect=$val";
70     my $connected = defined $self->_dbh;
71     $self->disconnect;
72     $self->ensure_connected if $connected;
73   }
74 }
75
76 =head2 connect_call_use_softcommit
77
78 Used as:
79
80   on_connect_call => 'use_softcommit'
81
82 In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the
83 L<DBD::InterBase> C<ib_softcommit> option.
84
85 You need either this option or C<< disable_sth_caching => 1 >> for
86 L<DBIx::Class> code to function correctly (otherwise you may get C<no statement
87 executing> errors.) Or use the L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird>
88 driver.
89
90 The downside of using this option is that your process will B<NOT> see UPDATEs,
91 INSERTs and DELETEs from other processes for already open statements.
92
93 =cut
94
95 sub connect_call_use_softcommit {
96   my $self = shift;
97
98   $self->_dbh->{ib_softcommit} = 1;
99 }
100
101 =head2 connect_call_datetime_setup
102
103 Used as:
104
105   on_connect_call => 'datetime_setup'
106
107 In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the date and
108 timestamp formats using:
109
110   $dbh->{ib_time_all} = 'ISO';
111
112 See L<DBD::InterBase> for more details.
113
114 The C<TIMESTAMP> data type supports up to 4 digits after the decimal point for
115 second precision. The full precision is used.
116
117 The C<DATE> data type stores the date portion only, and it B<MUST> be declared
118 with:
119
120   data_type => 'date'
121
122 in your Result class.
123
124 Timestamp columns can be declared with either C<datetime> or C<timestamp>.
125
126 You will need the L<DateTime::Format::Strptime> module for inflation to work.
127
128 For L<DBIx::Class::Storage::DBI::ODBC::Firebird>, this is a noop.
129
130 =cut
131
132 sub connect_call_datetime_setup {
133   my $self = shift;
134
135   $self->_get_dbh->{ib_time_all} = 'ISO';
136 }
137
138
139 package # hide from PAUSE
140   DBIx::Class::Storage::DBI::InterBase::DateTime::Format;
141
142 my $timestamp_format = '%Y-%m-%d %H:%M:%S.%4N'; # %F %T
143 my $date_format      = '%Y-%m-%d';
144
145 my ($timestamp_parser, $date_parser);
146
147 sub parse_datetime {
148   shift;
149   require DateTime::Format::Strptime;
150   $timestamp_parser ||= DateTime::Format::Strptime->new(
151     pattern  => $timestamp_format,
152     on_error => 'croak',
153   );
154   return $timestamp_parser->parse_datetime(shift);
155 }
156
157 sub format_datetime {
158   shift;
159   require DateTime::Format::Strptime;
160   $timestamp_parser ||= DateTime::Format::Strptime->new(
161     pattern  => $timestamp_format,
162     on_error => 'croak',
163   );
164   return $timestamp_parser->format_datetime(shift);
165 }
166
167 sub parse_date {
168   shift;
169   require DateTime::Format::Strptime;
170   $date_parser ||= DateTime::Format::Strptime->new(
171     pattern  => $date_format,
172     on_error => 'croak',
173   );
174   return $date_parser->parse_datetime(shift);
175 }
176
177 sub format_date {
178   shift;
179   require DateTime::Format::Strptime;
180   $date_parser ||= DateTime::Format::Strptime->new(
181     pattern  => $date_format,
182     on_error => 'croak',
183   );
184   return $date_parser->format_datetime(shift);
185 }
186
187 1;
188
189 =head1 CAVEATS
190
191 =over 4
192
193 =item *
194
195 with L</connect_call_use_softcommit>, you will not be able to see changes made
196 to data in other processes. If this is an issue, use
197 L<disable_sth_caching|DBIx::Class::Storage::DBI/disable_sth_caching> as a
198 workaround for the C<no statement executing> errors, this of course adversely
199 affects performance.
200
201 Alternately, use the L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird> driver.
202
203 =back
204
205 =head1 AUTHOR
206
207 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
208
209 =head1 LICENSE
210
211 You may distribute this code under the same terms as Perl itself.
212
213 =cut
214 # vim:sts=2 sw=2: