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

package SQL::Translator::Parser::DBI::SQLServer;

=head1 NAME

SQL::Translator::Parser::DBI::SQLServer - parser for SQL Server through DBD::ODBC

=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 = '1.59';
$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(undef, undef, undef, undef);


    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,c.text
  FROM syscomments c
  JOIN sysobjects o
    ON c.id = o.id
 WHERE o.type ='V'
ORDER BY o.name,
         c.colid
}
);

    # 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} .= $_->[2];
    }

    #### objects with indexes.
    map {
        $stuff->{indexes}->{$_->[0]}++
            if defined;
    } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id)
                                    FROM sysindexes
                                   WHERE indid > 0 and indid < 255 and
                                         name not like '_WA_Sys%'")};

    ## 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,c.text
  FROM syscomments c
  JOIN sysobjects o
    ON c.id = o.id
 WHERE o.type in ('P', 'FN', 'TF', 'IF')
}
);

    foreach (@{$h}) {
        $stuff->{procedures}->{$_->[0]}->{text} .= $_->[2]
            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,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
}
);
    foreach (@{$h}) {
        $stuff->{triggers}->{$_->[0]}->{text} .= $_->[2];
    }

    ### 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} eq "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_CAT}}
                    ->{$table_info->{TABLE_SCHEM}}
                        ->{$table_info->{TABLE_NAME}}
                            ->{columns};

            foreach my $c (values %{$cols}) {
            my $is_auto_increment = $c->{TYPE_NAME} =~ s#(\(\))? identity##i;
                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($c->{NULLABLE} == 1);
                $f->is_auto_increment($is_auto_increment);
                if ( defined $c->{COLUMN_DEF}) {
                  $c->{COLUMN_DEF} =~ s#\('?(.*?)'?\)#$1#;
                  $f->default_value($c->{COLUMN_DEF});
                }
            }

            # 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 foreign keys
            $h = $dbh->selectall_hashref("sp_fkeys NULL,
\@fktable_name = '$table_info->{TABLE_NAME}'", 'FK_NAME');
         foreach my $fk ( values %{$h} ) {
            my $constraint = $table->add_constraint( name => $fk->{FK_NAME},
               fields => [$fk->{FKCOLUMN_NAME}],
            );
            $constraint->type("FOREIGN_KEY");
            $constraint->on_delete(
               $fk->{DELETE_RULE} == 0 ? "CASCADE" :
               $fk->{DELETE_RULE} == 1 ? "NO ACTION" : "SET_NULL"
            );
            $constraint->on_update(
               $fk->{UPDATE_RULE} == 0 ? "CASCADE" :
               $fk->{UPDATE_RULE} == 1 ? "NO ACTION" : "SET_NULL"
            );
            $constraint->reference_table($fk->{PKTABLE_NAME});
         }

            # 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') {
         next if $table_info->{TABLE_NAME} eq 'sysconstraints'
            || $table_info->{TABLE_NAME} eq 'syssegments';
         next if !$stuff->{view}->{$table_info->{TABLE_NAME}}->{text};
            my $view =  $schema->add_view(
                                          name =>
$table_info->{TABLE_NAME},
                                          );


            my $cols =
                $columns->{$table_info->{TABLE_CAT}}
                    ->{$table_info->{TABLE_SCHEM}}
                        ->{$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}}) {
      next if !$p->{text};
        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

Chris Hilton E<lt>chris@dctank.comE<gt> - Bulk of code from
DBI-Sybase parser, I just tweaked it for SQLServer. Thanks.

=head1 SEE ALSO

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

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