1 package DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS;
5 use base 'DBIx::Class::Schema::Loader::DBI::ODBC';
9 use DBIx::Class::Schema::Loader::Table ();
11 our $VERSION = '0.07036_02';
13 __PACKAGE__->mk_group_accessors('simple', qw/
20 DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS - Microsoft Access driver for
21 DBIx::Class::Schema::Loader
25 See L<DBIx::Class::Schema::Loader::Base> for usage information.
29 sub _supports_db_schema { 0 }
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->name)->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->name)->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->name)->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);
248 next unless $key->Type == 2;
250 my $local_cols = $key->Columns;
251 my $remote_table = $key->RelatedTable;
252 my (@local_cols, @remote_cols);
254 for my $col_idx (0..$local_cols->Count-1) {
255 my $col = $local_cols->Item($col_idx);
256 push @local_cols, $self->_lc($col->Name);
257 push @remote_cols, $self->_lc($col->RelatedColumn);
261 local_columns => \@local_cols,
262 remote_columns => \@remote_cols,
263 remote_table => DBIx::Class::Schema::Loader::Table->new(
265 name => $remote_table,
266 ($self->db_schema ? (
267 schema => $self->db_schema->[0],
277 sub _columns_info_for {
281 my $result = $self->next::method(@_);
283 while (my ($col, $info) = each %$result) {
284 my $data_type = $info->{data_type};
286 my $col_obj = $self->_adox_column($table, $col);
288 $info->{is_nullable} = ($col_obj->Attributes & 2) == 2 ? 1 : 0;
290 if ($data_type eq 'counter') {
291 $info->{data_type} = 'integer';
292 $info->{is_auto_increment} = 1;
293 delete $info->{size};
295 elsif ($data_type eq 'longbinary') {
296 $info->{data_type} = 'image';
297 $info->{original}{data_type} = 'longbinary';
299 elsif ($data_type eq 'longchar') {
300 $info->{data_type} = 'text';
301 $info->{original}{data_type} = 'longchar';
303 elsif ($data_type eq 'double') {
304 $info->{data_type} = 'double precision';
305 $info->{original}{data_type} = 'double';
307 elsif ($data_type eq 'guid') {
308 $info->{data_type} = 'uniqueidentifier';
309 $info->{original}{data_type} = 'guid';
311 elsif ($data_type eq 'byte') {
312 $info->{data_type} = 'tinyint';
313 $info->{original}{data_type} = 'byte';
315 elsif ($data_type eq 'currency') {
316 $info->{data_type} = 'money';
317 $info->{original}{data_type} = 'currency';
319 if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 19 && $info->{size}[1] == 4) {
320 # Actual money column via ODBC, otherwise we pass the sizes on to the ADO driver for
321 # decimal columns (which masquerade as money columns...)
322 delete $info->{size};
325 elsif ($data_type eq 'decimal') {
326 if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 18 && $info->{size}[1] == 0) {
327 delete $info->{size};
331 # Pass through currency (which can be decimal for ADO.)
332 if ($data_type !~ /^(?:(?:var)?(?:char|binary)|decimal)\z/ && $data_type ne 'currency') {
333 delete $info->{size};
342 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
343 L<DBIx::Class::Schema::Loader::DBI>
347 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
351 This library is free software; you can redistribute it and/or modify it under
352 the same terms as Perl itself.
357 # vim:et sts=4 sw=4 tw=0: