[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / DBI / Sybase.pm

package SQL::Translator::Parser::DBI::Sybase;

# $Id: Sybase.pm,v 1.3 2003-10-04 00:10:00 phrrngtn Exp $

=head1 NAME

SQL::Translator::Parser::DBI::Sybase - parser for DBD::Sybase

=head1 SYNOPSIS

See SQL::Translator::Parser::DBI.

=head1 DESCRIPTION

Uses DBI Catalog Methods.

=cut

use strict;
use DBI;
use SQL::Translator::Schema;
use Data::Dumper;

use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;

no strict 'refs';

# -------------------------------------------------------------------
sub parse {
    my ( $tr, $dbh ) = @_;

    if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
        warn "setting dbh attribute {FetchHashKeyName} to NAME_uc";
        $dbh->{FetchHashKeyName} = 'NAME_uc';
    }

    if ($dbh->{ChopBlanks} != 1) {
        warn "setting dbh attribute {ChopBlanks} to 1";
        $dbh->{ChopBlanks} = 1;
    }

    my $schema = $tr->schema;

    my ($sth, @tables, $columns);
    my $stuff;

    ### Columns

    # it is much quicker to slurp back everything all at once rather
    # than make repeated calls

    $sth = $dbh->column_info();


    foreach my $c (@{$sth->fetchall_arrayref({})}) {
        $columns
            ->{$c->{TABLE_CAT}}
                ->{$c->{TABLE_SCHEM}}
                    ->{$c->{TABLE_NAME}}
                        ->{columns}
                            ->{$c->{COLUMN_NAME}}= $c;
    }

    ### Tables and views

    # Get a list of the tables and views.
    $sth = $dbh->table_info();
    @tables   = @{$sth->fetchall_arrayref({})};

    my $h = $dbh->selectall_arrayref(q{
SELECT o.name, colid,colid2,c.text
  FROM syscomments c
  JOIN sysobjects o
    ON c.id = o.id
 WHERE o.type ='V'
ORDER BY o.name,
         c.colid,
         c.colid2
}
);

    # View text
    # I had always thought there was something 'hard' about
    # reconstructing text from syscomments ..
    # this seems to work fine and is certainly not complicated!

    foreach (@{$h}) {
        $stuff->{view}->{$_->[0]}->{text} .= $_->[3];
    }

    #### objects with indexes.
    map {
        $stuff->{indexes}->{$_->[0]}++
            if defined;
    } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id) AS name
                                    FROM sysindexes
                                   WHERE indid > 0")};

    ## slurp objects
    map {
        $stuff->{$_->[1]}->{$_->[0]} = $_;
    } @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")};


    ### Procedures

    # This gets legitimate procedures by used the 'supported' API: sp_stored_procedures
    map {
        my $n = $_->{PROCEDURE_NAME};
        $n =~ s/;\d+$//;        # Ignore versions for now
        $_->{name} = $n;
        $stuff->{procedures}->{$n} = $_;
    } values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')};


    # And this blasts in the text of 'legit' stored procedures.  Do
    # this rather than calling sp_helptext in a loop.

    $h = $dbh->selectall_arrayref(q{
SELECT o.name, colid,colid2,c.text
  FROM syscomments c
  JOIN sysobjects o
    ON c.id = o.id
 WHERE o.type ='P'
ORDER BY o.name,
         c.colid,
         c.colid2
}
);

    foreach (@{$h}) {
        $stuff->{procedures}->{$_->[0]}->{text} .= $_->[3]
            if (defined($stuff->{procedures}->{$_->[0]}));
    }

    ### Defaults
    ### Rules
    ### Bind Defaults
    ### Bind Rules

    ### Triggers
    # Since the 'target' of the trigger is defined in the text, we will
    # just create them independently for now rather than associating them
    # with a table.

    $h = $dbh->selectall_arrayref(q{
SELECT o.name, colid,colid2,c.text
  FROM syscomments c
  JOIN sysobjects o
    ON c.id = o.id
  JOIN sysobjects o1
    ON (o.id = o1.instrig OR o.id = o1.deltrig or o.id = o1.updtrig)
 WHERE o.type ='TR'
ORDER BY o.name,
         c.colid,
         c.colid2
}
);
    foreach (@{$h}) {
        $stuff->{triggers}->{$_->[0]}->{text} .= $_->[3];
    }

    ### References
    ### Keys

    ### Types
    # Not sure what to do with these?
    $stuff->{type_info_all} = $dbh->type_info_all;

    ### Tables
    # According to the DBI docs, these can be

    # "TABLE"
    # "VIEW"
    # "SYSTEM TABLE"
    # "GLOBAL TEMPORARY",
    # "LOCAL TEMPORARY"
    # "ALIAS"
    # "SYNONYM"

    foreach my $table_info (@tables) {
        next
            unless (defined($table_info->{TABLE_TYPE}));

        if ($table_info->{TABLE_TYPE} =~ /TABLE/) {
            my $table = $schema->add_table(
                                           name =>
$table_info->{TABLE_NAME},
                                           type =>
$table_info->{TABLE_TYPE},
                                          ) || die $schema->error;

            # find the associated columns

            my $cols =
                $columns->{$table_info->{TABLE_QUALIFIER}}
                    ->{$table_info->{TABLE_OWNER}}
                        ->{$table_info->{TABLE_NAME}}
                            ->{columns};

            foreach my $c (values %{$cols}) {
                my $f = $table->add_field(
                                          name        => $c->{COLUMN_NAME},
                                          data_type   => $c->{TYPE_NAME},
                                          order       => $c->{ORDINAL_POSITION},
                                          size        => $c->{COLUMN_SIZE},
                                         ) || die $table->error;

                $f->is_nullable(1)
                    if ($c->{NULLABLE} == 1);
            }

            # add in primary key
            my $h = $dbh->selectall_hashref("sp_pkeys
$table_info->{TABLE_NAME}", 'COLUMN_NAME');
            if (scalar keys %{$h} > 1) {
                my @c = map {
                    $_->{COLUMN_NAME}
                } sort {
                    $a->{KEY_SEQ} <=> $b->{KEY_SEQ}
                } values %{$h};

                $table->primary_key(@c)
                    if (scalar @c);
            }

            # add in any indexes ... how do we tell if the index has
            # already been created as part of a primary key or other
            # constraint?

            if (defined($stuff->{indexes}->{$table_info->{TABLE_NAME}})){
                my $h = $dbh->selectall_hashref("sp_helpindex
$table_info->{TABLE_NAME}", 'INDEX_NAME');
                foreach (values %{$h}) {
                    my $fields = $_->{'INDEX_KEYS'};
                    $fields =~ s/\s*//g;
                    my $i = $table->add_index(
                                              name   =>
$_->{INDEX_NAME},
                                              fields => $fields,
                                             );
                    if ($_->{'INDEX_DESCRIPTION'} =~ /unique/i) {
                        $i->type('unique');

                        # we could make this a primary key if there
                        # isn't already one defined and if there
                        # aren't any nullable columns in thisindex.

                        if (!defined($table->primary_key())) {
                            $table->primary_key($fields)
                                unless grep {
                                    $table->get_field($_)->is_nullable()
                                } split(/,\s*/, $fields);
                        }
                    }
                }
            }
        } elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
            my $view =  $schema->add_view(
                                          name =>
$table_info->{TABLE_NAME},
                                          );


            my $cols =
                $columns->{$table_info->{TABLE_QUALIFIER}}
                    ->{$table_info->{TABLE_OWNER}}
                        ->{$table_info->{TABLE_NAME}}
                            ->{columns};

            $view->fields(map {
                $_->{COLUMN_NAME}
            } sort {
                $a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION}
                } values %{$cols}
                         );

            $view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})
                if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}));
        }
    }

    foreach my $p (values %{$stuff->{procedures}}) {
        my $proc = $schema->add_procedure(
                               name      => $p->{name},
                               owner     => $p->{PROCEDURE_OWNER},
                               comments  => $p->{REMARKS},
                               sql       => $p->{text},
                               );

    }
    ### Permissions
    ### Groups
    ### Users
    ### Aliases
    ### Logins
return 1;
}

1;

=pod

=head1 AUTHOR

Paul Harrington E<lt>harringp@deshaw.comE<gt>,

=head1 SEE ALSO

DBI, DBD::Sybase, SQL::Translator::Schema.

=cut
Commit	Line	Data
86ee0658	1	package SQL::Translator::Parser::DBI::Sybase;
86ee0658	2
1eb8ea88	3	# $Id: Sybase.pm,v 1.3 2003-10-04 00:10:00 phrrngtn Exp $
86ee0658	4
	5	=head1 NAME
	6
	7	SQL::Translator::Parser::DBI::Sybase - parser for DBD::Sybase
	8
	9	=head1 SYNOPSIS
	10
	11	See SQL::Translator::Parser::DBI.
	12
	13	=head1 DESCRIPTION
	14
	15	Uses DBI Catalog Methods.
	16
	17	=cut
	18
	19	use strict;
	20	use DBI;
	21	use SQL::Translator::Schema;
	22	use Data::Dumper;
	23
	24	use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
1eb8ea88	25	$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
86ee0658	26	$DEBUG = 0 unless defined $DEBUG;
	27
	28	no strict 'refs';
	29
	30	# -------------------------------------------------------------------
	31	sub parse {
	32	my ( $tr, $dbh ) = @_;
	33
	34	if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
	35	warn "setting dbh attribute {FetchHashKeyName} to NAME_uc";
	36	$dbh->{FetchHashKeyName} = 'NAME_uc';
	37	}
	38
	39	if ($dbh->{ChopBlanks} != 1) {
	40	warn "setting dbh attribute {ChopBlanks} to 1";
	41	$dbh->{ChopBlanks} = 1;
	42	}
	43
	44	my $schema = $tr->schema;
	45
	46	my ($sth, @tables, $columns);
	47	my $stuff;
	48
	49	### Columns
	50
	51	# it is much quicker to slurp back everything all at once rather
	52	# than make repeated calls
	53
	54	$sth = $dbh->column_info();
	55
	56
	57	foreach my $c (@{$sth->fetchall_arrayref({})}) {
	58	$columns
	59	->{$c->{TABLE_CAT}}
	60	->{$c->{TABLE_SCHEM}}
	61	->{$c->{TABLE_NAME}}
	62	->{columns}
	63	->{$c->{COLUMN_NAME}}= $c;
	64	}
	65
	66	### Tables and views
	67
	68	# Get a list of the tables and views.
	69	$sth = $dbh->table_info();
	70	@tables = @{$sth->fetchall_arrayref({})};
	71
	72	my $h = $dbh->selectall_arrayref(q{
	73	SELECT o.name, colid,colid2,c.text
	74	FROM syscomments c
	75	JOIN sysobjects o
	76	ON c.id = o.id
	77	WHERE o.type ='V'
	78	ORDER BY o.name,
	79	c.colid,
	80	c.colid2
	81	}
	82	);
	83
	84	# View text
	85	# I had always thought there was something 'hard' about
