[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::Util 'any';
use DBIx::Class::Schema::Loader::Table::Sybase ();
use namespace::clean;

our $VERSION = '0.07047';

=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) = @_;

    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);
}

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;
        }
    }

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

    return [ map { [ $_ => $uniqs{$_} ] } sort keys %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 AUTHORS

See L<DBIx::Class::Schema::Loader/AUTHORS>.

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