Comprehensive MSAccess support over both DBD::ODBC and DBD::ADO
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / ODBC / ACCESS.pm
index 710be6e..2a0624f 100644 (file)
-package DBIx::Class::Storage::DBI::ODBC::ACCESS;\r
-use strict;\r
-use warnings;\r
-\r
-use Data::Dump qw( dump );\r
-\r
-use DBI;\r
-use base qw/DBIx::Class::Storage::DBI/;\r
-\r
-my $ERR_MSG_START = __PACKAGE__ . ' failed: ';\r
-\r
-sub insert {\r
-    my $self = shift;\r
-    my ( $source, $to_insert ) = @_;\r
-\r
-    my $bind_attributes = $self->source_bind_attributes( $source );\r
-    my ( undef, $sth ) = $self->_execute( 'insert' => [], $source, $bind_attributes, $to_insert );\r
-\r
-    #store the identity here since @@IDENTITY is connection global and this prevents\r
-    #possibility that another insert to a different table overwrites it for this resultsource\r
-    my $identity = 'SELECT @@IDENTITY';\r
-    my $max_sth  = $self->{ _dbh }->prepare( $identity )\r
-        or $self->throw_exception( $ERR_MSG_START . $self->{ _dbh }->errstr() );\r
-    $max_sth->execute() or $self->throw_exception( $ERR_MSG_START . $max_sth->errstr );\r
-\r
-    my $row = $max_sth->fetchrow_arrayref()\r
-        or $self->throw_exception( $ERR_MSG_START . "$identity did not return any result." );\r
-\r
-    $self->{ last_pk }->{ $source->name() } = $row;\r
-\r
-    return $to_insert;\r
-}\r
-\r
-sub last_insert_id {\r
-    my $self = shift;\r
-    my ( $result_source ) = @_;\r
-\r
-    return @{ $self->{ last_pk }->{ $result_source->name() } };\r
-}\r
-\r
-sub bind_attribute_by_data_type {\r
-    my $self = shift;\r
-    \r
-    my ( $data_type ) = @_;\r
-    \r
-    return { TYPE => $data_type } if $data_type == DBI::SQL_LONGVARCHAR;\r
-    \r
-    return;\r
-}\r
-\r
-sub sqlt_type { 'ACCESS' }\r
-\r
-1;\r
-\r
-=head1 NAME\r
-\r
-DBIx::Class::Storage::ODBC::ACCESS - Support specific to MS Access over ODBC\r
-\r
-=head1 WARNING\r
-\r
-I am not a DBI, DBIx::Class or MS Access guru. Use this module with that in\r
-mind.\r
-\r
-This module is currently considered alpha software and can change without notice.\r
-\r
-=head1 DESCRIPTION\r
-\r
-This class implements support specific to Microsoft Access over ODBC.\r
-\r
-It is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it\r
-detects a MS Access back-end.\r
-\r
-=head1 SUPPORTED VERSIONS\r
-\r
-This module have currently only been tested on MS Access 2003 using the Jet 4.0 engine.\r
-\r
-As far as my knowledge it should work on MS Access 2000 or later, but that have not been tested.\r
-Information about support for different version of MS Access is welcome.\r
-\r
-=head1 IMPLEMENTATION NOTES\r
-\r
-MS Access supports the @@IDENTITY function for retriving the id of the latest inserted row.\r
-@@IDENTITY is global to the connection, so to support the possibility of getting the last inserted\r
-id for different tables, the insert() function stores the inserted id on a per table basis.\r
-last_insert_id() then just returns the stored value.\r
-\r
-=head1 KNOWN ACCESS PROBLEMS\r
-\r
-=over\r
-\r
-=item Invalid precision value\r
-\r
-This error message is received when trying to store more than 255 characters in a MEMO field.\r
-The problem is (to my knowledge) an error in the MS Access ODBC driver. The problem is fixed\r
-by setting the C<data_type> of the column to C<SQL_LONGVARCHAR> in C<add_columns>. \r
-C<SQL_LONGVARCHAR> is a constant in the C<DBI> module.\r
-\r
-=back\r
-\r
-=head1 IMPLEMENTED FUNCTIONS\r
-\r
-=head2 bind_attribute_by_data_type\r
-\r
-This function currently supports the SQL_LONGVARCHAR column type.\r
-\r
-=head2 insert\r
-\r
-=head2 last_insert_id\r
-\r
-=head2 sqlt_type\r
-\r
-=head1 BUGS\r
-\r
-Most likely. Bug reports are welcome.\r
-\r
-=head1 AUTHORS\r
-\r
-Øystein Torget C<< <oystein.torget@dnv.com> >>\r
-\r
-=head1 COPYRIGHT\r
-\r
-You may distribute this code under the same terms as Perl itself.\r
-\r
-Det Norske Veritas AS (DNV)\r
-\r
-http://www.dnv.com\r
-\r
-=cut\r
-\r
+package DBIx::Class::Storage::DBI::ODBC::ACCESS;
+
+use strict;
+use warnings;
+use base qw/
+  DBIx::Class::Storage::DBI::ODBC
+  DBIx::Class::Storage::DBI::ACCESS
+/;
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors(inherited =>
+  'disable_sth_caching_for_image_insert_or_update'
+);
+
+__PACKAGE__->disable_sth_caching_for_image_insert_or_update(1);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::ACCESS - Support specific to MS Access over ODBC
+
+=head1 DESCRIPTION
+
+This class implements support specific to Microsoft Access over ODBC.
+
+It is a subclass of L<DBIx::Class::Storage::DBI::ODBC> and
+L<DBIx::Class::Storage::DBI::ACCESS>, see those classes for more
+information.
+
+It is loaded automatically by by L<DBIx::Class::Storage::DBI::ODBC> when it
+detects a MS Access back-end.
+
+This driver implements workarounds for C<IMAGE> and C<MEMO> columns, and
+L<DBIx::Class::InflateColumn::DateTime> support for C<DATETIME> columns.
+
+=head1 EXAMPLE DSN
+
+  dbi:ODBC:driver={Microsoft Access Driver (*.mdb, *.accdb)};dbq=C:\Users\rkitover\Documents\access_sample.accdb
+
+=head1 TEXT/IMAGE/MEMO COLUMNS
+
+Avoid using C<TEXT> columns as they will be truncated to 255 bytes. Some other
+drivers (like L<ADO|DBIx::Class::Storage::DBI::ADO::MS_Jet>) will automatically
+convert C<TEXT> columns to C<MEMO>, but the ODBC driver does not.
+
+C<IMAGE> columns work correctly, but the statements for inserting or updating an
+C<IMAGE> column will not be L<cached|DBI/prepare_cached>, due to a bug in the
+Access ODBC driver.
+
+C<MEMO> columns work correctly as well, but you must take care to set
+L<LongReadLen|DBI/LongReadLen> to C<$max_memo_size * 2 + 1>. This is done for
+you automatically if you pass L<LongReadLen|DBI/LongReadLen> in your
+L<connect_info|DBIx::Class::Storage::DBI/connect_info>; but if you set this
+attribute directly on the C<$dbh>, keep this limitation in mind.
+
+=cut
+
+# set LongReadLen = LongReadLen * 2 + 1 (see docs on MEMO)
+sub _run_connection_actions {
+  my $self = shift;
+
+  my $long_read_len = $self->_dbh->{LongReadLen};
+
+  # 80 is another default (just like 0) on some drivers
+  if ($long_read_len != 0 && $long_read_len != 80) {
+    $self->_dbh->{LongReadLen} = $long_read_len * 2 + 1;
+  }
+
+  return $self->next::method(@_);
+}
+
+sub insert {
+  my $self = shift;
+  my ($source, $to_insert) = @_;
+
+  my $columns_info = $source->columns_info;
+
+  my $is_image_insert = 0;
+
+  for my $col (keys %$to_insert) {
+    if ($self->_is_binary_lob_type($columns_info->{$col}{data_type})) {
+      $is_image_insert = 1;
+      last;
+    }
+  }
+
+  local $self->{disable_sth_caching} = 1 if $is_image_insert
+    && $self->disable_sth_caching_for_image_insert_or_update;
+
+  return $self->next::method(@_);
+}
+
+sub update {
+  my $self = shift;
+  my ($source, $fields) = @_;
+
+  my $columns_info = $source->columns_info;
+
+  my $is_image_insert = 0;
+
+  for my $col (keys %$fields) {
+    if ($self->_is_binary_lob_type($columns_info->{$col}{data_type})) {
+      $is_image_insert = 1;
+      last;
+    }
+  }
+
+  local $self->{disable_sth_caching} = 1 if $is_image_insert
+    && $self->disable_sth_caching_for_image_insert_or_update;
+
+  return $self->next::method(@_);
+}
+
+sub datetime_parser_type {
+  'DBIx::Class::Storage::DBI::ODBC::ACCESS::DateTime::Format'
+}
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::ODBC::ACCESS::DateTime::Format;
+
+my $datetime_format = '%Y-%m-%d %H:%M:%S'; # %F %T, no fractional part
+my $datetime_parser;
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->format_datetime(shift);
+}
+
+1;
+
+=head1 AUTHOR
+
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+# vim:sts=2 sw=2: