[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.07002';

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

    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 if $_[0] == 17461; }; 
    my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}});
    $sth->execute;

    my @fk_info;
    while (my $row = $sth->fetchrow_hashref) {
        (my $ksq = $row->{key_seq}) =~ s/\s+//g;

        my @keys = qw/pktable_name pkcolumn_name fktable_name fkcolumn_name/;
        my %ds;
        @ds{@keys}   = @{$row}{@keys};
        $ds{key_seq} = $ksq;

        push @{ $fk_info[$ksq] }, \%ds;
    }

    my $max_keys = $#fk_info;
    my @rels;
    for my $level (reverse 1 .. $max_keys) {
        my @level_rels;
        $level_rels[$level] = splice @fk_info, $level, 1;
        my $count = @{ $level_rels[$level] };

        for my $sub_level (reverse 1 .. $level-1) {
            my $total = @{ $fk_info[$sub_level] };

            $level_rels[$sub_level] = [
                splice @{ $fk_info[$sub_level] }, $total-$count, $count
            ];
        }

        while (1) {
            my @rel = map shift @$_, @level_rels[1..$level];

            last unless defined $rel[0];

            my @local_columns  = map $_->{fkcolumn_name}, @rel;
            my @remote_columns = map $_->{pkcolumn_name}, @rel;
            my $remote_table   = $rel[0]->{pktable_name};

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