X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FSybase.pm;h=fec655a648459bff522ea4d2f1de3a17c3bb8146;hb=4384692aca82fb49ad4a49c08d7ddbde85bc4ecb;hp=7527e0dfa9763daeaa4c34c2bc0446aa2a3f81a1;hpb=782b5a43519d2713171767f74a544fe9892542ea;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/Sybase.pm b/lib/SQL/Translator/Producer/Sybase.pm index 7527e0d..fec655a 100644 --- a/lib/SQL/Translator/Producer/Sybase.pm +++ b/lib/SQL/Translator/Producer/Sybase.pm @@ -1,25 +1,5 @@ package SQL::Translator::Producer::Sybase; -# ------------------------------------------------------------------- -# $Id$ -# ------------------------------------------------------------------- -# Copyright (C) 2002-2009 SQLFairy Authors -# -# 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 @@ -38,8 +18,9 @@ This module will produce text output of the schema suitable for Sybase. =cut use strict; -use vars qw[ $DEBUG $WARN $VERSION ]; -$VERSION = '1.99'; +use warnings; +our ( $DEBUG, $WARN ); +our $VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use Data::Dumper; @@ -63,27 +44,27 @@ my %translate = ( 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 ]; @@ -134,7 +115,6 @@ and table_constraint is: =cut -# ------------------------------------------------------------------- sub produce { my $translator = shift; $DEBUG = $translator->debug; @@ -163,7 +143,7 @@ sub produce { 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"]; @@ -184,10 +164,10 @@ sub produce { my $seq_name; 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'; } @@ -217,7 +197,7 @@ sub produce { $size = '255'; } elsif ( - $data_type eq 'varchar' && + $data_type eq 'varchar' && $orig_data_type eq 'boolean' ) { $size = '6'; @@ -271,24 +251,24 @@ sub produce { 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, + push @constraint_defs, "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 ) . ')'; } @@ -298,26 +278,26 @@ sub produce { # Indices # for my $index ( $table->get_indices ) { - push @index_defs, + push @index_defs, 'CREATE INDEX ' . $index->name . " ON $table_name (". join( ', ', $index->fields ) . ");"; } my $create_statement; - $create_statement = qq[DROP TABLE $table_name_ur;\n] + $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 + join( ",\n", + map { " $_" } @field_defs, @constraint_defs ). "\n);" ; - $output .= join( "\n\n", + $output .= join( "\n\n", @comments, - $create_statement, - @index_defs, + $create_statement, + @index_defs, '' ); } @@ -342,7 +322,7 @@ sub produce { my (@comments, $procedure_name); $procedure_name = $procedure->name(); - push @comments, + push @comments, "--\n-- Procedure: $procedure_name\n--" unless $no_comments; # text of procedure already has the 'create procedure' stuff @@ -372,17 +352,16 @@ sub produce { return $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; @@ -397,7 +376,7 @@ sub mk_name { 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 ", @@ -405,20 +384,19 @@ sub mk_name { $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"}; @@ -433,8 +411,6 @@ sub unreserve { 1; -# ------------------------------------------------------------------- - =pod =head1 SEE ALSO @@ -445,6 +421,6 @@ SQL::Translator. Sam Angiuoli Eangiuoli@users.sourceforge.netE, Paul Harrington Eharringp@deshaw.comE, -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =cut