Commit | Line | Data |
2a57124d |
1 | package DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL; |
d23f094e |
2 | use strict; |
3 | use warnings; |
4 | |
2a57124d |
5 | use base qw/DBIx::Class::Storage::DBI::ODBC/; |
2ad62d97 |
6 | use mro 'c3'; |
d23f094e |
7 | |
2149a4e9 |
8 | warn 'Major advances took place in the DBIC codebase since this driver' |
9 | .' (::Storage::DBI::ODBC::DB2_400_SQL) was written. However since the' |
10 | .' RDBMS in question is so rare it is not possible for us to test any' |
11 | .' of the "new hottness". If you are using DB2 on AS-400 please get' |
12 | .' in contact with the developer team:' |
13 | .' http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT' |
14 | ."\n" |
15 | ; |
16 | |
2b8cc2f2 |
17 | __PACKAGE__->sql_quote_char('"'); |
18 | |
2149a4e9 |
19 | # FIXME |
20 | # Most likely all of this code is redundant and unnecessary. We should |
21 | # be able to simply use base qw/DBIx::Class::Storage::DBI::DB2/; |
22 | # Unfortunately nobody has an RDBMS engine to test with, so keeping |
23 | # things as-is for the time being |
24 | |
d4f16b21 |
25 | sub _dbh_last_insert_id { |
26 | my ($self, $dbh, $source, $col) = @_; |
d23f094e |
27 | |
d4f16b21 |
28 | # get the schema/table separator: |
29 | # '.' when SQL naming is active |
30 | # '/' when system naming is active |
584ea6e4 |
31 | my $sep = $self->_dbh_get_info(41); |
d4f16b21 |
32 | my $sth = $dbh->prepare_cached( |
33 | "SELECT IDENTITY_VAL_LOCAL() FROM SYSIBM${sep}SYSDUMMY1", {}, 3); |
34 | $sth->execute(); |
d23f094e |
35 | |
d4f16b21 |
36 | my @res = $sth->fetchrow_array(); |
d23f094e |
37 | |
d4f16b21 |
38 | return @res ? $res[0] : undef; |
d23f094e |
39 | } |
40 | |
32a46300 |
41 | sub _sql_maker_opts { |
f1f56aad |
42 | my ($self) = @_; |
d4daee7b |
43 | |
a9f32dbc |
44 | $self->dbh_do(sub { |
d4f16b21 |
45 | my ($self, $dbh) = @_; |
46 | |
47 | return { |
48 | limit_dialect => 'FetchFirst', |
584ea6e4 |
49 | name_sep => $self->_dbh_get_info(41) |
d4f16b21 |
50 | }; |
a9f32dbc |
51 | }); |
f1f56aad |
52 | } |
53 | |
d23f094e |
54 | 1; |
55 | |
56 | =head1 NAME |
57 | |
f1f56aad |
58 | DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL - Support specific to DB2/400 |
d23f094e |
59 | over ODBC |
60 | |
61 | =head1 SYNOPSIS |
62 | |
d88ecca6 |
63 | # In your result (table) classes |
64 | use base 'DBIx::Class::Core'; |
d23f094e |
65 | __PACKAGE__->set_primary_key('id'); |
66 | |
d23f094e |
67 | |
68 | =head1 DESCRIPTION |
69 | |
f1f56aad |
70 | This class implements support specific to DB2/400 over ODBC, including |
71 | auto-increment primary keys, SQL::Abstract::Limit dialect, and name separator |
32a46300 |
72 | for connections using either SQL naming or System naming. |
d23f094e |
73 | |
74 | |
75 | =head1 AUTHORS |
76 | |
c1e64353 |
77 | Marc Mims C<< <marc@questright.com> >> |
d23f094e |
78 | |
aa8b8190 |
79 | Based on DBIx::Class::Storage::DBI::DB2 by Jess Robinson. |
80 | |
d23f094e |
81 | =head1 LICENSE |
82 | |
83 | You may distribute this code under the same terms as Perl itself. |
84 | |
85 | =cut |