package SQL::Translator::Producer::Sybase;
-# -------------------------------------------------------------------
-# $Id: Sybase.pm,v 1.6 2003-08-18 15:43:15 kycl4rk Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
-# darren chamberlain <darren@cpan.org>,
-# Chris Mungall <cjm@fruitfly.org>,
-# Sam Angiuoli <angiuoli@users.sourceforge.net>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-# 02111-1307 USA
-# -------------------------------------------------------------------
-
=head1 NAME
SQL::Translator::Producer::Sybase - Sybase producer for SQL::Translator
+=head1 SYNOPSIS
+
+ use SQL::Translator;
+
+ my $t = SQL::Translator->new( parser => '...', producer => 'Sybase' );
+ $t->translate;
+
+=head1 DESCRIPTION
+
+This module will produce text output of the schema suitable for Sybase.
+
=cut
use strict;
-use vars qw[ $DEBUG $WARN $VERSION ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
+use warnings;
+our ( $DEBUG, $WARN );
+our $VERSION = '1.61';
$DEBUG = 1 unless defined $DEBUG;
use Data::Dumper;
bit => 'bit',
tinyint => 'smallint',
float => 'double precision',
- serial => 'numeric',
+ serial => 'numeric',
boolean => 'varchar',
char => 'char',
long => 'varchar',
);
my %reserved = map { $_, 1 } qw[
- ALL ANALYSE ANALYZE AND ANY AS ASC
+ ALL ANALYSE ANALYZE AND ANY AS ASC
BETWEEN BINARY BOTH
CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
- CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
+ CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
DEFAULT DEFERRABLE DESC DISTINCT DO
ELSE END EXCEPT
- FALSE FOR FOREIGN FREEZE FROM FULL
- GROUP HAVING
- ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
- JOIN LEADING LEFT LIKE LIMIT
+ FALSE FOR FOREIGN FREEZE FROM FULL
+ GROUP HAVING
+ ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
+ JOIN LEADING LEFT LIKE LIMIT
NATURAL NEW NOT NOTNULL NULL
OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
- PRIMARY PUBLIC REFERENCES RIGHT
- SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
+ PRIMARY PUBLIC REFERENCES RIGHT
+ SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
UNION UNIQUE USER USING VERBOSE WHEN WHERE
];
=cut
-# -------------------------------------------------------------------
sub produce {
my $translator = shift;
$DEBUG = $translator->debug;
my $add_drop_table = $translator->add_drop_table;
my $schema = $translator->schema;
- my $output;
- $output .= header_comment unless ($no_comments);
+ my @output;
+ push @output, header_comment unless ($no_comments);
+
+ my @foreign_keys;
for my $table ( $schema->get_tables ) {
my $table_name = $table->name or next;
my %field_name_scope;
for my $field ( $table->get_fields ) {
my $field_name = mk_name(
- $field->name, '', \%field_name_scope, undef,1
+ $field->name, '', \%field_name_scope, undef,1
);
my $field_name_ur = unreserve( $field_name, $table_name );
my $field_def = qq["$field_name_ur"];
my $commalist = join( ', ', map { qq['$_'] } @$list );
my $seq_name;
+ my $identity = '';
+
if ( $data_type eq 'enum' ) {
- my $check_name = mk_name(
+ my $check_name = mk_name(
$table_name.'_'.$field_name, 'chk' ,undef, 1
);
- push @constraint_defs,
+ push @constraint_defs,
"CONSTRAINT $check_name CHECK ($field_name IN ($commalist))";
$data_type .= 'character varying';
}
elsif ( $data_type eq 'set' ) {
$data_type .= 'character varying';
}
- elsif ( $field->is_auto_increment ) {
- $field_def .= ' IDENTITY';
- }
else {
+ if ( $field->is_auto_increment ) {
+ $identity = 'IDENTITY';
+ }
if ( defined $translate{ $data_type } ) {
$data_type = $translate{ $data_type };
}
$size = '255';
}
elsif (
- $data_type eq 'varchar' &&
+ $data_type eq 'varchar' &&
$orig_data_type eq 'boolean'
) {
$size = '6';
$field_def .= " $data_type";
$field_def .= "($size)" if $size;
+ $field_def .= " $identity" if $identity;
#
# Default value
if ( $type eq PRIMARY_KEY ) {
$name ||= mk_name( $table_name, 'pk', undef,1 );
- push @constraint_defs,
+ push @constraint_defs,
"CONSTRAINT $name PRIMARY KEY ".
'(' . join( ', ', @fields ) . ')';
}
elsif ( $type eq FOREIGN_KEY ) {
$name ||= mk_name( $table_name, 'fk', undef,1 );
- push @constraint_defs,
- "CONSTRAINT $name FOREIGN KEY".
+ push @foreign_keys,
+ "ALTER TABLE $table ADD CONSTRAINT $name FOREIGN KEY".
' (' . join( ', ', @fields ) . ') REFERENCES '.
$constraint->reference_table.
' (' . join( ', ', @rfields ) . ')';
}
elsif ( $type eq UNIQUE ) {
- $name ||= mk_name(
- $table_name,
+ $name ||= mk_name(
+ $table_name,
$name || ++$c_name_default,undef, 1
);
- push @constraint_defs,
+ push @constraint_defs,
"CONSTRAINT $name UNIQUE " .
'(' . join( ', ', @fields ) . ')';
}
# Indices
#
for my $index ( $table->get_indices ) {
- push @index_defs,
+ push @index_defs,
'CREATE INDEX ' . $index->name .
" ON $table_name (".
- join( ', ', $index->fields ) . ");";
+ join( ', ', $index->fields ) . ")";
}
- my $create_statement;
- $create_statement = qq[DROP TABLE $table_name_ur;\n]
- if $add_drop_table;
- $create_statement .= qq[CREATE TABLE $table_name_ur (\n].
- join( ",\n",
- map { " $_" } @field_defs, @constraint_defs
+ my $drop_statement = $add_drop_table
+ ? qq[DROP TABLE $table_name_ur] : '';
+ my $create_statement = qq[CREATE TABLE $table_name_ur (\n].
+ join( ",\n",
+ map { " $_" } @field_defs, @constraint_defs
).
- "\n);"
+ "\n)"
;
- $output .= join( "\n\n",
- @comments,
- $create_statement,
- @index_defs,
- ''
- );
+ $create_statement = join("\n\n", @comments) . "\n\n" . $create_statement;
+ push @output,
+ $create_statement,
+ @index_defs,
+ ;
}
+ foreach my $view ( $schema->get_views ) {
+ my (@comments, $view_name);
+
+ $view_name = $view->name();
+ push @comments, "--\n-- View: $view_name\n--" unless $no_comments;
+
+ # text of view is already a 'create view' statement so no need
+ # to do anything fancy.
+
+ push @output, join("\n\n",
+ @comments,
+ $view->sql(),
+ );
+ }
+
+
+ foreach my $procedure ( $schema->get_procedures ) {
+ my (@comments, $procedure_name);
+
+ $procedure_name = $procedure->name();
+ push @comments,
+ "--\n-- Procedure: $procedure_name\n--" unless $no_comments;
+
+ # text of procedure already has the 'create procedure' stuff
+ # so there is no need to do anything fancy. However, we should
+ # think about doing fancy stuff with granting permissions and
+ # so on.
+
+ push @output, join("\n\n",
+ @comments,
+ $procedure->sql(),
+ );
+ }
+ push @output, @foreign_keys;
+
if ( $WARN ) {
if ( %truncated ) {
warn "Truncated " . keys( %truncated ) . " names:\n";
}
}
- return $output;
+ return wantarray ? @output : join ";\n\n", @output;
}
-# -------------------------------------------------------------------
sub mk_name {
- my $basename = shift || '';
- my $type = shift || '';
- my $scope = shift || '';
+ my $basename = shift || '';
+ my $type = shift || '';
+ my $scope = shift || '';
my $critical = shift || '';
my $basename_orig = $basename;
- my $max_name = $type
- ? $max_id_length - (length($type) + 1)
+ my $max_name = $type
+ ? $max_id_length - (length($type) + 1)
: $max_id_length;
- $basename = substr( $basename, 0, $max_name )
+ $basename = substr( $basename, 0, $max_name )
if length( $basename ) > $max_name;
my $name = $type ? "${type}_$basename" : $basename;
if ( my $prev = $scope->{ $name } ) {
my $name_orig = $name;
$name .= sprintf( "%02d", ++$prev );
- substr($name, $max_id_length - 3) = "00"
+ substr($name, $max_id_length - 3) = "00"
if length( $name ) > $max_id_length;
warn "The name '$name_orig' has been changed to ",
$scope->{ $name_orig }++;
}
- $name = substr( $name, 0, $max_id_length )
+ $name = substr( $name, 0, $max_id_length )
if ((length( $name ) > $max_id_length) && $critical);
$scope->{ $name }++;
return $name;
}
-# -------------------------------------------------------------------
sub unreserve {
my $name = shift || '';
my $schema_obj_name = shift || '';
my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
# also trap fields that don't begin with a letter
- return $name if !$reserved{ uc $name } && $name =~ /^[a-z]/i;
+ return $name if !$reserved{ uc $name } && $name =~ /^[a-z]/i;
if ( $schema_obj_name ) {
++$unreserve{"$schema_obj_name.$name"};
1;
-# -------------------------------------------------------------------
-
=pod
+=head1 SEE ALSO
+
+SQL::Translator.
+
=head1 AUTHORS
Sam Angiuoli E<lt>angiuoli@users.sourceforge.netE<gt>,
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
+Paul Harrington E<lt>harringp@deshaw.comE<gt>,
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=cut
projects / dbsrgits/SQL-Translator.git / blobdiff