Commit | Line | Data |
726c8f65 |
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: |