| DBIx-Class-Schema-Loader documentation | Contained in the DBIx-Class-Schema-Loader distribution. |
DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet - ADO wrapper for DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS
Proxy for DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS when using DBD::ADO.
See DBIx::Class::Schema::Loader::Base for usage information.
DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS, DBIx::Class::Schema::Loader::DBI::ADO, DBIx::Class::Schema::Loader, DBIx::Class::Schema::Loader::Base, DBIx::Class::Schema::Loader::DBI
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| DBIx-Class-Schema-Loader documentation | Contained in the DBIx-Class-Schema-Loader distribution. |
package DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet; use strict; use warnings; use base qw/ DBIx::Class::Schema::Loader::DBI::ADO DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS /; use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; use Try::Tiny; use namespace::clean; our $VERSION = '0.07010';
sub _db_path { my $self = shift; $self->schema->storage->dbh->get_info(2); } sub _ado_connection { my $self = shift; return $self->__ado_connection if $self->__ado_connection; my ($dsn, $user, $pass) = @{ $self->schema->storage->_dbi_connect_info }; my $have_pass = 1; if (ref $dsn eq 'CODE') { ($dsn, $user, $pass) = $self->_try_infer_connect_info_from_coderef($dsn); if (not $dsn) { my $dbh = $self->schema->storage->dbh; $dsn = $dbh->{Name}; $user = $dbh->{Username}; $have_pass = 0; } } require Win32::OLE; my $conn = Win32::OLE->new('ADODB.Connection'); $dsn =~ s/^dbi:[^:]+://i; local $Win32::OLE::Warn = 0; my @dsn; for my $s (split /;/, $dsn) { my ($k, $v) = split /=/, $s, 2; if (defined $conn->{$k}) { $conn->{$k} = $v; next; } push @dsn, $s; } $dsn = join ';', @dsn; $user = '' unless defined $user; if ((not $have_pass) && exists $self->_passwords->{$dsn}{$user}) { $pass = $self->_passwords->{$dsn}{$user}; $have_pass = 1; } $pass = '' unless defined $pass; try { $conn->Open($dsn, $user, $pass); } catch { if (not $have_pass) { if (exists $ENV{DBI_PASS}) { $pass = $ENV{DBI_PASS}; try { $conn->Open($dsn, $user, $pass); $self->_passwords->{$dsn}{$user} = $pass; } catch { print "Enter database password for $user ($dsn): "; chomp($pass = <STDIN>); $conn->Open($dsn, $user, $pass); $self->_passwords->{$dsn}{$user} = $pass; }; } else { print "Enter database password for $user ($dsn): "; chomp($pass = <STDIN>); $conn->Open($dsn, $user, $pass); $self->_passwords->{$dsn}{$user} = $pass; } } else { die $_; } }; $self->__ado_connection($conn); return $conn; } sub _columns_info_for { my $self = shift; my ($table) = @_; my $result = $self->next::method(@_); while (my ($col, $info) = each %$result) { my $data_type = $info->{data_type}; my $col_obj; my $cols = $self->_adox_catalog->Tables->Item($table)->Columns; for my $col_idx (0..$cols->Count-1) { $col_obj = $cols->Item($col_idx); if ($self->preserve_case) { last if $col_obj->Name eq $col; } else { last if lc($col_obj->Name) eq lc($col); } } if ($col_obj->Attributes | 2 == 2) { $info->{is_nullable} = 1; } if ($data_type eq 'long') { $info->{data_type} = 'integer'; delete $info->{size}; my $props = $col_obj->Properties; for my $prop_idx (0..$props->Count-1) { my $prop = $props->Item($prop_idx); if ($prop->Name eq 'Autoincrement' && $prop->Value == 1) { $info->{is_auto_increment} = 1; last; } } } elsif ($data_type eq 'short') { $info->{data_type} = 'smallint'; delete $info->{size}; } elsif ($data_type eq 'single') { $info->{data_type} = 'real'; delete $info->{size}; } elsif ($data_type eq 'money') { if (ref $info->{size} eq 'ARRAY') { if ($info->{size}[0] == 19 && $info->{size}[1] == 255) { delete $info->{size}; } else { # it's really a decimal $info->{data_type} = 'decimal'; if ($info->{size}[0] == 18 && $info->{size}[1] == 0) { # default size delete $info->{size}; } delete $info->{original}; } } } elsif ($data_type eq 'varchar') { $info->{data_type} = 'char' if $col_obj->Type == 130; $info->{size} = $col_obj->DefinedSize; } elsif ($data_type eq 'bigbinary') { $info->{data_type} = 'varbinary'; my $props = $col_obj->Properties; for my $prop_idx (0..$props->Count-1) { my $prop = $props->Item($prop_idx); if ($prop->Name eq 'Fixed Length' && $prop->Value == 1) { $info->{data_type} = 'binary'; last; } } $info->{size} = $col_obj->DefinedSize; } elsif ($data_type eq 'longtext') { $info->{data_type} = 'text'; $info->{original}{data_type} = 'longchar'; delete $info->{size}; } } return $result; }
1; # vim:et sts=4 sw=4 tw=0: