I was wrong about 2d12a809 - the crash is real
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Informix.pm
1 package DBIx::Class::Storage::DBI::Informix;
2 use strict;
3 use warnings;
4
5 use base qw/DBIx::Class::Storage::DBI/;
6 use mro 'c3';
7
8 use Scope::Guard ();
9 use Context::Preserve 'preserve_context';
10 use namespace::clean;
11
12 __PACKAGE__->sql_limit_dialect ('SkipFirst');
13 __PACKAGE__->sql_quote_char ('"');
14 __PACKAGE__->datetime_parser_type (
15   'DBIx::Class::Storage::DBI::Informix::DateTime::Format'
16 );
17
18
19 __PACKAGE__->mk_group_accessors('simple' => '__last_insert_id');
20
21 =head1 NAME
22
23 DBIx::Class::Storage::DBI::Informix - Base Storage Class for Informix Support
24
25 =head1 DESCRIPTION
26
27 This class implements storage-specific support for the Informix RDBMS
28
29 =head1 METHODS
30
31 =cut
32
33 sub _execute {
34   my $self = shift;
35   my ($op) = @_;
36   my ($rv, $sth, @rest) = $self->next::method(@_);
37
38   $self->__last_insert_id($sth->{ix_sqlerrd}[1])
39     if $self->_perform_autoinc_retrieval;
40
41   return (wantarray ? ($rv, $sth, @rest) : $rv);
42 }
43
44 sub last_insert_id {
45   shift->__last_insert_id;
46 }
47
48 sub _exec_svp_begin {
49     my ($self, $name) = @_;
50
51     $self->_dbh->do("SAVEPOINT $name");
52 }
53
54 # can't release savepoints
55 sub _exec_svp_release { 1 }
56
57 sub _exec_svp_rollback {
58     my ($self, $name) = @_;
59
60     $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
61 }
62
63 sub with_deferred_fk_checks {
64   my ($self, $sub) = @_;
65
66   my $txn_scope_guard = $self->txn_scope_guard;
67
68   $self->_do_query('SET CONSTRAINTS ALL DEFERRED');
69
70   my $sg = Scope::Guard->new(sub {
71     $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE');
72   });
73
74   return preserve_context { $sub->() } after => sub { $txn_scope_guard->commit };
75 }
76
77 =head2 connect_call_datetime_setup
78
79 Used as:
80
81   on_connect_call => 'datetime_setup'
82
83 In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the C<DATE> and
84 C<DATETIME> formats.
85
86 Sets the following environment variables:
87
88     GL_DATE="%m/%d/%Y"
89     GL_DATETIME="%Y-%m-%d %H:%M:%S%F5"
90
91 The C<DBDATE> and C<DBCENTURY> environment variables are cleared.
92
93 B<NOTE:> setting the C<GL_DATE> environment variable seems to have no effect
94 after the process has started, so the default format is used. The C<GL_DATETIME>
95 setting does take effect however.
96
97 The C<DATETIME> data type supports up to 5 digits after the decimal point for
98 second precision, depending on how you have declared your column. The full
99 possible precision is used.
100
101 The column declaration for a C<DATETIME> with maximum precision is:
102
103   column_name DATETIME YEAR TO FRACTION(5)
104
105 The C<DATE> data type stores the date portion only, and it B<MUST> be declared
106 with:
107
108   data_type => 'date'
109
110 in your Result class.
111
112 You will need the L<DateTime::Format::Strptime> module for inflation to work.
113
114 =cut
115
116 sub connect_call_datetime_setup {
117   my $self = shift;
118
119   delete @ENV{qw/DBDATE DBCENTURY/};
120
121   $ENV{GL_DATE}     = "%m/%d/%Y";
122   $ENV{GL_DATETIME} = "%Y-%m-%d %H:%M:%S%F5";
123 }
124
125 package # hide from PAUSE
126   DBIx::Class::Storage::DBI::Informix::DateTime::Format;
127
128 my $timestamp_format = '%Y-%m-%d %H:%M:%S.%5N'; # %F %T
129 my $date_format      = '%m/%d/%Y';
130
131 my ($timestamp_parser, $date_parser);
132
133 sub parse_datetime {
134   shift;
135   require DateTime::Format::Strptime;
136   $timestamp_parser ||= DateTime::Format::Strptime->new(
137     pattern  => $timestamp_format,
138     on_error => 'croak',
139   );
140   return $timestamp_parser->parse_datetime(shift);
141 }
142
143 sub format_datetime {
144   shift;
145   require DateTime::Format::Strptime;
146   $timestamp_parser ||= DateTime::Format::Strptime->new(
147     pattern  => $timestamp_format,
148     on_error => 'croak',
149   );
150   return $timestamp_parser->format_datetime(shift);
151 }
152
153 sub parse_date {
154   shift;
155   require DateTime::Format::Strptime;
156   $date_parser ||= DateTime::Format::Strptime->new(
157     pattern  => $date_format,
158     on_error => 'croak',
159   );
160   return $date_parser->parse_datetime(shift);
161 }
162
163 sub format_date {
164   shift;
165   require DateTime::Format::Strptime;
166   $date_parser ||= DateTime::Format::Strptime->new(
167     pattern  => $date_format,
168     on_error => 'croak',
169   );
170   return $date_parser->format_datetime(shift);
171 }
172
173 1;
174
175 =head1 AUTHOR
176
177 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
178
179 =head1 LICENSE
180
181 You may distribute this code under the same terms as Perl itself.
182
183 =cut