lib/DBIx/Class/Storage/DBI/ACCESS.pm

   1 package DBIx::Class::Storage::DBI::ACCESS;
   2
   3 use strict;
   4 use warnings;
   5 use base 'DBIx::Class::Storage::DBI::UniqueIdentifier';
   6 use mro 'c3';
   7
   8 use List::Util 'first';
   9 use namespace::clean;
  10
  11 __PACKAGE__->sql_limit_dialect ('Top');
  12 __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::ACCESS');
  13 __PACKAGE__->sql_quote_char ([qw/[ ]/]);
  14
  15 sub sqlt_type { 'ACCESS' }
  16
  17 __PACKAGE__->new_guid(undef);
  18
  19 =head1 NAME
  20
  21 DBIx::Class::Storage::DBI::ACCESS - Support specific to MS Access
  22
  23 =head1 DESCRIPTION
  24
  25 This is the base class for Microsoft Access support.
  26
  27 This driver supports L<last_insert_id|DBIx::Class::Storage::DBI/last_insert_id>,
  28 empty inserts for tables with C<AUTOINCREMENT> columns, nested transactions via
  29 L<auto_savepoint|DBIx::Class::Storage::DBI/auto_savepoint>, C<GUID> columns via
  30 L<DBIx::Class::Storage::DBI::UniqueIdentifier>.
  31
  32 =head1 SUPPORTED VERSIONS
  33
  34 This module has currently only been tested on MS Access 2010.
  35
  36 Information about how well it works on different version of MS Access is welcome
  37 (write the mailing list, or submit a ticket to RT if you find bugs.)
  38
  39 =head1 USING GUID COLUMNS
  40
  41 If you have C<GUID> PKs or other C<GUID> columns with
  42 L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> you will need to set a
  43 L<new_guid|DBIx::Class::Storage::DBI::UniqueIdentifier/new_guid> callback, like
  44 so:
  45
  46   $schema->storage->new_guid(sub { Data::GUID->new->as_string });
  47
  48 Under L<Catalyst> you can use code similar to this in your
  49 L<Catalyst::Model::DBIC::Schema> C<Model.pm>:
  50
  51   after BUILD => sub {
  52     my $self = shift;
  53     $self->storage->new_guid(sub { Data::GUID->new->as_string });
  54   };
  55
  56 =cut
  57
  58 sub _dbh_last_insert_id { $_[1]->selectrow_array('select @@identity') }
  59
  60 # support empty insert
  61 sub insert {
  62   my $self = shift;
  63   my ($source, $to_insert) = @_;
  64
  65   my $columns_info = $source->columns_info;
  66
  67   if (keys %$to_insert == 0) {
  68     my $autoinc_col = first {
  69       $columns_info->{$_}{is_auto_increment}
  70     } keys %$columns_info;
  71
  72     if (not $autoinc_col) {
  73       $self->throw_exception(
  74 'empty insert only supported for tables with an autoincrement column'
  75       );
  76     }
  77
  78     my $table = $source->from;
  79     $table = $$table if ref $table;
  80
  81     $to_insert->{$autoinc_col} = \"dmax('${autoinc_col}', '${table}')+1";
  82   }
  83
  84   return $self->next::method(@_);
  85 }
  86
  87 sub bind_attribute_by_data_type {
  88   my $self = shift;
  89   my ($data_type) = @_;
  90
  91   my $attributes = $self->next::method(@_) || {};
  92
  93   if ($self->_is_text_lob_type($data_type)) {
  94     $attributes->{TYPE} = DBI::SQL_LONGVARCHAR;
  95   }
  96   elsif ($self->_is_binary_lob_type($data_type)) {
  97     $attributes->{TYPE} = DBI::SQL_LONGVARBINARY;
  98   }
  99
 100   return $attributes;
 101 }
 102
 103 # savepoints are not supported, but nested transactions are.
 104 # Unfortunately DBI does not support nested transactions.
 105 # WARNING: this code uses the undocumented 'BegunWork' DBI attribute.
 106
 107 sub _svp_begin {
 108   my ($self, $name) = @_;
 109
 110   $self->throw_exception(
 111     'cannot BEGIN a nested transaction on a disconnected handle'
 112   ) unless $self->_dbh;
 113
 114   local $self->_dbh->{AutoCommit} = 1;
 115   local $self->_dbh->{BegunWork}  = 0;
 116   $self->_dbh_begin_work;
 117 }
 118
 119 # A new nested transaction on the same level releases the previous one.
 120 sub _svp_release { 1 }
 121
 122 sub _svp_rollback {
 123   my ($self, $name) = @_;
 124
 125   $self->throw_exception(
 126     'cannot ROLLBACK a nested transaction on a disconnected handle'
 127   ) unless $self->_dbh;
 128
 129   local $self->_dbh->{AutoCommit} = 0;
 130   local $self->_dbh->{BegunWork}  = 1;
 131   $self->_dbh_rollback;
 132 }
 133
 134 1;
 135
 136 =head1 AUTHOR
 137
 138 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
 139
 140 =head1 LICENSE
 141
 142 You may distribute this code under the same terms as Perl itself.
 143
 144 =cut
 145 # vim:sts=2 sw=2: