1 package DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet;
6 DBIx::Class::Schema::Loader::DBI::ADO
7 DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS
10 use Carp::Clan qw/^DBIx::Class/;
14 our $VERSION = '0.07008';
18 DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet - ADO wrapper for
19 L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS>
23 Proxy for L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS> when using
26 See L<DBIx::Class::Schema::Loader::Base> for usage information.
33 $self->schema->storage->dbh->get_info(2);
39 return $self->__ado_connection if $self->__ado_connection;
41 my ($dsn, $user, $pass) = @{ $self->schema->storage->_dbi_connect_info };
45 if (ref $dsn eq 'CODE') {
46 ($dsn, $user, $pass) = $self->_try_infer_connect_info_from_coderef($dsn);
49 my $dbh = $self->schema->storage->dbh;
51 $user = $dbh->{Username};
57 my $conn = Win32::OLE->new('ADODB.Connection');
59 $dsn =~ s/^dbi:[^:]+://i;
61 local $Win32::OLE::Warn = 0;
64 for my $s (split /;/, $dsn) {
65 my ($k, $v) = split /=/, $s, 2;
66 if (defined $conn->{$k}) {
73 $dsn = join ';', @dsn;
75 $user = '' unless defined $user;
77 if ((not $have_pass) && exists $self->_passwords->{$dsn}{$user}) {
78 $pass = $self->_passwords->{$dsn}{$user};
81 $pass = '' unless defined $pass;
84 $conn->Open($dsn, $user, $pass);
88 if (exists $ENV{DBI_PASS}) {
89 $pass = $ENV{DBI_PASS};
91 $conn->Open($dsn, $user, $pass);
92 $self->_passwords->{$dsn}{$user} = $pass;
95 print "Enter database password for $user ($dsn): ";
96 chomp($pass = <STDIN>);
97 $conn->Open($dsn, $user, $pass);
98 $self->_passwords->{$dsn}{$user} = $pass;
102 print "Enter database password for $user ($dsn): ";
103 chomp($pass = <STDIN>);
104 $conn->Open($dsn, $user, $pass);
105 $self->_passwords->{$dsn}{$user} = $pass;
113 $self->__ado_connection($conn);
118 sub _columns_info_for {
122 my $result = $self->next::method(@_);
124 while (my ($col, $info) = each %$result) {
125 my $data_type = $info->{data_type};
129 $self->_adox_catalog->Tables->Item($table)->Columns;
131 for my $col_idx (0..$cols->Count-1) {
132 $col_obj = $cols->Item($col_idx);
133 if ($self->preserve_case) {
134 last if $col_obj->Name eq $col;
137 last if lc($col_obj->Name) eq lc($col);
141 if ($col_obj->Attributes | 2 == 2) {
142 $info->{is_nullable} = 1;
145 if ($data_type eq 'long') {
146 $info->{data_type} = 'integer';
147 delete $info->{size};
149 my $props = $col_obj->Properties;
150 for my $prop_idx (0..$props->Count-1) {
151 my $prop = $props->Item($prop_idx);
152 if ($prop->Name eq 'Autoincrement' && $prop->Value == 1) {
153 $info->{is_auto_increment} = 1;
158 elsif ($data_type eq 'short') {
159 $info->{data_type} = 'smallint';
160 delete $info->{size};
162 elsif ($data_type eq 'single') {
163 $info->{data_type} = 'real';
164 delete $info->{size};
166 elsif ($data_type eq 'money') {
167 if (ref $info->{size} eq 'ARRAY') {
168 if ($info->{size}[0] == 19 && $info->{size}[1] == 255) {
169 delete $info->{size};
172 # it's really a decimal
173 $info->{data_type} = 'decimal';
175 if ($info->{size}[0] == 18 && $info->{size}[1] == 0) {
177 delete $info->{size};
179 delete $info->{original};
183 elsif ($data_type eq 'varchar') {
184 $info->{data_type} = 'char' if $col_obj->Type == 130;
185 $info->{size} = $col_obj->DefinedSize;
187 elsif ($data_type eq 'bigbinary') {
188 $info->{data_type} = 'varbinary';
190 my $props = $col_obj->Properties;
191 for my $prop_idx (0..$props->Count-1) {
192 my $prop = $props->Item($prop_idx);
193 if ($prop->Name eq 'Fixed Length' && $prop->Value == 1) {
194 $info->{data_type} = 'binary';
200 $info->{size} = $col_obj->DefinedSize;
202 elsif ($data_type eq 'longtext') {
203 $info->{data_type} = 'text';
204 $info->{original}{data_type} = 'longchar';
205 delete $info->{size};
214 L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS>,
215 L<DBIx::Class::Schema::Loader::DBI::ADO>,
216 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
217 L<DBIx::Class::Schema::Loader::DBI>
221 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
225 This library is free software; you can redistribute it and/or modify it under
226 the same terms as Perl itself.
231 # vim:et sts=4 sw=4 tw=0: