Commit | Line | Data |
3b17d988 |
1 | package DBIx::Class::Schema::Loader::DBI::ADO; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use base 'DBIx::Class::Schema::Loader::DBI'; |
6 | use mro 'c3'; |
7 | use Carp::Clan qw/^DBIx::Class/; |
8 | use namespace::clean; |
9 | |
4295c4b4 |
10 | our $VERSION = '0.07010'; |
3b17d988 |
11 | |
12 | =head1 NAME |
13 | |
14 | DBIx::Class::Schema::Loader::DBI::ADO - L<DBD::ADO> proxy |
15 | |
16 | =head1 DESCRIPTION |
17 | |
18 | Reblesses into an C<::ADO::> class when connecting via L<DBD::ADO>. |
19 | |
20 | See L<DBIx::Class::Schema::Loader::Base> for usage information. |
21 | |
22 | =cut |
23 | |
24 | sub _rebless { |
25 | my $self = shift; |
26 | |
27 | return if ref $self ne __PACKAGE__; |
28 | |
29 | my $dbh = $self->schema->storage->dbh; |
30 | my $dbtype = eval { $dbh->get_info(17) }; |
31 | unless ( $@ ) { |
32 | # Translate the backend name into a perl identifier |
33 | $dbtype =~ s/\W/_/gi; |
34 | my $class = "DBIx::Class::Schema::Loader::DBI::ADO::${dbtype}"; |
35 | if ($self->load_optional_class($class) && !$self->isa($class)) { |
36 | bless $self, $class; |
37 | $self->_rebless; |
38 | } |
39 | } |
40 | } |
41 | |
42 | sub _tables_list { |
43 | my ($self, $opts) = @_; |
44 | |
45 | return $self->next::method($opts, undef, undef); |
46 | } |
47 | |
48 | sub _filter_tables { |
49 | my $self = shift; |
50 | |
51 | local $^W = 0; # turn off exception printing from Win32::OLE |
52 | |
53 | $self->next::method(@_); |
54 | } |
55 | |
56 | =head1 SEE ALSO |
57 | |
58 | L<DBIx::Class::Schema::Loader::DBI::ADO::Microsoft_SQL_Server>, |
59 | L<DBIx::Class::Schema::Loader::DBI::ADO::MS_Jet>, |
60 | L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, |
61 | L<DBIx::Class::Schema::Loader::DBI> |
62 | |
63 | =head1 AUTHOR |
64 | |
65 | See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. |
66 | |
67 | =head1 LICENSE |
68 | |
69 | This library is free software; you can redistribute it and/or modify it under |
70 | the same terms as Perl itself. |
71 | |
72 | =cut |
73 | |
74 | 1; |