e36f4eac	86	# reconstructing text from syscomments ..
86ee0658	87	# this seems to work fine and is certainly not complicated!
	88
	89	foreach (@{$h}) {
	90	$stuff->{view}->{$_->[0]}->{text} .= $_->[3];
	91	}
	92
	93	#### objects with indexes.
	94	map {
	95	$stuff->{indexes}->{$_->[0]}++
	96	if defined;
1eb8ea88	97	} @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id) AS name
	98	FROM sysindexes
	99	WHERE indid > 0")};
86ee0658	100
	101	## slurp objects
	102	map {
	103	$stuff->{$_->[1]}->{$_->[0]} = $_;
1eb8ea88	104	} @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")};
86ee0658	105
	106
	107	### Procedures
1eb8ea88	108
	109	# This gets legitimate procedures by used the 'supported' API: sp_stored_procedures
	110	map {
	111	my $n = $_->{PROCEDURE_NAME};
	112	$n =~ s/;\d+$//; # Ignore versions for now
	113	$_->{name} = $n;
	114	$stuff->{procedures}->{$n} = $_;
	115	} values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')};
	116
	117
	118	# And this blasts in the text of 'legit' stored procedures. Do
	119	# this rather than calling sp_helptext in a loop.
	120
	121	$h = $dbh->selectall_arrayref(q{
	122	SELECT o.name, colid,colid2,c.text
	123	FROM syscomments c
	124	JOIN sysobjects o
	125	ON c.id = o.id
	126	WHERE o.type ='P'
	127	ORDER BY o.name,
	128	c.colid,
	129	c.colid2
	130	}
	131	);
	132
	133	foreach (@{$h}) {
	134	$stuff->{procedures}->{$_->[0]}->{text} .= $_->[3]
	135	if (defined($stuff->{procedures}->{$_->[0]}));
	136	}
	137
86ee0658	138	### Defaults
	139	### Rules
	140	### Bind Defaults
	141	### Bind Rules
	142
	143	### Triggers
1eb8ea88	144	# Since the 'target' of the trigger is defined in the text, we will
	145	# just create them independently for now rather than associating them
	146	# with a table.
	147
	148	$h = $dbh->selectall_arrayref(q{
	149	SELECT o.name, colid,colid2,c.text
	150	FROM syscomments c
	151	JOIN sysobjects o
	152	ON c.id = o.id
	153	JOIN sysobjects o1
	154	ON (o.id = o1.instrig OR o.id = o1.deltrig or o.id = o1.updtrig)
	155	WHERE o.type ='TR'
	156	ORDER BY o.name,
	157	c.colid,
	158	c.colid2
	159	}
	160	);
	161	foreach (@{$h}) {
	162	$stuff->{triggers}->{$_->[0]}->{text} .= $_->[3];
	163	}
86ee0658	164
	165	### References
	166	### Keys
	167
	168	### Types
1eb8ea88	169	# Not sure what to do with these?
86ee0658	170	$stuff->{type_info_all} = $dbh->type_info_all;
	171
	172	### Tables
	173	# According to the DBI docs, these can be
	174
	175	# "TABLE"
	176	# "VIEW"
	177	# "SYSTEM TABLE"
	178	# "GLOBAL TEMPORARY",
	179	# "LOCAL TEMPORARY"
	180	# "ALIAS"
	181	# "SYNONYM"
	182
	183	foreach my $table_info (@tables) {
	184	next
	185	unless (defined($table_info->{TABLE_TYPE}));
	186
	187	if ($table_info->{TABLE_TYPE} =~ /TABLE/) {
	188	my $table = $schema->add_table(
	189	name =>
	190	$table_info->{TABLE_NAME},
	191	type =>
	192	$table_info->{TABLE_TYPE},
	193	) \|\| die $schema->error;
	194
	195	# find the associated columns
	196
	197	my $cols =
	198	$columns->{$table_info->{TABLE_QUALIFIER}}
	199	->{$table_info->{TABLE_OWNER}}
	200	->{$table_info->{TABLE_NAME}}
	201	->{columns};
	202
	203	foreach my $c (values %{$cols}) {
1eb8ea88	204	my $f = $table->add_field(
	205	name => $c->{COLUMN_NAME},
	206	data_type => $c->{TYPE_NAME},
	207	order => $c->{ORDINAL_POSITION},
	208	size => $c->{COLUMN_SIZE},
86ee0658	209	) \|\| die $table->error;
1eb8ea88	210
86ee0658	211	$f->is_nullable(1)
	212	if ($c->{NULLABLE} == 1);
	213	}
	214
	215	# add in primary key
	216	my $h = $dbh->selectall_hashref("sp_pkeys
	217	$table_info->{TABLE_NAME}", 'COLUMN_NAME');
	218	if (scalar keys %{$h} > 1) {
	219	my @c = map {
	220	$_->{COLUMN_NAME}
	221	} sort {
	222	$a->{KEY_SEQ} <=> $b->{KEY_SEQ}
	223	} values %{$h};
	224
	225	$table->primary_key(@c)
	226	if (scalar @c);
	227	}
	228
	229	# add in any indexes ... how do we tell if the index has
	230	# already been created as part of a primary key or other
	231	# constraint?
	232
1eb8ea88	233	if (defined($stuff->{indexes}->{$table_info->{TABLE_NAME}})){
86ee0658	234	my $h = $dbh->selectall_hashref("sp_helpindex
	235	$table_info->{TABLE_NAME}", 'INDEX_NAME');
	236	foreach (values %{$h}) {
	237	my $fields = $_->{'INDEX_KEYS'};
	238	$fields =~ s/\s*//g;
	239	my $i = $table->add_index(
	240	name =>
	241	$_->{INDEX_NAME},
	242	fields => $fields,
	243	);
	244	if ($_->{'INDEX_DESCRIPTION'} =~ /unique/i) {
	245	$i->type('unique');
	246
	247	# we could make this a primary key if there
	248	# isn't already one defined and if there
	249	# aren't any nullable columns in thisindex.
	250
	251	if (!defined($table->primary_key())) {
	252	$table->primary_key($fields)
	253	unless grep {
	254	$table->get_field($_)->is_nullable()
	255	} split(/,\s*/, $fields);
	256	}
	257	}
	258	}
	259	}
	260	} elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
	261	my $view = $schema->add_view(
	262	name =>
	263	$table_info->{TABLE_NAME},
	264	);
	265
1eb8ea88	266
86ee0658	267	my $cols =
	268	$columns->{$table_info->{TABLE_QUALIFIER}}
	269	->{$table_info->{TABLE_OWNER}}
	270	->{$table_info->{TABLE_NAME}}
	271	->{columns};
	272
	273	$view->fields(map {
	274	$_->{COLUMN_NAME}
	275	} sort {
	276	$a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION}
	277	} values %{$cols}
	278	);
	279
1eb8ea88	280	$view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})
1eb8ea88	281	if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}));
86ee0658	282	}
86ee0658	283	}
1eb8ea88	284
	285	foreach my $p (values %{$stuff->{procedures}}) {
	286	my $proc = $schema->add_procedure(
	287	name => $p->{name},
	288	owner => $p->{PROCEDURE_OWNER},
	289	comments => $p->{REMARKS},
	290	sql => $p->{text},
	291	);
	292
	293	}
86ee0658	294	### Permissions
	295	### Groups
	296	### Users
	297	### Aliases
	298	### Logins
1eb8ea88	299	return 1;
86ee0658	300	}
	301
	302	1;
	303
	304	=pod
	305
	306	=head1 AUTHOR
	307
	308	Paul Harrington E<lt>harringp@deshaw.comE<gt>,
	309
	310	=head1 SEE ALSO
	311
	312	DBI, DBD::Sybase, SQL::Translator::Schema.
	313
	314	=cut
	315