• Home
  • History
  • Annotate
  • Line#
  • Navigate
  • Raw
  • Download
  • only in /macosx-10.9.5/CPANInternal-140/DBIx-Class-Schema-Loader-0.07033/lib/DBIx/Class/Schema/Loader/DBI/ADO/
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