1 package DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS;
6 DBIx::Class::Schema::Loader::DBI::ODBC
11 use DBIx::Class::Schema::Loader::Table ();
13 our $VERSION = '0.07013';
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.
31 sub _supports_db_schema { 0 }
36 $self->schema->storage->dbh->get_info(16);
39 sub _open_ado_connection {
40 my ($self, $conn, $user, $pass) = @_;
43 provider => 'Microsoft.ACE.OLEDB.12.0',
44 dsn_extra => 'Persist Security Info=False',
46 provider => 'Microsoft.Jet.OLEDB.4.0',
52 for my $info (@info) {
53 $conn->{Provider} = $info->{provider};
55 my $dsn = 'Data Source='.($self->_db_path);
56 $dsn .= ";$info->{dsn_extra}" if exists $info->{dsn_extra};
59 $conn->Open($dsn, $user, $pass);
72 return ($opened, $exception);
79 return $self->__ado_connection if $self->__ado_connection;
81 my ($dsn, $user, $pass) = @{ $self->schema->storage->_dbi_connect_info };
85 if (ref $dsn eq 'CODE') {
86 ($dsn, $user, $pass) = $self->_try_infer_connect_info_from_coderef($dsn);
89 my $dbh = $self->schema->storage->dbh;
91 $user = $dbh->{Username};
97 my $conn = Win32::OLE->new('ADODB.Connection');
99 $user = '' unless defined $user;
100 if ((not $have_pass) && exists $self->_passwords->{$dsn}{$user}) {
101 $pass = $self->_passwords->{$dsn}{$user};
104 $pass = '' unless defined $pass;
106 my ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
108 if ((not $opened) && (not $have_pass)) {
109 if (exists $ENV{DBI_PASS}) {
110 $pass = $ENV{DBI_PASS};
112 ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
115 $self->_passwords->{$dsn}{$user} = $pass;
118 print "Enter database password for $user ($dsn): ";
119 chomp($pass = <STDIN>);
121 ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
124 $self->_passwords->{$dsn}{$user} = $pass;
129 print "Enter database password for $user ($dsn): ";
130 chomp($pass = <STDIN>);
132 ($opened, $exception) = $self->_open_ado_connection($conn, $user, $pass);
135 $self->_passwords->{$dsn}{$user} = $pass;
141 die "Failed to open ADO connection: $exception";
144 $self->__ado_connection($conn);
152 return $self->__adox_catalog if $self->__adox_catalog;
155 my $cat = Win32::OLE->new('ADOX.Catalog');
156 $cat->{ActiveConnection} = $self->_ado_connection;
158 $self->__adox_catalog($cat);
164 my ($self, $table, $col) = @_;
168 my $cols = $self->_adox_catalog->Tables->Item($table->name)->Columns;
170 for my $col_idx (0..$cols->Count-1) {
171 $col_obj = $cols->Item($col_idx);
172 if ($self->preserve_case) {
173 last if $col_obj->Name eq $col;
176 last if lc($col_obj->Name) eq lc($col);
186 if ($self->__adox_catalog) {
187 $self->__ado_connection(undef);
188 $self->__adox_catalog(undef);
191 return $self->next::method(@_);
195 my ($self, $table) = @_;
197 return [] if $self->_disable_pk_detection;
202 $self->_adox_catalog->Tables->Item($table->name)->Indexes
205 warn "Could not retrieve indexes in table '$table', disabling primary key detection: $_\n";
210 $self->_disable_pk_detection(1);
214 for my $idx_num (0..($indexes->Count-1)) {
215 my $idx = $indexes->Item($idx_num);
216 if ($idx->PrimaryKey) {
217 my $cols = $idx->Columns;
218 for my $col_idx (0..$cols->Count-1) {
219 push @keydata, $self->_lc($cols->Item($col_idx)->Name);
228 my ($self, $table) = @_;
230 return [] if $self->_disable_fk_detection;
233 $self->_adox_catalog->Tables->Item($table->name)->Keys;
236 warn "Could not retrieve keys in table '$table', disabling relationship detection: $_\n";
241 $self->_disable_fk_detection(1);
247 for my $key_idx (0..($keys->Count-1)) {
248 my $key = $keys->Item($key_idx);
250 next unless $key->Type == 2;
252 my $local_cols = $key->Columns;
253 my $remote_table = $key->RelatedTable;
254 my (@local_cols, @remote_cols);
256 for my $col_idx (0..$local_cols->Count-1) {
257 my $col = $local_cols->Item($col_idx);
258 push @local_cols, $self->_lc($col->Name);
259 push @remote_cols, $self->_lc($col->RelatedColumn);
263 local_columns => \@local_cols,
264 remote_columns => \@remote_cols,
265 remote_table => DBIx::Class::Schema::Loader::Table->new(
267 name => $remote_table,
268 ($self->db_schema ? (
269 schema => $self->db_schema->[0],
279 sub _columns_info_for {
283 my $result = $self->next::method(@_);
285 while (my ($col, $info) = each %$result) {
286 my $data_type = $info->{data_type};
288 my $col_obj = $self->_adox_column($table, $col);
290 $info->{is_nullable} = ($col_obj->Attributes & 2) == 2 ? 1 : 0;
292 if ($data_type eq 'counter') {
293 $info->{data_type} = 'integer';
294 $info->{is_auto_increment} = 1;
295 delete $info->{size};
297 elsif ($data_type eq 'longbinary') {
298 $info->{data_type} = 'image';
299 $info->{original}{data_type} = 'longbinary';
301 elsif ($data_type eq 'longchar') {
302 $info->{data_type} = 'text';
303 $info->{original}{data_type} = 'longchar';
305 elsif ($data_type eq 'double') {
306 $info->{data_type} = 'double precision';
307 $info->{original}{data_type} = 'double';
309 elsif ($data_type eq 'guid') {
310 $info->{data_type} = 'uniqueidentifier';
311 $info->{original}{data_type} = 'guid';
313 elsif ($data_type eq 'byte') {
314 $info->{data_type} = 'tinyint';
315 $info->{original}{data_type} = 'byte';
317 elsif ($data_type eq 'currency') {
318 $info->{data_type} = 'money';
319 $info->{original}{data_type} = 'currency';
321 if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 19 && $info->{size}[1] == 4) {
322 # Actual money column via ODBC, otherwise we pass the sizes on to the ADO driver for
323 # decimal columns (which masquerade as money columns...)
324 delete $info->{size};
327 elsif ($data_type eq 'decimal') {
328 if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 18 && $info->{size}[1] == 0) {
329 delete $info->{size};
333 # Pass through currency (which can be decimal for ADO.)
334 if ($data_type !~ /^(?:(?:var)?(?:char|binary)|decimal)\z/ && $data_type ne 'currency') {
335 delete $info->{size};
344 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
345 L<DBIx::Class::Schema::Loader::DBI>
349 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
353 This library is free software; you can redistribute it and/or modify it under
354 the same terms as Perl itself.
359 # vim:et sts=4 sw=4 tw=0: