[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DBI / Sybase.pm

package DBIx::Class::Schema::Loader::DBI::Sybase;

use strict;
use warnings;
use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common';
use mro 'c3';
use List::MoreUtils 'any';
use namespace::clean;

use DBIx::Class::Schema::Loader::Table::Sybase ();

our $VERSION = '0.07039';

=head1 NAME

DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI
Sybase ASE Implementation.

=head1 DESCRIPTION

See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.

This class reblesses into the L<DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server> class for connections to MSSQL.

=cut

sub _rebless {
    my $self = shift;

    my $dbh = $self->schema->storage->dbh;
    my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2];
    if ($DBMS_VERSION =~ /^Microsoft /i) {
        $DBMS_VERSION =~ s/\s/_/g;
        my $subclass = "DBIx::Class::Schema::Loader::DBI::Sybase::$DBMS_VERSION";
        if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
            bless $self, $subclass;
            $self->_rebless;
      }
    }
}

sub _system_databases {
    return (qw/
        master model sybsystemdb sybsystemprocs tempdb
    /);
}

sub _system_tables {
    return (qw/
        sysquerymetrics
    /);
}

sub _setup {
    my $self = shift;

    $self->next::method(@_);

    $self->preserve_case(1);

    my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');

    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 name
FROM master.dbo.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;

                        foreach my $owner (@$owners) {
                            push @owners, $owner
                                if defined $self->_uid($db, $owner);
                        }

                        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->dbh->do("USE [$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('SELECT user_name()') ];

        $self->qualify_objects(1) if @$owners > 1;

        $self->db_schema({ $current_db => $owners });
    }

    foreach my $db (keys %{ $self->db_schema }) {
        if ($self->db_schema->{$db} eq '%') {
            my $owners = $self->dbh->selectcol_arrayref(<<"EOF");
SELECT name
FROM [$db].dbo.sysusers
WHERE uid <> gid
EOF
            $self->db_schema->{$db} = $owners;

            $self->qualify_objects(1);
        }
    }
}

sub _tables_list {
    my ($self, $opts) = @_;

    my @tables;

    while (my ($db, $owners) = each %{ $self->db_schema }) {
        foreach my $owner (@$owners) {
            my ($uid) = $self->_uid($db, $owner);

            my $table_names = $self->dbh->selectcol_arrayref(<<"EOF");
SELECT name
FROM [$db].dbo.sysobjects
WHERE uid = $uid
    AND type IN ('U', 'V')
EOF

            TABLE: foreach my $table_name (@$table_names) {
                next TABLE if any { $_ eq $table_name } $self->_system_tables;

                push @tables, DBIx::Class::Schema::Loader::Table::Sybase->new(
                    loader   => $self,
                    name     => $table_name,
                    database => $db,
                    schema   => $owner,
                );
            }
        }
    }

    return $self->_filter_tables(\@tables, $opts);
}

sub _uid {
    my ($self, $db, $owner) = @_;

    my ($uid) = $self->dbh->selectrow_array(<<"EOF");
SELECT uid
FROM [$db].dbo.sysusers
WHERE name = @{[ $self->dbh->quote($owner) ]}
EOF

    return $uid;
}

sub _table_columns {
    my ($self, $table) = @_;

    my $db    = $table->database;
    my $owner = $table->schema;

    my $columns = $self->dbh->selectcol_arrayref(<<"EOF");
SELECT c.name
FROM [$db].dbo.syscolumns c
JOIN [$db].dbo.sysobjects o
    ON c.id = o.id
WHERE o.name = @{[ $self->dbh->quote($table->name) ]}
    AND o.type IN ('U', 'V')
    AND o.uid  = @{[ $self->_uid($db, $owner) ]}
ORDER BY c.colid ASC
EOF

    return $columns;
}

sub _table_pk_info {
    my ($self, $table) = @_;

    my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');

    my $db = $table->database;

    $self->dbh->do("USE [$db]");

    local $self->dbh->{FetchHashKeyName} = 'NAME_lc';

    my $sth = $self->dbh->prepare(<<"EOF");
sp_pkeys @{[ $self->dbh->quote($table->name) ]}, 
    @{[ $self->dbh->quote($table->schema) ]},
    @{[ $self->dbh->quote($db) ]}
EOF
    $sth->execute;

    my @keydata;

    while (my $row = $sth->fetchrow_hashref) {
        push @keydata, $row->{column_name};
    }

    $self->dbh->do("USE [$current_db]");

    return \@keydata;
}

sub _table_fk_info {
    my ($self, $table) = @_;

    my $db    = $table->database;
    my $owner = $table->schema;

    my $sth = $self->dbh->prepare(<<"EOF");
SELECT sr.reftabid, sd2.name, sr.keycnt,
    fokey1,  fokey2,   fokey3,   fokey4,   fokey5,   fokey6,   fokey7,   fokey8,
    fokey9,  fokey10,  fokey11,  fokey12,  fokey13,  fokey14,  fokey15,  fokey16,
    refkey1, refkey2,  refkey3,  refkey4,  refkey5,  refkey6,  refkey7,  refkey8,
    refkey9, refkey10, refkey11, refkey12, refkey13, refkey14, refkey15, refkey16
FROM [$db].dbo.sysreferences sr
JOIN [$db].dbo.sysobjects so1
    ON sr.tableid = so1.id
JOIN [$db].dbo.sysusers su1
    ON so1.uid = su1.uid
JOIN master.dbo.sysdatabases sd2
    ON sr.pmrydbid = sd2.dbid
WHERE so1.name = @{[ $self->dbh->quote($table->name) ]}
    AND su1.name = @{[ $self->dbh->quote($table->schema) ]}
EOF
    $sth->execute;

    my @rels;

    REL: while (my @rel = $sth->fetchrow_array) {
        my ($remote_tab_id, $remote_db, $key_cnt) = splice @rel, 0, 3;

        my ($remote_tab_owner, $remote_tab_name) =
            $self->dbh->selectrow_array(<<"EOF");
SELECT su.name, so.name
FROM [$remote_db].dbo.sysusers su
JOIN [$remote_db].dbo.sysobjects so
    ON su.uid = so.uid
WHERE so.id = $remote_tab_id
EOF

        next REL
            unless any { $_ eq $remote_tab_owner }
                @{ $self->db_schema->{$remote_db} || [] };

        my @local_col_ids  = splice @rel, 0, 16;
        my @remote_col_ids = splice @rel, 0, 16;

        @local_col_ids  = splice @local_col_ids,  0, $key_cnt;
        @remote_col_ids = splice @remote_col_ids, 0, $key_cnt;

        my $remote_table = DBIx::Class::Schema::Loader::Table::Sybase->new(
            loader   => $self,
            name     => $remote_tab_name,
            database => $remote_db,
            schema   => $remote_tab_owner,
        );

        my $all_local_cols  = $self->_table_columns($table);
        my $all_remote_cols = $self->_table_columns($remote_table);

        my @local_cols  = map $all_local_cols->[$_-1],  @local_col_ids;
        my @remote_cols = map $all_remote_cols->[$_-1], @remote_col_ids;

        next REL if    (any { not defined $_ } @local_cols)
                    || (any { not defined $_ } @remote_cols);

        push @rels, {
            local_columns  => \@local_cols,
            remote_table   => $remote_table,
            remote_columns => \@remote_cols,
        };
    };

    return \@rels;
}

sub _table_uniq_info {
    my ($self, $table) = @_;

    my $db    = $table->database;
    my $owner = $table->schema;
    my $uid   = $self->_uid($db, $owner);

    my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');

    $self->dbh->do("USE [$db]");

    my $sth = $self->dbh->prepare(<<"EOF");
SELECT si.name, si.indid, si.keycnt
FROM [$db].dbo.sysindexes si
JOIN [$db].dbo.sysobjects so
    ON si.id = so.id
WHERE so.name = @{[ $self->dbh->quote($table->name) ]}
    AND so.uid = $uid
    AND si.indid > 0
    AND si.status & 2048 <> 2048
    AND si.status2 & 2 = 2
EOF
    $sth->execute;

    my %uniqs;

    while (my ($ind_name, $ind_id, $key_cnt) = $sth->fetchrow_array) {
        COLS: foreach my $col_idx (1 .. ($key_cnt+1)) {
            my ($next_col) = $self->dbh->selectrow_array(<<"EOF");
SELECT index_col(
    @{[ $self->dbh->quote($table->name) ]},
    $ind_id, $col_idx, $uid
)
EOF
            last COLS unless defined $next_col;

            push @{ $uniqs{$ind_name} }, $next_col;
        }
    }

    my @uniqs = map { [ $_ => $uniqs{$_} ] } keys %uniqs;

    $self->dbh->do("USE [$current_db]");

    return \@uniqs;
}

sub _columns_info_for {
    my $self    = shift;
    my ($table) = @_;
    my $result  = $self->next::method(@_);

    my $db    = $table->database;
    my $owner = $table->schema;
    my $uid   = $self->_uid($db, $owner);

    local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
    my $sth = $self->dbh->prepare(<<"EOF");
SELECT c.name, bt.name base_type, ut.name user_type, c.prec prec, c.scale scale, c.length len, c.cdefault dflt_id, c.computedcol comp_id, (c.status & 0x80) is_id
FROM [$db].dbo.syscolumns c
LEFT JOIN [$db].dbo.sysobjects o  ON c.id       = o.id
LEFT JOIN [$db].dbo.systypes   bt ON c.type     = bt.type
LEFT JOIN [$db].dbo.systypes   ut ON c.usertype = ut.usertype
WHERE o.name = @{[ $self->dbh->quote($table) ]}
    AND o.uid = $uid
    AND o.type IN ('U', 'V')
EOF
    $sth->execute;
    my $info = $sth->fetchall_hashref('name');

    while (my ($col, $res) = each %$result) {
        $res->{data_type} = $info->{$col}{user_type} || $info->{$col}{base_type};

        if ($info->{$col}{is_id}) {
            $res->{is_auto_increment} = 1;
        }
        $sth->finish;

        # column has default value
        if (my $default_id = $info->{$col}{dflt_id}) {
            my $sth = $self->dbh->prepare(<<"EOF");
SELECT cm.id, cm.text
FROM [$db].dbo.syscomments cm
WHERE cm.id = $default_id
EOF
            $sth->execute;

            if (my ($d_id, $default) = $sth->fetchrow_array) {
                my $constant_default = ($default =~ /^DEFAULT \s+ (\S.*\S)/ix)
                    ? $1
                    : $default;

                $constant_default = substr($constant_default, 1, length($constant_default) - 2)
                    if (   substr($constant_default, 0, 1) =~ m{['"\[]}
                        && substr($constant_default, -1)   =~ m{['"\]]});

                $res->{default_value} = $constant_default;
            }
        }

        # column is a computed value
        if (my $comp_id = $info->{$col}{comp_id}) {
            my $sth = $self->dbh->prepare(<<"EOF");
SELECT cm.id, cm.text
FROM [$db].dbo.syscomments cm
WHERE cm.id = $comp_id
EOF
            $sth->execute;
            if (my ($c_id, $comp) = $sth->fetchrow_array) {
                my $function = ($comp =~ /^AS \s+ (\S+)/ix) ? $1 : $comp;
                $res->{default_value} = \$function;

                if ($function =~ /^getdate\b/) {
                    $res->{inflate_datetime} = 1;
                }

                delete $res->{size};
                $res->{data_type} = undef;
            }
        }

        if (my $data_type = $res->{data_type}) {
            if ($data_type eq 'int') {
                $data_type = $res->{data_type} = 'integer';
            }
            elsif ($data_type eq 'decimal') {
                $data_type = $res->{data_type} = 'numeric';
            }
            elsif ($data_type eq 'float') {
                $data_type = $res->{data_type}
                    = ($info->{$col}{len} <= 4 ? 'real' : 'double precision');
            }

            if ($data_type eq 'timestamp') {
                $res->{inflate_datetime} = 0;
            }

            if ($data_type =~ /^(?:text|unitext|image|bigint|integer|smallint|tinyint|real|double|double precision|float|date|time|datetime|smalldatetime|money|smallmoney|timestamp|bit)\z/i) {
                delete $res->{size};
            }
            elsif ($data_type eq 'numeric') {
                my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};

                if (!defined $prec && !defined $scale) {
                    $data_type = $res->{data_type} = 'integer';
                    delete $res->{size};
                }
                elsif ($prec == 18 && $scale == 0) {
                    delete $res->{size};
                }
                else {
                    $res->{size} = [ $prec, $scale ];
                }
            }
            elsif ($data_type =~ /char/) {
                $res->{size} = $info->{$col}{len};

                if ($data_type =~ /^(?:unichar|univarchar)\z/i) {
                    $res->{size} /= 2;
                }
                elsif ($data_type =~ /^n(?:var)?char\z/i) {
                    my ($nchar_size) = $self->dbh->selectrow_array('SELECT @@ncharsize');

                    $res->{size} /= $nchar_size;
                }
            }
        }
    }

    return $result;
}

=head1 SEE ALSO

L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
L<DBIx::Class::Schema::Loader::DBI>

=head1 AUTHOR

See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;
# vim:et sts=4 sw=4 tw=0:
Commit	Line	Data
fe67d343	1	package DBIx::Class::Schema::Loader::DBI::Sybase;
	2
	3	use strict;
	4	use warnings;
de82711a	5	use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common';
942bd5e0	6	use mro 'c3';
c4a69b87	7	use List::MoreUtils 'any';
	8	use namespace::clean;
	9
	10	use DBIx::Class::Schema::Loader::Table::Sybase ();
fe67d343	11
a6900c91	12	our $VERSION = '0.07039';
fe67d343	13
	14	=head1 NAME
	15
5163dc4a	16	DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI
5163dc4a	17	Sybase ASE Implementation.
fe67d343	18
	19	=head1 DESCRIPTION
	20
5163dc4a	21	See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
fe67d343	22
c4a69b87	23	This class reblesses into the L<DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server> class for connections to MSSQL.
bc1cb85e	24
c4a69b87	25	=cut
565335e6	26
fe67d343	27	sub _rebless {
	28	my $self = shift;
	29
	30	my $dbh = $self->schema->storage->dbh;
	31	my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2];
	32	if ($DBMS_VERSION =~ /^Microsoft /i) {
b1e43108	33	$DBMS_VERSION =~ s/\s/_/g;
b1e43108	34	my $subclass = "DBIx::Class::Schema::Loader::DBI::Sybase::$DBMS_VERSION";
65f74457	35	if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
	36	bless $self, $subclass;
	37	$self->_rebless;
fe67d343	38	}
	39	}
	40	}
	41
c4a69b87	42	sub _system_databases {
	43	return (qw/
	44	master model sybsystemdb sybsystemprocs tempdb
	45	/);
	46	}
	47
	48	sub _system_tables {
	49	return (qw/
	50	sysquerymetrics
	51	/);
	52	}
	53
	54	sub _setup {
	55	my $self = shift;
	56
	57	$self->next::method(@_);
	58
	59	$self->preserve_case(1);
	60
	61	my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
	62
	63	if (ref $self->db_schema eq 'HASH') {
	64	if (keys %{ $self->db_schema } < 2) {
	65	my ($db) = keys %{ $self->db_schema };
	66
	67	$db \|\|= $current_db;
	68
	69	if ($db eq '%') {
	70	my $owners = $self->db_schema->{$db};
	71
	72	my $db_names = $self->dbh->selectcol_arrayref(<<'EOF');
	73	SELECT name
	74	FROM master.dbo.sysdatabases
	75	EOF
	76
	77	my @dbs;
	78
	79	foreach my $db_name (@$db_names) {
	80	push @dbs, $db_name
	81	unless any { $_ eq $db_name } $self->_system_databases;
	82	}
	83
	84	$self->db_schema({});
	85
	86	DB: foreach my $db (@dbs) {
	87	if (not ((ref $owners eq 'ARRAY' && $owners->[0] eq '%') \|\| $owners eq '%')) {
	88	my @owners;
	89
	90	foreach my $owner (@$owners) {
	91	push @owners, $owner
	92	if defined $self->_uid($db, $owner);
	93	}
	94
	95	next DB unless @owners;
	96
	97	$self->db_schema->{$db} = \@owners;
	98	}
	99	else {
	100	# for post-processing below
	101	$self->db_schema->{$db} = '%';
	102	}
	103	}
	104
	105	$self->qualify_objects(1);
106	}
107	else {
108	if ($db ne $current_db) {
109	$self->dbh->do("USE [$db]");
110
111	$self->qualify_objects(1);
112	}
113	}
114	}
115	else {
116	$self->qualify_objects(1);
117	}
118	}
119	elsif (ref $self->db_schema eq 'ARRAY' \|\| (not defined $self->db_schema)) {
120	my $owners = $self->db_schema;
121	$owners \|\|= [ $self->dbh->selectrow_array('SELECT user_name()') ];
122
123	$self->qualify_objects(1) if @$owners > 1;
124
125	$self->db_schema({ $current_db => $owners });
126	}
127
128	foreach my $db (keys %{ $self->db_schema }) {
129	if ($self->db_schema->{$db} eq '%') {
130	my $owners = $self->dbh->selectcol_arrayref(<<"EOF");
131	SELECT name
132	FROM [$db].dbo.sysusers
133	WHERE uid <> gid
134	EOF
135	$self->db_schema->{$db} = $owners;
136
137	$self->qualify_objects(1);
138	}
139	}
140	}
141
8f65b7e5	142	sub _tables_list {
	143	my ($self, $opts) = @_;
	144
c4a69b87	145	my @tables;
8f65b7e5	146
c4a69b87	147	while (my ($db, $owners) = each %{ $self->db_schema }) {
	148	foreach my $owner (@$owners) {
	149	my ($uid) = $self->_uid($db, $owner);
8f65b7e5	150
c4a69b87	151	my $table_names = $self->dbh->selectcol_arrayref(<<"EOF");
	152	SELECT name
	153	FROM [$db].dbo.sysobjects
	154	WHERE uid = $uid
	155	AND type IN ('U', 'V')
	156	EOF
	157
	158	TABLE: foreach my $table_name (@$table_names) {
	159	next TABLE if any { $_ eq $table_name } $self->_system_tables;
	160
	161	push @tables, DBIx::Class::Schema::Loader::Table::Sybase->new(
	162	loader => $self,
	163	name => $table_name,
	164	database => $db,
	165	schema => $owner,
	166	);
	167	}
	168	}
	169	}
8f65b7e5	170
	171	return $self->_filter_tables(\@tables, $opts);
	172	}
	173
c4a69b87	174	sub _uid {
	175	my ($self, $db, $owner) = @_;
	176
	177	my ($uid) = $self->dbh->selectrow_array(<<"EOF");
	178	SELECT uid
	179	FROM [$db].dbo.sysusers
	180	WHERE name = @{[ $self->dbh->quote($owner) ]}
	181	EOF
	182
	183	return $uid;
	184	}
	185
fe67d343	186	sub _table_columns {
	187	my ($self, $table) = @_;
	188
c4a69b87	189	my $db = $table->database;
	190	my $owner = $table->schema;
	191
	192	my $columns = $self->dbh->selectcol_arrayref(<<"EOF");
9a55cbd2	193	SELECT c.name
c4a69b87	194	FROM [$db].dbo.syscolumns c
	195	JOIN [$db].dbo.sysobjects o
	196	ON c.id = o.id
	197	WHERE o.name = @{[ $self->dbh->quote($table->name) ]}
	198	AND o.type IN ('U', 'V')
	199	AND o.uid = @{[ $self->_uid($db, $owner) ]}
	200	ORDER BY c.colid ASC
	201	EOF
fe67d343	202
	203	return $columns;
	204	}
	205
	206	sub _table_pk_info {
	207	my ($self, $table) = @_;
	208
c4a69b87	209	my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
	210
	211	my $db = $table->database;
	212
	213	$self->dbh->do("USE [$db]");
	214
	215	local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
	216
	217	my $sth = $self->dbh->prepare(<<"EOF");
	218	sp_pkeys @{[ $self->dbh->quote($table->name) ]},
	219	@{[ $self->dbh->quote($table->schema) ]},
	220	@{[ $self->dbh->quote($db) ]}
	221	EOF
fe67d343	222	$sth->execute;
	223
	224	my @keydata;
	225
	226	while (my $row = $sth->fetchrow_hashref) {
c9373b79	227	push @keydata, $row->{column_name};
fe67d343	228	}
fe67d343	229
c4a69b87	230	$self->dbh->do("USE [$current_db]");
c4a69b87	231
fe67d343	232	return \@keydata;
	233	}
	234
	235	sub _table_fk_info {
	236	my ($self, $table) = @_;
	237
c4a69b87	238	my $db = $table->database;
	239	my $owner = $table->schema;
	240
	241	my $sth = $self->dbh->prepare(<<"EOF");
	242	SELECT sr.reftabid, sd2.name, sr.keycnt,
	243	fokey1, fokey2, fokey3, fokey4, fokey5, fokey6, fokey7, fokey8,
	244	fokey9, fokey10, fokey11, fokey12, fokey13, fokey14, fokey15, fokey16,
	245	refkey1, refkey2, refkey3, refkey4, refkey5, refkey6, refkey7, refkey8,
	246	refkey9, refkey10, refkey11, refkey12, refkey13, refkey14, refkey15, refkey16
	247	FROM [$db].dbo.sysreferences sr
	248	JOIN [$db].dbo.sysobjects so1
	249	ON sr.tableid = so1.id
	250	JOIN [$db].dbo.sysusers su1
	251	ON so1.uid = su1.uid
	252	JOIN master.dbo.sysdatabases sd2
	253	ON sr.pmrydbid = sd2.dbid
	254	WHERE so1.name = @{[ $self->dbh->quote($table->name) ]}
	255	AND su1.name = @{[ $self->dbh->quote($table->schema) ]}
	256	EOF
fe67d343	257	$sth->execute;
fe67d343	258
c4a69b87	259	my @rels;
0852b7b8	260
c4a69b87	261	REL: while (my @rel = $sth->fetchrow_array) {
c4a69b87	262	my ($remote_tab_id, $remote_db, $key_cnt) = splice @rel, 0, 3;
dc379dc6	263
c4a69b87	264	my ($remote_tab_owner, $remote_tab_name) =
	265	$self->dbh->selectrow_array(<<"EOF");
	266	SELECT su.name, so.name
	267	FROM [$remote_db].dbo.sysusers su
	268	JOIN [$remote_db].dbo.sysobjects so
	269	ON su.uid = so.uid
	270	WHERE so.id = $remote_tab_id
	271	EOF
dc379dc6	272
c4a69b87	273	next REL
	274	unless any { $_ eq $remote_tab_owner }
	275	@{ $self->db_schema->{$remote_db} \|\| [] };
dc379dc6	276
c4a69b87	277	my @local_col_ids = splice @rel, 0, 16;
c4a69b87	278	my @remote_col_ids = splice @rel, 0, 16;
0852b7b8	279
c4a69b87	280	@local_col_ids = splice @local_col_ids, 0, $key_cnt;
c4a69b87	281	@remote_col_ids = splice @remote_col_ids, 0, $key_cnt;
0852b7b8	282
c4a69b87	283	my $remote_table = DBIx::Class::Schema::Loader::Table::Sybase->new(
	284	loader => $self,
	285	name => $remote_tab_name,
	286	database => $remote_db,
	287	schema => $remote_tab_owner,
	288	);
0852b7b8	289
c4a69b87	290	my $all_local_cols = $self->_table_columns($table);
c4a69b87	291	my $all_remote_cols = $self->_table_columns($remote_table);
0852b7b8	292
c4a69b87	293	my @local_cols = map $all_local_cols->[$_-1], @local_col_ids;
c4a69b87	294	my @remote_cols = map $all_remote_cols->[$_-1], @remote_col_ids;
dc379dc6	295
c4a69b87	296	next REL if (any { not defined $_ } @local_cols)
c4a69b87	297	\|\| (any { not defined $_ } @remote_cols);
dc379dc6	298
	299	push @rels, {
	300	local_columns => \@local_cols,
dc379dc6	301	remote_table => $remote_table,
c4a69b87	302	remote_columns => \@remote_cols,
dc379dc6	303	};
c4a69b87	304	};
0852b7b8	305
	306	return \@rels;
	307	}
	308
fe67d343	309	sub _table_uniq_info {
	310	my ($self, $table) = @_;
	311
c4a69b87	312	my $db = $table->database;
	313	my $owner = $table->schema;
	314	my $uid = $self->_uid($db, $owner);
	315
	316	my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
	317
	318	$self->dbh->do("USE [$db]");
	319
	320	my $sth = $self->dbh->prepare(<<"EOF");
	321	SELECT si.name, si.indid, si.keycnt
	322	FROM [$db].dbo.sysindexes si
	323	JOIN [$db].dbo.sysobjects so
	324	ON si.id = so.id
	325	WHERE so.name = @{[ $self->dbh->quote($table->name) ]}
	326	AND so.uid = $uid
	327	AND si.indid > 0
	328	AND si.status & 2048 <> 2048
	329	AND si.status2 & 2 = 2
	330	EOF
	331	$sth->execute;
0852b7b8	332
c4a69b87	333	my %uniqs;
fe67d343	334
c4a69b87	335	while (my ($ind_name, $ind_id, $key_cnt) = $sth->fetchrow_array) {
	336	COLS: foreach my $col_idx (1 .. ($key_cnt+1)) {
	337	my ($next_col) = $self->dbh->selectrow_array(<<"EOF");
	338	SELECT index_col(
	339	@{[ $self->dbh->quote($table->name) ]},
	340	$ind_id, $col_idx, $uid
	341	)
	342	EOF
	343	last COLS unless defined $next_col;
	344
	345	push @{ $uniqs{$ind_name} }, $next_col;
fe67d343	346	}
	347	}
	348
c4a69b87	349	my @uniqs = map { [ $_ => $uniqs{$_} ] } keys %uniqs;
	350
	351	$self->dbh->do("USE [$current_db]");
	352
fe67d343	353	return \@uniqs;
	354	}
	355
db4d62ad	356	sub _columns_info_for {
	357	my $self = shift;
	358	my ($table) = @_;
	359	my $result = $self->next::method(@_);
	360
c4a69b87	361	my $db = $table->database;
	362	my $owner = $table->schema;
	363	my $uid = $self->_uid($db, $owner);
	364
	365	local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
	366	my $sth = $self->dbh->prepare(<<"EOF");
006c8ed3	367	SELECT c.name, bt.name base_type, ut.name user_type, c.prec prec, c.scale scale, c.length len, c.cdefault dflt_id, c.computedcol comp_id, (c.status & 0x80) is_id
c4a69b87	368	FROM [$db].dbo.syscolumns c
006c8ed3	369	LEFT JOIN [$db].dbo.sysobjects o ON c.id = o.id
	370	LEFT JOIN [$db].dbo.systypes bt ON c.type = bt.type
	371	LEFT JOIN [$db].dbo.systypes ut ON c.usertype = ut.usertype
c4a69b87	372	WHERE o.name = @{[ $self->dbh->quote($table) ]}
	373	AND o.uid = $uid
	374	AND o.type IN ('U', 'V')
	375	EOF
db4d62ad	376	$sth->execute;
2fb9a4b3	377	my $info = $sth->fetchall_hashref('name');
db4d62ad	378
2fb9a4b3	379	while (my ($col, $res) = each %$result) {
006c8ed3	380	$res->{data_type} = $info->{$col}{user_type} \|\| $info->{$col}{base_type};
c4a69b87	381
006c8ed3	382	if ($info->{$col}{is_id}) {
c4a69b87	383	$res->{is_auto_increment} = 1;
c4a69b87	384	}
e17ad40a	385	$sth->finish;
41968729	386
006c8ed3	387	# column has default value
	388	if (my $default_id = $info->{$col}{dflt_id}) {
	389	my $sth = $self->dbh->prepare(<<"EOF");
	390	SELECT cm.id, cm.text
	391	FROM [$db].dbo.syscomments cm
	392	WHERE cm.id = $default_id
	393	EOF
	394	$sth->execute;
	395
	396	if (my ($d_id, $default) = $sth->fetchrow_array) {
	397	my $constant_default = ($default =~ /^DEFAULT \s+ (\S.*\S)/ix)
	398	? $1
	399	: $default;
	400
	401	$constant_default = substr($constant_default, 1, length($constant_default) - 2)
	402	if ( substr($constant_default, 0, 1) =~ m{['"\[]}
	403	&& substr($constant_default, -1) =~ m{['"\]]});
	404
	405	$res->{default_value} = $constant_default;
	406	}
41968729	407	}
2fb9a4b3	408
006c8ed3	409	# column is a computed value
	410	if (my $comp_id = $info->{$col}{comp_id}) {
	411	my $sth = $self->dbh->prepare(<<"EOF");
	412	SELECT cm.id, cm.text
	413	FROM [$db].dbo.syscomments cm
	414	WHERE cm.id = $comp_id
	415	EOF
	416	$sth->execute;
	417	if (my ($c_id, $comp) = $sth->fetchrow_array) {
	418	my $function = ($comp =~ /^AS \s+ (\S+)/ix) ? $1 : $comp;
2fb9a4b3	419	$res->{default_value} = \$function;
0faae4b8	420
	421	if ($function =~ /^getdate\b/) {
	422	$res->{inflate_datetime} = 1;
	423	}
5163dc4a	424
	425	delete $res->{size};
	426	$res->{data_type} = undef;
2fb9a4b3	427	}
2fb9a4b3	428	}
6ecee584	429
6ecee584	430	if (my $data_type = $res->{data_type}) {
5163dc4a	431	if ($data_type eq 'int') {
	432	$data_type = $res->{data_type} = 'integer';
	433	}
	434	elsif ($data_type eq 'decimal') {
	435	$data_type = $res->{data_type} = 'numeric';
	436	}
006c8ed3	437	elsif ($data_type eq 'float') {
	438	$data_type = $res->{data_type}
	439	= ($info->{$col}{len} <= 4 ? 'real' : 'double precision');
	440	}
	441
	442	if ($data_type eq 'timestamp') {
	443	$res->{inflate_datetime} = 0;
	444	}
5163dc4a	445
5163dc4a	446	if ($data_type =~ /^(?:text\|unitext\|image\|bigint\|integer\|smallint\|tinyint\|real\|double\|double precision\|float\|date\|time\|datetime\|smalldatetime\|money\|smallmoney\|timestamp\|bit)\z/i) {
6ecee584	447	delete $res->{size};
6ecee584	448	}
5163dc4a	449	elsif ($data_type eq 'numeric') {
	450	my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};
	451
006c8ed3	452	if (!defined $prec && !defined $scale) {
	453	$data_type = $res->{data_type} = 'integer';
	454	delete $res->{size};
	455	}
	456	elsif ($prec == 18 && $scale == 0) {
5163dc4a	457	delete $res->{size};
	458	}
	459	else {
	460	$res->{size} = [ $prec, $scale ];
	461	}
6ecee584	462	}
c4a69b87	463	elsif ($data_type =~ /char/) {
	464	$res->{size} = $info->{$col}{len};
	465
	466	if ($data_type =~ /^(?:unichar\|univarchar)\z/i) {
	467	$res->{size} /= 2;
	468	}
e17ad40a	469	elsif ($data_type =~ /^n(?:var)?char\z/i) {
	470	my ($nchar_size) = $self->dbh->selectrow_array('SELECT @@ncharsize');
	471
	472	$res->{size} /= $nchar_size;
	473	}
6ecee584	474	}
6ecee584	475	}
db4d62ad	476	}
	477
	478	return $result;
	479	}
	480
fe67d343	481	=head1 SEE ALSO
fe67d343	482
5163dc4a	483	L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
fe67d343	484	L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
	485	L<DBIx::Class::Schema::Loader::DBI>
	486
	487	=head1 AUTHOR
	488
9cc8e7e1	489	See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
fe67d343	490
be80bba7	491	=head1 LICENSE
0852b7b8	492
be80bba7	493	This library is free software; you can redistribute it and/or modify it under
be80bba7	494	the same terms as Perl itself.
0852b7b8	495
fe67d343	496	=cut
	497
	498	1;
db9c411a	499	# vim:et sts=4 sw=4 tw=0: