[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 Carp::Clan qw/^DBIx::Class/;
use mro 'c3';

our $VERSION = '0.07010';

=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>.

=cut

sub _setup {
    my $self = shift;

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

    if (not defined $self->preserve_case) {
        $self->preserve_case(1);
    }
}

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 _tables_list {
    my ($self, $opts) = @_;

    my $dbh = $self->schema->storage->dbh;

    my $sth = $dbh->table_info(undef, $self->db_schema, undef, "'TABLE','VIEW'");

    my @tables = grep $_ ne 'sysquerymetrics',
              map $_->{table_name}, @{ $sth->fetchall_arrayref({ table_name => 1 }) };

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

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

    my $dbh = $self->schema->storage->dbh;
    my $columns = $dbh->selectcol_arrayref(qq{
SELECT c.name
FROM syscolumns c JOIN sysobjects o
ON c.id = o.id
WHERE o.name = @{[ $dbh->quote($table) ]} AND o.type = 'U'
});

    return $columns;
}

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

    my $dbh = $self->schema->storage->dbh;
    my $sth = $dbh->prepare(qq{sp_pkeys @{[ $dbh->quote($table) ]}});
    $sth->execute;

    my @keydata;

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

    return \@keydata;
}

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

    # check if FK_NAME is supported

    my $dbh = $self->schema->storage->dbh;
    local $dbh->{FetchHashKeyName} = 'NAME_lc';
    # hide "Object does not exist in this database." when trying to fetch fkeys
    local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 }; 
    my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}});
    $sth->execute;
    my $row = $sth->fetchrow_hashref;

    return unless $row;

    if (exists $row->{fk_name}) {
        $sth->finish;
        return $self->_table_fk_info_by_name($table);
    }

    $sth->finish;
    return $self->_table_fk_info_by_sp_helpconstraint($table);
}

sub _table_fk_info_by_name {
    my ($self, $table) = @_;
    my ($local_cols, $remote_cols, $remote_table, @rels);

    my $dbh = $self->schema->storage->dbh;
    local $dbh->{FetchHashKeyName} = 'NAME_lc';
    # hide "Object does not exist in this database." when trying to fetch fkeys
    local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 }; 
    my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}});
    $sth->execute;

    while (my $row = $sth->fetchrow_hashref) {
        my $fk = $row->{fk_name};
        next unless defined $fk;

        push @{$local_cols->{$fk}}, $row->{fkcolumn_name};
        push @{$remote_cols->{$fk}}, $row->{pkcolumn_name};
        $remote_table->{$fk} = $row->{pktable_name};
    }

    foreach my $fk (keys %$remote_table) {
        push @rels, {
                     local_columns => \@{$local_cols->{$fk}},
                     remote_columns => \@{$remote_cols->{$fk}},
                     remote_table => $remote_table->{$fk},
                    };

    }
    return \@rels;
}

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

    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
    local $SIG{__WARN__} = sub {
        $warn_handler->(@_) unless $_[0] =~
            /^\s*$|^Total Number of|^Details|^(?:--?|=|\+) Number|^Formula for/;
    };

    my $dbh = $self->schema->storage->dbh;

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

    my $sth = $dbh->prepare("sp_helpconstraint $table");
    $sth->execute;

    my $constraints = $sth->fetchall_arrayref({});

    my @rels;

    foreach my $constraint (map $_->{definition}, @$constraints) {
        my ($local_cols, $remote_table, $remote_cols) = $constraint =~
/^$table FOREIGN KEY \(([^)]+)\) REFERENCES ([^(]+)\(([^)]+)\)/;

        next unless $local_cols;

        my @local_cols  = split /,\s*/, $local_cols;
        my @remote_cols = split /,\s*/, $remote_cols;

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

    return \@rels;
}

sub _table_uniq_info {
    no warnings 'uninitialized'; # for presumably XS weirdness with null operations
    my ($self, $table) = @_;

    local $SIG{__WARN__} = sub { warn @_
        unless $_[0] =~ /^Formula for Calculation:|^(?:--?|\+|=) Number of (?:self )?references|^Total Number of Referential Constraints|^Details:|^\s*$/ };

    my $dbh = $self->schema->storage->dbh;
    local $dbh->{FetchHashKeyName} = 'NAME_lc';
    my $sth = $dbh->prepare(qq{sp_helpconstraint \@objname=@{[ $dbh->quote($table) ]}, \@nomsg='nomsg'});
    eval { $sth->execute };
    return if $@;

    my $constraints;
    while (my $row = $sth->fetchrow_hashref) {
        if (exists $row->{constraint_type}) {
            my $type = $row->{constraint_type} || '';
            if ($type =~ /^unique/i) {
                my $name = $row->{constraint_name};
                push @{$constraints->{$name}},
                    ( split /,/, $row->{constraint_keys} );
            }
        } else {
            my $def = $row->{definition} || next;
            next unless $def =~ /^unique/i;
            my $name = $row->{name};
            my ($keys) = $def =~ /\((.*)\)/;
            $keys =~ s/\s*//g;
            my @keys = split /,/ => $keys;
            push @{$constraints->{$name}}, @keys;
        }
    }

    my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints;
    return \@uniqs;
}

# get the correct data types, defaults and size
sub _columns_info_for {
    my $self    = shift;
    my ($table) = @_;
    my $result  = $self->next::method(@_);

    my $dbh = $self->schema->storage->dbh;
    my $sth = $dbh->prepare(qq{
SELECT c.name name, bt.name base_type, ut.name user_type, cm.text deflt, c.prec prec, c.scale scale, c.length len
FROM syscolumns c
JOIN sysobjects o ON c.id = o.id
LEFT JOIN systypes bt ON c.type     = bt.type 
LEFT JOIN systypes ut ON c.usertype = ut.usertype
LEFT JOIN syscomments cm
    ON cm.id = CASE WHEN c.cdefault = 0 THEN c.computedcol ELSE c.cdefault END
WHERE o.name = @{[ $dbh->quote($table) ]} AND o.type = 'U'
});
    $sth->execute;
    local $dbh->{FetchHashKeyName} = 'NAME_lc';
    my $info = $sth->fetchall_hashref('name');

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

        if ($data_type && $data_type =~ /^timestamp\z/i) {
            $res->{inflate_datetime} = 0;
        }

        if (my $default = $info->{$col}{deflt}) {
            if ($default =~ /^AS \s+ (\S+)/ix) {
                my $function = $1;
                $res->{default_value} = \$function;

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

                delete $res->{size};
                $res->{data_type} = undef;
            }
            elsif ($default =~ /^DEFAULT \s+ (\S+)/ix) {
                my ($constant_default) = $1 =~ /^['"\[\]]?(.*?)['"\[\]]?\z/;
                $res->{default_value} = $constant_default;
            }
        }

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

            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 ($prec == 18 && $scale == 0) {
                    delete $res->{size};
                }
                else {
                    $res->{size} = [ $prec, $scale ];
                }
            }
            elsif ($data_type =~ /^(?:unichar|univarchar)\z/i) {
                $res->{size} /= 2;
            }
        }

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

    return $result;
}

sub _extra_column_info {
    my ($self, $table, $column, $info, $dbi_info) = @_;
    my %extra_info;

    my $dbh = $self->schema->storage->dbh;
    my $sth = $dbh->prepare(qq{SELECT name FROM syscolumns WHERE id = (SELECT id FROM sysobjects WHERE name = @{[ $dbh->quote($table) ]}) AND (status & 0x80) = 0x80 AND name = @{[ $dbh->quote($column) ]}});
    $sth->execute();

    if ($sth->fetchrow_array) {
        $extra_info{is_auto_increment} = 1;
    }

    return \%extra_info;
}

=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';
fe67d343	6	use Carp::Clan qw/^DBIx::Class/;
942bd5e0	7	use mro 'c3';
fe67d343	8
4295c4b4	9	our $VERSION = '0.07010';
fe67d343	10
	11	=head1 NAME
	12
5163dc4a	13	DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI
5163dc4a	14	Sybase ASE Implementation.
fe67d343	15
	16	=head1 DESCRIPTION
	17
5163dc4a	18	See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
fe67d343	19
	20	=cut
	21
bc1cb85e	22	sub _setup {
	23	my $self = shift;
	24
	25	$self->next::method(@_);
	26
	27	if (not defined $self->preserve_case) {
	28	$self->preserve_case(1);
	29	}
	30	}
565335e6	31
fe67d343	32	sub _rebless {
	33	my $self = shift;
	34
	35	my $dbh = $self->schema->storage->dbh;
	36	my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2];
	37	if ($DBMS_VERSION =~ /^Microsoft /i) {
b1e43108	38	$DBMS_VERSION =~ s/\s/_/g;
b1e43108	39	my $subclass = "DBIx::Class::Schema::Loader::DBI::Sybase::$DBMS_VERSION";
65f74457	40	if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
	41	bless $self, $subclass;
	42	$self->_rebless;
fe67d343	43	}
	44	}
	45	}
	46
8f65b7e5	47	sub _tables_list {
	48	my ($self, $opts) = @_;
	49
	50	my $dbh = $self->schema->storage->dbh;
	51
	52	my $sth = $dbh->table_info(undef, $self->db_schema, undef, "'TABLE','VIEW'");
	53
	54	my @tables = grep $_ ne 'sysquerymetrics',
	55	map $_->{table_name}, @{ $sth->fetchall_arrayref({ table_name => 1 }) };
	56
	57	return $self->_filter_tables(\@tables, $opts);
	58	}
	59
fe67d343	60	sub _table_columns {
	61	my ($self, $table) = @_;
	62
	63	my $dbh = $self->schema->storage->dbh;
9a55cbd2	64	my $columns = $dbh->selectcol_arrayref(qq{
	65	SELECT c.name
	66	FROM syscolumns c JOIN sysobjects o
	67	ON c.id = o.id
	68	WHERE o.name = @{[ $dbh->quote($table) ]} AND o.type = 'U'
	69	});
fe67d343	70
	71	return $columns;
	72	}
	73
	74	sub _table_pk_info {
	75	my ($self, $table) = @_;
	76
	77	my $dbh = $self->schema->storage->dbh;
772367d3	78	my $sth = $dbh->prepare(qq{sp_pkeys @{[ $dbh->quote($table) ]}});
fe67d343	79	$sth->execute;
	80
	81	my @keydata;
	82
	83	while (my $row = $sth->fetchrow_hashref) {
c9373b79	84	push @keydata, $row->{column_name};
fe67d343	85	}
	86
	87	return \@keydata;
	88	}
	89
	90	sub _table_fk_info {
	91	my ($self, $table) = @_;
	92
0852b7b8	93	# check if FK_NAME is supported
565335e6	94
0852b7b8	95	my $dbh = $self->schema->storage->dbh;
565335e6	96	local $dbh->{FetchHashKeyName} = 'NAME_lc';
0852b7b8	97	# hide "Object does not exist in this database." when trying to fetch fkeys
0852b7b8	98	local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 };
772367d3	99	my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}});
0852b7b8	100	$sth->execute;
	101	my $row = $sth->fetchrow_hashref;
	102
	103	return unless $row;
	104
	105	if (exists $row->{fk_name}) {
	106	$sth->finish;
	107	return $self->_table_fk_info_by_name($table);
	108	}
	109
	110	$sth->finish;
dc379dc6	111	return $self->_table_fk_info_by_sp_helpconstraint($table);
0852b7b8	112	}
	113
	114	sub _table_fk_info_by_name {
	115	my ($self, $table) = @_;
	116	my ($local_cols, $remote_cols, $remote_table, @rels);
565335e6	117
0852b7b8	118	my $dbh = $self->schema->storage->dbh;
0852b7b8	119	local $dbh->{FetchHashKeyName} = 'NAME_lc';
fe67d343	120	# hide "Object does not exist in this database." when trying to fetch fkeys
0852b7b8	121	local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 };
772367d3	122	my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}});
fe67d343	123	$sth->execute;
	124
	125	while (my $row = $sth->fetchrow_hashref) {
0852b7b8	126	my $fk = $row->{fk_name};
0852b7b8	127	next unless defined $fk;
565335e6	128
	129	push @{$local_cols->{$fk}}, $row->{fkcolumn_name};
	130	push @{$remote_cols->{$fk}}, $row->{pkcolumn_name};
	131	$remote_table->{$fk} = $row->{pktable_name};
fe67d343	132	}
	133
	134	foreach my $fk (keys %$remote_table) {
65f74457	135	push @rels, {
	136	local_columns => \@{$local_cols->{$fk}},
	137	remote_columns => \@{$remote_cols->{$fk}},
	138	remote_table => $remote_table->{$fk},
	139	};
fe67d343	140
	141	}
	142	return \@rels;
	143	}
	144
dc379dc6	145	sub _table_fk_info_by_sp_helpconstraint {
0852b7b8	146	my ($self, $table) = @_;
0852b7b8	147
dc379dc6	148	my $warn_handler = $SIG{__WARN__} \|\| sub { warn @_ };
	149	local $SIG{__WARN__} = sub {
	150	$warn_handler->(@_) unless $_[0] =~
	151	/^\s*$\|^Total Number of\|^Details\|^(?:--?\|=\|\+) Number\|^Formula for/;
	152	};
	153
0852b7b8	154	my $dbh = $self->schema->storage->dbh;
dc379dc6	155
0852b7b8	156	local $dbh->{FetchHashKeyName} = 'NAME_lc';
dc379dc6	157
dc379dc6	158	my $sth = $dbh->prepare("sp_helpconstraint $table");
0852b7b8	159	$sth->execute;
0852b7b8	160
dc379dc6	161	my $constraints = $sth->fetchall_arrayref({});
0852b7b8	162
dc379dc6	163	my @rels;
0852b7b8	164
dc379dc6	165	foreach my $constraint (map $_->{definition}, @$constraints) {
	166	my ($local_cols, $remote_table, $remote_cols) = $constraint =~
	167	/^$table FOREIGN KEY \(([^)]+)\) REFERENCES ([^(]+)\(([^)]+)\)/;
0852b7b8	168
dc379dc6	169	next unless $local_cols;
	170
	171	my @local_cols = split /,\s*/, $local_cols;
	172	my @remote_cols = split /,\s*/, $remote_cols;
	173
	174	push @rels, {
	175	local_columns => \@local_cols,
	176	remote_columns => \@remote_cols,
	177	remote_table => $remote_table,
	178	};
0852b7b8	179	}
	180
	181	return \@rels;
	182	}
	183
fe67d343	184	sub _table_uniq_info {
db9c411a	185	no warnings 'uninitialized'; # for presumably XS weirdness with null operations
fe67d343	186	my ($self, $table) = @_;
fe67d343	187
db9c411a	188	local $SIG{__WARN__} = sub { warn @_
db9c411a	189	unless $_[0] =~ /^Formula for Calculation:\|^(?:--?\|\+\|=) Number of (?:self )?references\|^Total Number of Referential Constraints\|^Details:\|^\s*$/ };
0852b7b8	190
fe67d343	191	my $dbh = $self->schema->storage->dbh;
0852b7b8	192	local $dbh->{FetchHashKeyName} = 'NAME_lc';
772367d3	193	my $sth = $dbh->prepare(qq{sp_helpconstraint \@objname=@{[ $dbh->quote($table) ]}, \@nomsg='nomsg'});
0852b7b8	194	eval { $sth->execute };
0852b7b8	195	return if $@;
fe67d343	196
	197	my $constraints;
	198	while (my $row = $sth->fetchrow_hashref) {
1e1839d1	199	if (exists $row->{constraint_type}) {
	200	my $type = $row->{constraint_type} \|\| '';
	201	if ($type =~ /^unique/i) {
c9373b79	202	my $name = $row->{constraint_name};
1e1839d1	203	push @{$constraints->{$name}},
c9373b79	204	( split /,/, $row->{constraint_keys} );
1e1839d1	205	}
	206	} else {
	207	my $def = $row->{definition} \|\| next;
	208	next unless $def =~ /^unique/i;
c9373b79	209	my $name = $row->{name};
1e1839d1	210	my ($keys) = $def =~ /\((.*)\)/;
1e1839d1	211	$keys =~ s/\s*//g;
c9373b79	212	my @keys = split /,/ => $keys;
1e1839d1	213	push @{$constraints->{$name}}, @keys;
fe67d343	214	}
	215	}
	216
	217	my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints;
	218	return \@uniqs;
	219	}
	220
6ecee584	221	# get the correct data types, defaults and size
db4d62ad	222	sub _columns_info_for {
	223	my $self = shift;
	224	my ($table) = @_;
	225	my $result = $self->next::method(@_);
	226
	227	my $dbh = $self->schema->storage->dbh;
	228	my $sth = $dbh->prepare(qq{
5163dc4a	229	SELECT c.name name, bt.name base_type, ut.name user_type, cm.text deflt, c.prec prec, c.scale scale, c.length len
db4d62ad	230	FROM syscolumns c
db4d62ad	231	JOIN sysobjects o ON c.id = o.id
5163dc4a	232	LEFT JOIN systypes bt ON c.type = bt.type
5163dc4a	233	LEFT JOIN systypes ut ON c.usertype = ut.usertype
2fb9a4b3	234	LEFT JOIN syscomments cm
2fb9a4b3	235	ON cm.id = CASE WHEN c.cdefault = 0 THEN c.computedcol ELSE c.cdefault END
db4d62ad	236	WHERE o.name = @{[ $dbh->quote($table) ]} AND o.type = 'U'
	237	});
	238	$sth->execute;
	239	local $dbh->{FetchHashKeyName} = 'NAME_lc';
2fb9a4b3	240	my $info = $sth->fetchall_hashref('name');
db4d62ad	241
2fb9a4b3	242	while (my ($col, $res) = each %$result) {
5163dc4a	243	my $data_type = $res->{data_type} = $info->{$col}{user_type} \|\| $info->{$col}{base_type};
41968729	244
	245	if ($data_type && $data_type =~ /^timestamp\z/i) {
	246	$res->{inflate_datetime} = 0;
	247	}
2fb9a4b3	248
	249	if (my $default = $info->{$col}{deflt}) {
	250	if ($default =~ /^AS \s+ (\S+)/ix) {
	251	my $function = $1;
	252	$res->{default_value} = \$function;
0faae4b8	253
	254	if ($function =~ /^getdate\b/) {
	255	$res->{inflate_datetime} = 1;
	256	}
5163dc4a	257
	258	delete $res->{size};
	259	$res->{data_type} = undef;
2fb9a4b3	260	}
2fb9a4b3	261	elsif ($default =~ /^DEFAULT \s+ (\S+)/ix) {
41968729	262	my ($constant_default) = $1 =~ /^['"\[\]]?(.*?)['"\[\]]?\z/;
2fb9a4b3	263	$res->{default_value} = $constant_default;
	264	}
	265	}
6ecee584	266
6ecee584	267	if (my $data_type = $res->{data_type}) {
5163dc4a	268	if ($data_type eq 'int') {
	269	$data_type = $res->{data_type} = 'integer';
	270	}
	271	elsif ($data_type eq 'decimal') {
	272	$data_type = $res->{data_type} = 'numeric';
	273	}
	274
	275	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	276	delete $res->{size};
6ecee584	277	}
5163dc4a	278	elsif ($data_type eq 'numeric') {
	279	my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};
	280
	281	if ($prec == 18 && $scale == 0) {
	282	delete $res->{size};
	283	}
	284	else {
	285	$res->{size} = [ $prec, $scale ];
	286	}
6ecee584	287	}
	288	elsif ($data_type =~ /^(?:unichar\|univarchar)\z/i) {
	289	$res->{size} /= 2;
	290	}
	291	}
5163dc4a	292
	293	if ($data_type eq 'float') {
	294	$res->{data_type} = $info->{$col}{len} <= 4 ? 'real' : 'double precision';
	295	}
db4d62ad	296	}
	297
	298	return $result;
	299	}
	300
fe67d343	301	sub _extra_column_info {
45be2ce7	302	my ($self, $table, $column, $info, $dbi_info) = @_;
fe67d343	303	my %extra_info;
fe67d343	304
fe67d343	305	my $dbh = $self->schema->storage->dbh;
772367d3	306	my $sth = $dbh->prepare(qq{SELECT name FROM syscolumns WHERE id = (SELECT id FROM sysobjects WHERE name = @{[ $dbh->quote($table) ]}) AND (status & 0x80) = 0x80 AND name = @{[ $dbh->quote($column) ]}});
fe67d343	307	$sth->execute();
	308
	309	if ($sth->fetchrow_array) {
	310	$extra_info{is_auto_increment} = 1;
	311	}
	312
	313	return \%extra_info;
	314	}
	315
	316	=head1 SEE ALSO
	317
5163dc4a	318	L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
fe67d343	319	L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
	320	L<DBIx::Class::Schema::Loader::DBI>
	321
	322	=head1 AUTHOR
	323
9cc8e7e1	324	See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
fe67d343	325
be80bba7	326	=head1 LICENSE
0852b7b8	327
be80bba7	328	This library is free software; you can redistribute it and/or modify it under
be80bba7	329	the same terms as Perl itself.
0852b7b8	330
fe67d343	331	=cut
	332
	333	1;
db9c411a	334	# vim:et sts=4 sw=4 tw=0: