1 package DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS;
6 DBIx::Class::Schema::Loader::DBI::ODBC
9 use Carp::Clan qw/^DBIx::Class/;
13 our $VERSION = '0.07010';
15 __PACKAGE__->mk_group_accessors('simple', qw/
22 DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS - Microsoft Access driver for
23 DBIx::Class::Schema::Loader
27 See L<DBIx::Class::Schema::Loader::Base> for usage information.
34 $self->schema->storage->dbh->get_info(16);
37 sub _open_ado_connection {
38 my ($self, $conn, $user, $pass) = @_;
41 provider => 'Microsoft.ACE.OLEDB.12.0',
42 dsn_extra => 'Persist Security Info=False',
44 provider => 'Microsoft.Jet.OLEDB.4.0',
50 for my $info (@info) {
51 $conn->{Provider} = $info->{provider};
53 my $dsn = 'Data Source='.($self->_db_path);
54 $dsn .= ";$info->{dsn_extra}" if exists $info->{dsn_extra};
57 $conn->Open($dsn, $user, $pass);
70 return ($opened, $exception);
77 return $self->__ado_connection if $self->__ado_connection;
79 my ($dsn, $user, $pass) = @{ $self->schema->storage->_dbi_connect_info };
83 if (ref $dsn eq 'CODE') {
84 ($dsn, $user, $pass) = $self->_try_infer_connect_info_from_coderef($dsn);
87 my $dbh = $self->schema->storage->dbh;
89 $user = $dbh->{Username};
95 my $conn = Win32::OLE->new('ADODB.Connection');
97 $user = '' unless defined $user;
98 if ((not $have_pass) && exists $self->_passwords->{$dsn}{$user}) {
99 $pass = $self->_passwords->{$dsn}{$user};
102 $pass = '' unless defined $pass;
104 my ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
106 if ((not $opened) && (not $have_pass)) {
107 if (exists $ENV{DBI_PASS}) {
108 $pass = $ENV{DBI_PASS};
110 ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
113 $self->_passwords->{$dsn}{$user} = $pass;
116 print "Enter database password for $user ($dsn): ";
117 chomp($pass = <STDIN>);
119 ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
122 $self->_passwords->{$dsn}{$user} = $pass;
127 print "Enter database password for $user ($dsn): ";
128 chomp($pass = <STDIN>);
130 ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
133 $self->_passwords->{$dsn}{$user} = $pass;
139 die "Failed to open ADO connection: $exception";
142 $self->__ado_connection($conn);
150 return $self->__adox_catalog if $self->__adox_catalog;
153 my $cat = Win32::OLE->new('ADOX.Catalog');
154 $cat->{ActiveConnection} = $self->_ado_connection;
156 $self->__adox_catalog($cat);
162 my ($self, $table, $col) = @_;
166 my $cols = $self->_adox_catalog->Tables->Item($table)->Columns;
168 for my $col_idx (0..$cols->Count-1) {
169 $col_obj = $cols->Item($col_idx);
170 if ($self->preserve_case) {
171 last if $col_obj->Name eq $col;
174 last if lc($col_obj->Name) eq lc($col);
184 if ($self->__adox_catalog) {
185 $self->__ado_connection(undef);
186 $self->__adox_catalog(undef);
189 return $self->next::method(@_);
193 my ($self, $table) = @_;
195 return [] if $self->_disable_pk_detection;
200 $self->_adox_catalog->Tables->Item($table)->Indexes
203 warn "Could not retrieve indexes in table '$table', disabling primary key detection: $_\n";
208 $self->_disable_pk_detection(1);
212 for my $idx_num (0..($indexes->Count-1)) {
213 my $idx = $indexes->Item($idx_num);
214 if ($idx->PrimaryKey) {
215 my $cols = $idx->Columns;
216 for my $col_idx (0..$cols->Count-1) {
217 push @keydata, $self->_lc($cols->Item($col_idx)->Name);
226 my ($self, $table) = @_;
228 return [] if $self->_disable_fk_detection;
231 $self->_adox_catalog->Tables->Item($table)->Keys;
234 warn "Could not retrieve keys in table '$table', disabling relationship detection: $_\n";
239 $self->_disable_fk_detection(1);
245 for my $key_idx (0..($keys->Count-1)) {
246 my $key = $keys->Item($key_idx);
247 if ($key->Type == 2) {
248 my $local_cols = $key->Columns;
249 my $remote_table = $key->RelatedTable;
250 my (@local_cols, @remote_cols);
252 for my $col_idx (0..$local_cols->Count-1) {
253 my $col = $local_cols->Item($col_idx);
254 push @local_cols, $self->_lc($col->Name);
255 push @remote_cols, $self->_lc($col->RelatedColumn);
259 local_columns => \@local_cols,
260 remote_columns => \@remote_cols,
261 remote_table => $remote_table,
270 sub _columns_info_for {
274 my $result = $self->next::method(@_);
276 while (my ($col, $info) = each %$result) {
277 my $data_type = $info->{data_type};
279 my $col_obj = $self->_adox_column($table, $col);
281 $info->{is_nullable} = ($col_obj->Attributes & 2) == 2 ? 1 : 0;
283 if ($data_type eq 'counter') {
284 $info->{data_type} = 'integer';
285 $info->{is_auto_increment} = 1;
286 delete $info->{size};
288 elsif ($data_type eq 'longbinary') {
289 $info->{data_type} = 'image';
290 $info->{original}{data_type} = 'longbinary';
292 elsif ($data_type eq 'longchar') {
293 $info->{data_type} = 'text';
294 $info->{original}{data_type} = 'longchar';
296 elsif ($data_type eq 'double') {
297 $info->{data_type} = 'double precision';
298 $info->{original}{data_type} = 'double';
300 elsif ($data_type eq 'guid') {
301 $info->{data_type} = 'uniqueidentifier';
302 $info->{original}{data_type} = 'guid';
304 elsif ($data_type eq 'byte') {
305 $info->{data_type} = 'tinyint';
306 $info->{original}{data_type} = 'byte';
308 elsif ($data_type eq 'currency') {
309 $info->{data_type} = 'money';
310 $info->{original}{data_type} = 'currency';
312 if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 19 && $info->{size}[1] == 4) {
313 # Actual money column via ODBC, otherwise we pass the sizes on to the ADO driver for
314 # decimal columns (which masquerade as money columns...)
315 delete $info->{size};
318 elsif ($data_type eq 'decimal') {
319 if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 18 && $info->{size}[1] == 0) {
320 delete $info->{size};
324 # Pass through currency (which can be decimal for ADO.)
325 if ($data_type !~ /^(?:(?:var)?(?:char|binary)|decimal)\z/ && $data_type ne 'currency') {
326 delete $info->{size};
335 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
336 L<DBIx::Class::Schema::Loader::DBI>
340 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
344 This library is free software; you can redistribute it and/or modify it under
345 the same terms as Perl itself.
350 # vim:et sts=4 sw=4 tw=0: