1package DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet; 2 3use strict; 4use warnings; 5use base qw/ 6 DBIx::Class::Schema::Loader::DBI::ADO 7 DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS 8/; 9use mro 'c3'; 10use Try::Tiny; 11use namespace::clean; 12 13our $VERSION = '0.07033'; 14 15=head1 NAME 16 17DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet - ADO wrapper for 18L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS> 19 20=head1 DESCRIPTION 21 22Proxy for L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS> when using 23L<DBD::ADO>. 24 25See L<DBIx::Class::Schema::Loader::Base> for usage information. 26 27=cut 28 29sub _db_path { 30 my $self = shift; 31 32 $self->schema->storage->dbh->get_info(2); 33} 34 35sub _ado_connection { 36 my $self = shift; 37 38 return $self->__ado_connection if $self->__ado_connection; 39 40 my ($dsn, $user, $pass) = @{ $self->schema->storage->_dbi_connect_info }; 41 42 my $have_pass = 1; 43 44 if (ref $dsn eq 'CODE') { 45 ($dsn, $user, $pass) = $self->_try_infer_connect_info_from_coderef($dsn); 46 47 if (not $dsn) { 48 my $dbh = $self->schema->storage->dbh; 49 $dsn = $dbh->{Name}; 50 $user = $dbh->{Username}; 51 $have_pass = 0; 52 } 53 } 54 55 require Win32::OLE; 56 my $conn = Win32::OLE->new('ADODB.Connection'); 57 58 $dsn =~ s/^dbi:[^:]+://i; 59 60 local $Win32::OLE::Warn = 0; 61 62 my @dsn; 63 for my $s (split /;/, $dsn) { 64 my ($k, $v) = split /=/, $s, 2; 65 if (defined $conn->{$k}) { 66 $conn->{$k} = $v; 67 next; 68 } 69 push @dsn, $s; 70 } 71 72 $dsn = join ';', @dsn; 73 74 $user = '' unless defined $user; 75 76 if ((not $have_pass) && exists $self->_passwords->{$dsn}{$user}) { 77 $pass = $self->_passwords->{$dsn}{$user}; 78 $have_pass = 1; 79 } 80 $pass = '' unless defined $pass; 81 82 try { 83 $conn->Open($dsn, $user, $pass); 84 } 85 catch { 86 if (not $have_pass) { 87 if (exists $ENV{DBI_PASS}) { 88 $pass = $ENV{DBI_PASS}; 89 try { 90 $conn->Open($dsn, $user, $pass); 91 $self->_passwords->{$dsn}{$user} = $pass; 92 } 93 catch { 94 print "Enter database password for $user ($dsn): "; 95 chomp($pass = <STDIN>); 96 $conn->Open($dsn, $user, $pass); 97 $self->_passwords->{$dsn}{$user} = $pass; 98 }; 99 } 100 else { 101 print "Enter database password for $user ($dsn): "; 102 chomp($pass = <STDIN>); 103 $conn->Open($dsn, $user, $pass); 104 $self->_passwords->{$dsn}{$user} = $pass; 105 } 106 } 107 else { 108 die $_; 109 } 110 }; 111 112 $self->__ado_connection($conn); 113 114 return $conn; 115} 116 117sub _columns_info_for { 118 my $self = shift; 119 my ($table) = @_; 120 121 my $result = $self->next::method(@_); 122 123 while (my ($col, $info) = each %$result) { 124 my $data_type = $info->{data_type}; 125 126 my $col_obj = $self->_adox_column($table, $col); 127 128 if ($data_type eq 'long') { 129 $info->{data_type} = 'integer'; 130 delete $info->{size}; 131 132 my $props = $col_obj->Properties; 133 for my $prop_idx (0..$props->Count-1) { 134 my $prop = $props->Item($prop_idx); 135 if ($prop->Name eq 'Autoincrement' && $prop->Value == 1) { 136 $info->{is_auto_increment} = 1; 137 last; 138 } 139 } 140 } 141 elsif ($data_type eq 'short') { 142 $info->{data_type} = 'smallint'; 143 delete $info->{size}; 144 } 145 elsif ($data_type eq 'single') { 146 $info->{data_type} = 'real'; 147 delete $info->{size}; 148 } 149 elsif ($data_type eq 'money') { 150 if (ref $info->{size} eq 'ARRAY') { 151 if ($info->{size}[0] == 19 && $info->{size}[1] == 255) { 152 delete $info->{size}; 153 } 154 else { 155 # it's really a decimal 156 $info->{data_type} = 'decimal'; 157 158 if ($info->{size}[0] == 18 && $info->{size}[1] == 0) { 159 # default size 160 delete $info->{size}; 161 } 162 delete $info->{original}; 163 } 164 } 165 } 166 elsif ($data_type eq 'varchar') { 167 $info->{data_type} = 'char' if $col_obj->Type == 130; 168 $info->{size} = $col_obj->DefinedSize; 169 } 170 elsif ($data_type eq 'bigbinary') { 171 $info->{data_type} = 'varbinary'; 172 173 my $props = $col_obj->Properties; 174 for my $prop_idx (0..$props->Count-1) { 175 my $prop = $props->Item($prop_idx); 176 if ($prop->Name eq 'Fixed Length' && $prop->Value == 1) { 177 $info->{data_type} = 'binary'; 178 last; 179 } 180 } 181 182 $info->{size} = $col_obj->DefinedSize; 183 } 184 elsif ($data_type eq 'longtext') { 185 $info->{data_type} = 'text'; 186 $info->{original}{data_type} = 'longchar'; 187 delete $info->{size}; 188 } 189 } 190 191 return $result; 192} 193 194=head1 SEE ALSO 195 196L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS>, 197L<DBIx::Class::Schema::Loader::DBI::ADO>, 198L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, 199L<DBIx::Class::Schema::Loader::DBI> 200 201=head1 AUTHOR 202 203See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. 204 205=head1 LICENSE 206 207This library is free software; you can redistribute it and/or modify it under 208the same terms as Perl itself. 209 210=cut 211 2121; 213# vim:et sts=4 sw=4 tw=0: 214