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