X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FInformix.pm;h=6820dc3e9bf882863d310c10b2362bdebf6ec760;hb=306bf770bf08b06f92863808b1938f2fc704acb0;hp=c0051807b4986f13dee54888312bacaf53d07496;hpb=ed18888ff8321c761bae36b744a015098374c616;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm b/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm
index c005180..6820dc3 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Informix.pm
@@ -2,13 +2,15 @@ package DBIx::Class::Schema::Loader::DBI::Informix;
 
 use strict;
 use warnings;
-use mro 'c3';
 use base qw/DBIx::Class::Schema::Loader::DBI/;
-use Carp::Clan qw/^DBIx::Class/;
+use mro 'c3';
 use Scalar::Util 'looks_like_number';
+use List::Util 'any';
+use Try::Tiny;
 use namespace::clean;
+use DBIx::Class::Schema::Loader::Table::Informix ();
 
-our $VERSION = '0.07002';
+our $VERSION = '0.07047';
 
 =head1 NAME
 
@@ -21,6 +23,43 @@ See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
 
 =cut
 
+sub _build_name_sep { '.' }
+
+sub _system_databases {
+    return (qw/
+        sysmaster sysutils sysuser sysadmin
+    /);
+}
+
+sub _current_db {
+    my $self = shift;
+
+    my ($current_db) = $self->dbh->selectrow_array(<<'EOF');
+SELECT rtrim(ODB_DBName)
+FROM sysmaster:informix.SysOpenDB
+WHERE ODB_SessionID = (
+        SELECT DBINFO('sessionid')
+        FROM informix.SysTables
+        WHERE TabID = 1
+    ) and ODB_IsCurrent = 'Y'
+EOF
+
+    return $current_db;
+}
+
+sub _owners {
+    my ($self, $db) = @_;
+
+    my ($owners) = $self->dbh->selectcol_arrayref(<<"EOF");
+SELECT distinct(rtrim(owner))
+FROM ${db}:informix.systables
+EOF
+
+    my @owners = grep $_ && $_ ne 'informix' && !/^\d/, @$owners;
+
+    return @owners;
+}
+
 sub _setup {
     my $self = shift;
 
@@ -33,35 +72,156 @@ sub _setup {
         $self->schema->storage->sql_maker->quote_char('"');
         $self->schema->storage->sql_maker->name_sep('.');
     }
+
+    my $current_db = $self->_current_db;
+
+    if (ref $self->db_schema eq 'HASH') {
+        if (keys %{ $self->db_schema } < 2) {
+            my ($db) = keys %{ $self->db_schema };
+
+            $db ||= $current_db;
+
+            if ($db eq '%') {
+                my $owners = $self->db_schema->{$db};
+
+                my $db_names = $self->dbh->selectcol_arrayref(<<'EOF');
+SELECT rtrim(name)
+FROM sysmaster:sysdatabases
+EOF
+
+                my @dbs;
+
+                foreach my $db_name (@$db_names) {
+                    push @dbs, $db_name
+                        unless any { $_ eq $db_name } $self->_system_databases;
+                }
+
+                $self->db_schema({});
+
+                DB: foreach my $db (@dbs) {
+                    if (not ((ref $owners eq 'ARRAY' && $owners->[0] eq '%') || $owners eq '%')) {
+                        my @owners;
+
+                        my @db_owners = try {
+                            $self->_owners($db);
+                        }
+                        catch {
+                            if (/without logging/) {
+                                warn
+"Database '$db' is unreferencable due to lack of logging.\n";
+                            }
+                            return ();
+                        };
+
+                        foreach my $owner (@$owners) {
+                            push @owners, $owner
+                                if any { $_ eq $owner } @db_owners;
+                        }
+
+                        next DB unless @owners;
+
+                        $self->db_schema->{$db} = \@owners;
+                    }
+                    else {
+                        # for post-processing below
+                        $self->db_schema->{$db} = '%';
+                    }
+                }
+
+                $self->qualify_objects(1);
+            }
+            else {
+                if ($db ne $current_db) {
+                    $self->qualify_objects(1);
+                }
+            }
+        }
+        else {
+            $self->qualify_objects(1);
+        }
+    }
+    elsif (ref $self->db_schema eq 'ARRAY' || (not defined $self->db_schema)) {
+        my $owners = $self->db_schema;
+        $owners ||= [ $self->dbh->selectrow_array(<<'EOF') ];
+SELECT rtrim(username)
+FROM sysmaster:syssessions
+WHERE sid = DBINFO('sessionid')
+EOF
+
+        $self->qualify_objects(1) if @$owners > 1;
+
+        $self->db_schema({ $current_db => $owners });
+    }
+
+    DB: foreach my $db (keys %{ $self->db_schema }) {
+        if ($self->db_schema->{$db} eq '%') {
+            my @db_owners = try {
+                $self->_owners($db);
+            }
+            catch {
+                if (/without logging/) {
+                    warn
+"Database '$db' is unreferencable due to lack of logging.\n";
+                }
+                return ();
+            };
+
+            if (not @db_owners) {
+                delete $self->db_schema->{$db};
+                next DB;
+            }
+
+            $self->db_schema->{$db} = \@db_owners;
+
+            $self->qualify_objects(1);
+        }
+    }
 }
 
 sub _tables_list {
-    my ($self, $opts) = @_;
+    my ($self) = @_;
+
+    my @tables;
 
-    my $dbh = $self->schema->storage->dbh;
-    my $sth = $dbh->prepare(<<'EOF');
-select tabname from systables t
-where t.owner <> 'informix' and t.owner <> '' and t.tabname <> ' VERSION'
+    while (my ($db, $owners) = each %{ $self->db_schema }) {
+        foreach my $owner (@$owners) {
+            my $table_names = $self->dbh->selectcol_arrayref(<<"EOF", {}, $owner);
+select tabname
+FROM ${db}:informix.systables
+WHERE rtrim(owner) = ?
 EOF
-    $sth->execute;
 
-    my @tables = map @$_, @{ $sth->fetchall_arrayref };
+            TABLE: foreach my $table_name (@$table_names) {
+                next if $table_name =~ /^\s/;
 
-    return $self->_filter_tables(\@tables, $opts);
+                push @tables, DBIx::Class::Schema::Loader::Table::Informix->new(
+                    loader   => $self,
+                    name     => $table_name,
+                    database => $db,
+                    schema   => $owner,
+                );
+            }
+        }
+    }
+
+    return $self->_filter_tables(\@tables);
 }
 
 sub _constraints_for {
     my ($self, $table, $type) = @_;
 
-    my $dbh = $self->schema->storage->dbh;
-    local $dbh->{FetchHashKeyName} = 'NAME_lc';
+    local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
+
+    my $db = $table->database;
 
-    my $sth = $dbh->prepare(<<'EOF');
-select c.constrname, i.*
-from sysconstraints c
-join systables t on t.tabid = c.tabid
-join sysindexes i on c.idxname = i.idxname
-where t.tabname = ? and c.constrtype = ?
+    my $sth = $self->dbh->prepare(<<"EOF");
+SELECT c.constrname, i.*
+FROM ${db}:informix.sysconstraints c
+JOIN ${db}:informix.systables t
+    ON t.tabid = c.tabid
+JOIN ${db}:informix.sysindexes i
+    ON c.idxname = i.idxname
+WHERE t.tabname = ? and c.constrtype = ?
 EOF
     $sth->execute($table, $type);
     my $indexes = $sth->fetchall_hashref('constrname');
@@ -80,24 +240,26 @@ EOF
 sub _idx_colnames {
     my ($self, $idx_info, $table_cols_by_colno) = @_;
 
-    return [ map $self->_lc($table_cols_by_colno->{$_}), grep $_, map $idx_info->{$_}, map "part$_", (1..16) ];
+    return [ map $table_cols_by_colno->{$_}, grep $_, map $idx_info->{$_}, map "part$_", (1..16) ];
 }
 
 sub _colnames_by_colno {
     my ($self, $table) = @_;
 
-    my $dbh = $self->schema->storage->dbh;
-    local $dbh->{FetchHashKeyName} = 'NAME_lc';
+    local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
 
-    my $sth = $dbh->prepare(<<'EOF');
-select c.colname, c.colno
-from syscolumns c
-join systables t on c.tabid = t.tabid
-where t.tabname = ?
+    my $db = $table->database;
+
+    my $sth = $self->dbh->prepare(<<"EOF");
+SELECT c.colname, c.colno
+FROM ${db}:informix.syscolumns c
+JOIN ${db}:informix.systables t
+    ON c.tabid = t.tabid
+WHERE t.tabname = ?
 EOF
     $sth->execute($table);
     my $cols = $sth->fetchall_hashref('colno');
-    $cols = { map +($_, $cols->{$_}{colname}), keys %$cols };
+    $cols = { map +($_, $self->_lc($cols->{$_}{colname})), keys %$cols };
 
     return $cols;
 }
@@ -115,8 +277,7 @@ sub _table_uniq_info {
 
     my $constraints = $self->_constraints_for($table, 'U');
 
-    my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints;
-    return \@uniqs;
+    return [ map { [ $_ => $constraints->{$_} ] } sort keys %$constraints ];
 }
 
 sub _table_fk_info {
@@ -124,18 +285,24 @@ sub _table_fk_info {
 
     my $local_columns = $self->_constraints_for($table, 'R');
 
-    my $dbh = $self->schema->storage->dbh;
-    local $dbh->{FetchHashKeyName} = 'NAME_lc';
-
-    my $sth = $dbh->prepare(<<'EOF');
-select c.constrname local_constraint, rt.tabname remote_table, rc.constrname remote_constraint, ri.*
-from sysconstraints c
-join systables t on c.tabid = t.tabid
-join sysreferences r on c.constrid = r.constrid
-join sysconstraints rc on rc.constrid = r.primary
-join systables rt on r.ptabid = rt.tabid
-join sysindexes ri on rc.idxname = ri.idxname
-where t.tabname = ? and c.constrtype = 'R'
+    local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
+
+    my $db = $table->database;
+
+    my $sth = $self->dbh->prepare(<<"EOF");
+SELECT c.constrname local_constraint, rt.tabname remote_table, rtrim(rt.owner) remote_owner, rc.constrname remote_constraint, ri.*
+FROM ${db}:informix.sysconstraints c
+JOIN ${db}:informix.systables t
+    ON c.tabid = t.tabid
+JOIN ${db}:informix.sysreferences r
+    ON c.constrid = r.constrid
+JOIN ${db}:informix.sysconstraints rc
+    ON rc.constrid = r.primary
+JOIN ${db}:informix.systables rt
+    ON r.ptabid = rt.tabid
+JOIN ${db}:informix.sysindexes ri
+    ON rc.idxname = ri.idxname
+WHERE t.tabname = ? and c.constrtype = 'R'
 EOF
     $sth->execute($table);
     my $remotes = $sth->fetchall_hashref('local_constraint');
@@ -144,10 +311,17 @@ EOF
     my @rels;
 
     while (my ($local_constraint, $remote_info) = each %$remotes) {
+        my $remote_table = DBIx::Class::Schema::Loader::Table::Informix->new(
+            loader   => $self,
+            name     => $remote_info->{remote_table},
+            database => $db,
+            schema   => $remote_info->{remote_owner},
+        );
+
         push @rels, {
-            local_columns => $local_columns->{$local_constraint},
-            remote_columns => $self->_idx_colnames($remote_info, $self->_colnames_by_colno($remote_info->{remote_table})),
-            remote_table => $remote_info->{remote_table},
+            local_columns  => $local_columns->{$local_constraint},
+            remote_columns => $self->_idx_colnames($remote_info, $self->_colnames_by_colno($remote_table)),
+            remote_table   => $remote_table,
         };
     }
 
@@ -185,14 +359,16 @@ sub _columns_info_for {
 
     my $result = $self->next::method(@_);
 
-    my $dbh = $self->schema->storage->dbh;
+    my $db = $table->database;
 
-    my $sth = $dbh->prepare(<<'EOF');
-select c.colname, c.coltype, c.collength, c.colmin, d.type deflt_type, d.default deflt
-from syscolumns c
-join systables t on c.tabid = t.tabid
-left join sysdefaults d on t.tabid = d.tabid and c.colno = d.colno
-where t.tabname = ?
+    my $sth = $self->dbh->prepare(<<"EOF");
+SELECT c.colname, c.coltype, c.collength, c.colmin, d.type deflt_type, d.default deflt
+FROM ${db}:informix.syscolumns c
+JOIN ${db}:informix.systables t
+    ON c.tabid = t.tabid
+LEFT JOIN ${db}:informix.sysdefaults d
+    ON t.tabid = d.tabid AND c.colno = d.colno
+WHERE t.tabname = ?
 EOF
     $sth->execute($table);
     my $cols = $sth->fetchall_hashref('colname');
@@ -206,48 +382,42 @@ EOF
         if ($type == 6) { # SERIAL
             $result->{$col}{is_auto_increment} = 1;
         }
-
-        my $data_type = $result->{$col}{data_type};
-
-        if (looks_like_number $data_type) {
-            if ($type == 7) {
-                $result->{$col}{data_type} = 'date';
-            }
-            elsif ($type == 10) {
-                $result->{$col}{data_type} = 'datetime year to fraction(5)';
-                # this doesn't work yet
+        elsif ($type == 7) {
+            $result->{$col}{data_type} = 'date';
+        }
+        elsif ($type == 10) {
+            $result->{$col}{data_type} = 'datetime year to fraction(5)';
+            # this doesn't work yet
 #                $result->{$col}{data_type} = 'datetime ' . $self->_informix_datetime_precision($info->{collength});
-            }
-            elsif ($type == 17 || $type == 52) {
-                $result->{$col}{data_type} = 'bigint';
-            }
-            elsif ($type == 40) {
-                $result->{$col}{data_type} = 'lvarchar';
-                $result->{$col}{size}      = $info->{collength};
-            }
-            elsif ($type == 12) {
-                $result->{$col}{data_type} = 'text';
-            }
-            elsif ($type == 11) {
-                $result->{$col}{data_type}           = 'bytea';
-                $result->{$col}{original}{data_type} = 'byte';
-            }
-            elsif ($type == 41) {
-                # XXX no way to distinguish opaque types boolean, blob and clob
-                $result->{$col}{data_type} = 'blob';
-            }
-            elsif ($type == 21) {
-                $result->{$col}{data_type} = 'list';
-            }
-            elsif ($type == 20) {
-                $result->{$col}{data_type} = 'multiset';
-            }
-            elsif ($type == 19) {
-                $result->{$col}{data_type} = 'set';
-            }
         }
-
-        if ($type == 15) {
+        elsif ($type == 17 || $type == 52) {
+            $result->{$col}{data_type} = 'bigint';
+        }
+        elsif ($type == 40) {
+            $result->{$col}{data_type} = 'lvarchar';
+            $result->{$col}{size}      = $info->{collength};
+        }
+        elsif ($type == 12) {
+            $result->{$col}{data_type} = 'text';
+        }
+        elsif ($type == 11) {
+            $result->{$col}{data_type}           = 'bytea';
+            $result->{$col}{original}{data_type} = 'byte';
+        }
+        elsif ($type == 41) {
+            # XXX no way to distinguish opaque types boolean, blob and clob
+            $result->{$col}{data_type} = 'blob' unless $result->{$col}{data_type} eq 'smallint';
+        }
+        elsif ($type == 21) {
+            $result->{$col}{data_type} = 'list';
+        }
+        elsif ($type == 20) {
+            $result->{$col}{data_type} = 'multiset';
+        }
+        elsif ($type == 19) {
+            $result->{$col}{data_type} = 'set';
+        }
+        elsif ($type == 15) {
             $result->{$col}{data_type} = 'nchar';
         }
         elsif ($type == 16) {
@@ -258,11 +428,42 @@ EOF
             $result->{$col}{data_type} = 'idssecuritylabel';
         }
 
+        my $data_type = $result->{$col}{data_type};
+
+        if ($data_type !~ /^(?:[nl]?(?:var)?char|decimal)\z/i) {
+            delete $result->{$col}{size};
+        }
+
+        if (lc($data_type) eq 'decimal') {
+            no warnings 'uninitialized';
+
+            $result->{$col}{data_type} = 'numeric';
+
+            my @size = @{ $result->{$col}{size} || [] };
+
+            if ($size[0] == 16 && $size[1] == -4) {
+                delete $result->{$col}{size};
+            }
+            elsif ($size[0] == 16 && $size[1] == 2) {
+                $result->{$col}{data_type} = 'money';
+                delete $result->{$col}{size};
+            }
+        }
+        elsif (lc($data_type) eq 'smallfloat') {
+            $result->{$col}{data_type} = 'real';
+        }
+        elsif (lc($data_type) eq 'float') {
+            $result->{$col}{data_type} = 'double precision';
+        }
+        elsif ($data_type =~ /^n?(?:var)?char\z/i) {
+            $result->{$col}{size} = $result->{$col}{size}[0];
+        }
+
         # XXX colmin doesn't work for min size of varchar columns, it's NULL
 #        if (lc($data_type) eq 'varchar') {
 #            $result->{$col}{size}[1] = $info->{colmin};
 #        }
-       
+
         my ($default_type, $default) = @{$info}{qw/deflt_type deflt/};
 
         next unless $default_type;
@@ -288,40 +489,6 @@ EOF
         }
     }
 
-    # fix up data_types some more
-    while (my ($col, $info) = each %$result) {
-        my $data_type = $info->{data_type};
-
-        if ($data_type !~ /^(?:[nl]?(?:var)?char|decimal)\z/i) {
-            delete $info->{size};
-        }
-
-        if (lc($data_type) eq 'decimal') {
-            no warnings 'uninitialized';
-
-            $info->{data_type} = 'numeric';
-
-            my @size = @{ $info->{size} || [] };
-
-            if ($size[0] == 16 && $size[1] == -4) {
-                delete $info->{size};
-            }
-            elsif ($size[0] == 16 && $size[1] == 2) {
-                $info->{data_type} = 'money';
-                delete $info->{size};
-            }
-        }
-        elsif (lc($data_type) eq 'smallfloat') {
-            $info->{data_type} = 'real';
-        }
-        elsif (lc($data_type) eq 'float') {
-            $info->{data_type} = 'double precision';
-        }
-        elsif ($data_type =~ /^n?(?:var)?char\z/i) {
-            $info->{size} = $info->{size}[0];
-        }
-    }
-
     return $result;
 }
 
@@ -330,9 +497,9 @@ EOF
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
 L<DBIx::Class::Schema::Loader::DBI>
 
-=head1 AUTHOR
+=head1 AUTHORS
 
-See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHORS>.
 
 =head1 LICENSE