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