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'; |
3b17d988 |
10 | use Try::Tiny; |
11 | use namespace::clean; |
12 | |
22f91663 |
13 | our $VERSION = '0.07019'; |
3b17d988 |
14 | |
15 | =head1 NAME |
16 | |
17 | DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet - ADO wrapper for |
18 | L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS> |
19 | |
20 | =head1 DESCRIPTION |
21 | |
22 | Proxy for L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS> when using |
23 | L<DBD::ADO>. |
24 | |
25 | See L<DBIx::Class::Schema::Loader::Base> for usage information. |
26 | |
27 | =cut |
28 | |
29 | sub _db_path { |
30 | my $self = shift; |
31 | |
32 | $self->schema->storage->dbh->get_info(2); |
33 | } |
34 | |
35 | sub _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 | |
117 | sub _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 | |
2ae19e70 |
126 | my $col_obj = $self->_adox_column($table, $col); |
3b17d988 |
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 | } |
3b17d988 |
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 | |
196 | L<DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS>, |
197 | L<DBIx::Class::Schema::Loader::DBI::ADO>, |
198 | L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, |
199 | L<DBIx::Class::Schema::Loader::DBI> |
200 | |
201 | =head1 AUTHOR |
202 | |
203 | See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. |
204 | |
205 | =head1 LICENSE |
206 | |
207 | This library is free software; you can redistribute it and/or modify it under |
208 | the same terms as Perl itself. |
209 | |
210 | =cut |
211 | |
212 | 1; |
213 | # vim:et sts=4 sw=4 tw=0: |