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