From: Ken Youens-Clark Date: Tue, 26 Nov 2002 03:59:58 +0000 (+0000) Subject: Added "show_warnings" and "add_drop_table" options to sql_translator.pl and X-Git-Tag: v0.01~37 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=96844cae0d72044a12e178060d1f5f724eb4b428;p=dbsrgits%2FSQL-Translator.git Added "show_warnings" and "add_drop_table" options to sql_translator.pl and to SQL::Translator/Oracle producer. Fixed bug in Oracle producer that duplicated identifiers. Adding a lot of Oracle producer's logic to new PostgreSQL producer. --- diff --git a/bin/sql_translator.pl b/bin/sql_translator.pl index 2465737..b0dd681 100755 --- a/bin/sql_translator.pl +++ b/bin/sql_translator.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl -w # ------------------------------------------------------------------- -# $Id: sql_translator.pl,v 1.5 2002-11-22 03:03:40 kycl4rk Exp $ +# $Id: sql_translator.pl,v 1.6 2002-11-26 03:59:57 kycl4rk Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002 Ken Y. Clark , # darren chamberlain @@ -29,17 +29,19 @@ use SQL::Translator; use Data::Dumper; use vars qw( $VERSION ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/; - -my $from; # the original database -my $to; # the destination database -my $help; # show POD and bail -my $stdin; # whether to read STDIN for create script -my $no_comments; # whether to put comments in out file -my $xlate; # user overrides for field translation -my $debug; # whether to print debug info -my $trace; # whether to print parser trace -my $list; # list all parsers and producers +$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; + +my $from; # the original database +my $to; # the destination database +my $help; # show POD and bail +my $stdin; # whether to read STDIN for create script +my $no_comments; # whether to put comments in out file +my $show_warnings; # whether to show warnings from SQL::Translator +my $add_drop_table; # whether to show warnings from SQL::Translator +my $xlate; # user overrides for field translation +my $debug; # whether to print debug info +my $trace; # whether to print parser trace +my $list; # list all parsers and producers # # Get options, explain how to use the script if necessary. @@ -52,6 +54,8 @@ GetOptions( 'd|debug' => \$debug, 'trace' => \$trace, 'no-comments' => \$no_comments, + 'show-warnings' => \$show_warnings, + 'add-drop-table' => \$add_drop_table, 'xlate=s' => \$xlate, ) or pod2usage(2); @@ -71,11 +75,13 @@ if ( $xlate ) { # # If everything is OK, translate file(s). # -my $translator = SQL::Translator->new( - xlate => $xlate || {}, - debug => $debug, - trace => $trace, - no_comments => $no_comments, +my $translator = SQL::Translator->new( + xlate => $xlate || {}, + debug => $debug || 0, + trace => $trace || 0, + no_comments => $no_comments || 0, + show_warnings => $show_warnings || 0, + add_drop_table => $add_drop_table || 0, ); if ( $list ) { @@ -137,6 +143,8 @@ To translate a schema: -d|--debug Print debug info --trace Print parser trace info --no-comments Don't include comments in SQL output + --show-warnings Print to STDERR warnings of conflicts, etc. + --add-drop-table Add 'drop table' statements before creates --xlate=foo/bar,baz/blech Overrides for field translation =head1 DESCRIPTION @@ -146,6 +154,12 @@ This script is part of the SQL Fairy project database syntax for which it has a grammar into some other format it knows about. +If using "show-warnings," be sure to redirect STDERR to a separate file. +In bash, you could do this: + + $ sql_translator.pl -f MySQL -t PostgreSQL --show-warnings file.sql \ + 1>out 2>err + =head1 AUTHOR Ken Y. Clark Ekclark@cpan.orgE diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 7454f82..872f53b 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,7 +1,7 @@ package SQL::Translator; # ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.13 2002-11-25 14:48:34 dlc Exp $ +# $Id: Translator.pm,v 1.14 2002-11-26 03:59:57 kycl4rk Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002 Ken Y. Clark , # darren chamberlain @@ -29,11 +29,13 @@ SQL::Translator - convert schema from one database to another use SQL::Translator; - my $translator = SQL::Translator->new( - xlate => $xlate || {}, # Overrides for field translation - debug => $debug, # Print debug info - trace => $trace, # Print Parse::RecDescent trace - no_comments => $no_comments, # Don't include comments in output + my $translator = SQL::Translator->new( + xlate => $xlate || {}, # Overrides for field translation + debug => $debug, # Print debug info + trace => $trace, # Print Parse::RecDescent trace + no_comments => $no_comments, # Don't include comments in output + show_warnings => $show_warnings, # Print name mutations, conflicts + add_drop_table => $add_drop_table, # Add "drop table" statements ); my $output = $translator->translate( @@ -60,7 +62,7 @@ use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR ); use base 'Class::Base'; $VERSION = '0.01'; -$REVISION = sprintf "%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/; +$REVISION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; $ERROR = ""; @@ -158,18 +160,40 @@ sub init { # $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG; - $self->trace( $config->{'trace'} ); + + $self->add_drop_table( $config->{'add_drop_table'} ); $self->custom_translate( $config->{'xlate'} ); $self->no_comments( $config->{'no_comments'} ); + $self->show_warnings( $config->{'show_warnings'} ); + + $self->trace( $config->{'trace'} ); + return $self; } =head1 METHODS # ---------------------------------------------------------------------- +=head2 B + +Toggles whether or not to add "DROP TABLE" statements just before the +create definitions. + +=cut + +sub add_drop_table { + my $self = shift; + if ( defined (my $arg = shift) ) { + $self->{'add_drop_table'} = $arg ? 1 : 0; + } + return $self->{'add_drop_table'} || 0; +} + + +# ---------------------------------------------------------------------- =head2 B Allows the user to override default translation of fields. For example, @@ -484,6 +508,26 @@ sub parser_args { } # ---------------------------------------------------------------------- +=head2 B + +Toggles whether to print warnings of name conflicts, identifier +mutations, etc. Probably only generated by producers to let the user +know when something won't translate very smoothly (e.g., MySQL "enum" +fields into Oracle). Accepts a true or false value, returns the +current value. + +=cut + +sub show_warnings { + my $self = shift; + my $arg = shift; + if ( defined $arg ) { + $self->{'show_warnings'} = $arg ? 1 : 0; + } + return $self->{'show_warnings'} || 0; +} + +# ---------------------------------------------------------------------- =head2 B The B method calls the subroutines referenced by the diff --git a/lib/SQL/Translator/Producer/Oracle.pm b/lib/SQL/Translator/Producer/Oracle.pm index 4f19da1..e01d4ca 100644 --- a/lib/SQL/Translator/Producer/Oracle.pm +++ b/lib/SQL/Translator/Producer/Oracle.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::Oracle; # ------------------------------------------------------------------- -# $Id: Oracle.pm,v 1.5 2002-11-23 01:26:56 kycl4rk Exp $ +# $Id: Oracle.pm,v 1.6 2002-11-26 03:59:58 kycl4rk Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002 Ken Y. Clark , # darren chamberlain @@ -22,13 +22,10 @@ package SQL::Translator::Producer::Oracle; # ------------------------------------------------------------------- use strict; -use vars qw[ $VERSION $DEBUG ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/; +use vars qw[ $VERSION $DEBUG $WARN ]; +$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; -my $max_id_length = 30; -my %used_identifiers = (); - my %translate = ( # # MySQL types @@ -96,7 +93,7 @@ my %translate = ( # http://technet.oracle.com/docs/products/oracle8i/doc_library/\ # 817_doc/server.817/a85397/ap_keywd.htm # -my @ora_reserved = qw( +my %ora_reserved = map { $_, 1 } qw( ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT BETWEEN BY CHAR CHECK CLUSTER COLUMN COMMENT COMPRESS CONNECT CREATE CURRENT @@ -121,15 +118,19 @@ my @ora_reserved = qw( WHENEVER WHERE WITH ); -my %ora_reserved = map { $_ => 1 } @ora_reserved; +my $max_id_length = 30; +my %used_identifiers = (); my %global_names; my %unreserve; my %truncated; +# ------------------------------------------------------------------- sub produce { my ( $translator, $data ) = @_; $DEBUG = $translator->debug; + $WARN = $translator->show_warnings; my $no_comments = $translator->no_comments; + my $add_drop_table = $translator->add_drop_table; my $output; unless ( $no_comments ) { @@ -254,7 +255,7 @@ sub produce { if ( uc $field->{'data_type'} eq 'TIMESTAMP' ) { my $base_name = $table_name . "_". $field_name_ur; - my $trig_name = mk_name($base_name,'ts'); + my $trig_name = mk_name( $base_name, 'ts' ); push @trigger_decs, "CREATE OR REPLACE TRIGGER $trig_name\n". "BEFORE INSERT OR UPDATE ON $table_name_ur\n". @@ -300,11 +301,14 @@ sub produce { join( ', ', @fields ). ");"; } else { - warn "Unknown index type ($index_type) on table $table_name.\n"; + warn "Unknown index type ($index_type) on table $table_name.\n" + if $WARN; } } - my $create_statement = "CREATE TABLE $table_name_ur (\n". + my $create_statement; + $create_statement = "DROP TABLE $table_name_ur;\n" if $add_drop_table; + $create_statement .= "CREATE TABLE $table_name_ur (\n". join( ",\n", map { " $_" } @field_decs ). "\n);" ; @@ -318,6 +322,19 @@ sub produce { ); } + if ( $WARN ) { + if ( %truncated ) { + warn "Truncated " . keys( %truncated ) . " names:\n"; + warn "\t" . join( "\n\t", sort keys %truncated ) . "\n"; + } + + if ( %unreserve ) { + warn "Encounted " . keys( %unreserve ) . + " unsafe names in schema (reserved or invalid):\n"; + warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n"; + } + } + return $output; } @@ -326,36 +343,41 @@ sub mk_name { my ($basename, $type, $scope, $critical) = @_; my $basename_orig = $basename; my $max_name = $max_id_length - (length($type) + 1); - $basename = substr($basename, 0, $max_name) - if length($basename) > $max_name; + $basename = substr( $basename, 0, $max_name ) + if length( $basename ) > $max_name; my $name = $type ? "${type}_$basename" : $basename; if ( $basename ne $basename_orig and $critical ) { my $show_type = $type ? "+'$type'" : ""; warn "Truncating '$basename_orig'$show_type to $max_id_length ", - "character limit to make '$name'\n" if $DEBUG; - $truncated{$basename_orig} = $name; + "character limit to make '$name'\n" if $WARN; + $truncated{ $basename_orig } = $name; } $scope ||= \%global_names; - return $name unless $scope->{$name}++; - my $name_orig = $name; - $name .= "02"; - substr($name, $max_id_length - 3) = "00" if length($name) > $max_id_length; - ++$name while $scope->{$name}; - warn "The name '$name_orig' has been changed to ", - "'$name' to make it unique\n" if $DEBUG; + if ( my $prev = $scope->{ $name } ) { + my $name_orig = $name; + $name .= sprintf( "%02d", ++$prev ); + substr($name, $max_id_length - 3) = "00" + if length( $name ) > $max_id_length; + + warn "The name '$name_orig' has been changed to ", + "'$name' to make it unique.\n" if $WARN; + + $scope->{ $name_orig }++; + } + + $scope->{ $name }++; return $name; } # ------------------------------------------------------------------- sub unreserve { - my ($name, $schema_obj_name) = @_; - my ($suffix) = ($name =~ s/(\W.*)$//) ? $1 : ''; + my ( $name, $schema_obj_name ) = @_; + my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : ''; # also trap fields that don't begin with a letter - return $_[0] if !$ora_reserved{uc $name} - && $name =~ /^[a-z]/i; + return $_[0] if !$ora_reserved{ uc $name } && $name =~ /^[a-z]/i; if ( $schema_obj_name ) { ++$unreserve{"$schema_obj_name.$name"}; @@ -398,19 +420,6 @@ SQL::Translator::Producer::Oracle takes a parsed data structure, created by a SQL::Translator::Parser subclass, and turns it into a create string suitable for use with an Oracle database. -=head1 BUGS - -Problem with SQL::Translator::Producer::Oracle: it is keeping track -of the last sequence number used, so as not to duplicate them, which -is reasonable. However on runs past the first, it seems to be -creating multiple constraint lines, that look like: - - CONSTRAINT i_sessions_pk_2 PRIMARY KEY (id), - CONSTRAINT i_sessions_pk_3 PRIMARY KEY (id) - -This is a very preliminary finding, and needs to be investigated more -thoroughly, of course. - =head1 CREDITS A hearty "thank-you" to Tim Bunce for much of the logic stolen from @@ -425,65 +434,3 @@ Ken Y. Clark Ekclark@cpan.orgE perl(1). =cut - -__END__ -!!!!!Code Graveyard!!!!! -# -# Used to make index names -# -sub make_identifier { - my ( $identifier, @mutations ) = @_; - my $length_of_mutations; - for my $mutation ( @mutations ) { - $length_of_mutations += length( $mutation ); - } - - if ( - length( $identifier ) + $length_of_mutations > - $max_id_length - ) { - $identifier = substr( - $identifier, - 0, - $max_id_length - $length_of_mutations - ); - } - - for my $mutation ( @mutations ) { - if ( $mutation =~ m/.+_$/ ) { - $identifier = $mutation.$identifier; - } - elsif ( $mutation =~ m/^_.+/ ) { - $identifier = $identifier.$mutation; - } - } - - if ( $used_identifiers{ $identifier } ) { - my $index = 1; - if ( $identifier =~ m/_(\d+)$/ ) { - $index = $1; - $identifier = substr( - $identifier, - 0, - length( $identifier ) - ( length( $index ) + 1 ) - ); - } - $index++; - return make_identifier( $identifier, '_'.$index ); - } - - $used_identifiers{ $identifier } = 1; - - return $identifier; -} - -# -# Checks to see if an identifier is not too long -# -sub check_identifier { - my $identifier = shift; - die "Identifier '$identifier' is too long, unrecoverable error.\n" - if length( $identifier ) > $max_id_length; - return $identifier; -} - diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index 4d147a5..5fc1ffa 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/lib/SQL/Translator/Producer/PostgreSQL.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::PostgreSQL; # ------------------------------------------------------------------- -# $Id: PostgreSQL.pm,v 1.2 2002-11-22 03:03:40 kycl4rk Exp $ +# $Id: PostgreSQL.pm,v 1.3 2002-11-26 03:59:58 kycl4rk Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002 Ken Y. Clark , # darren chamberlain @@ -21,9 +21,15 @@ package SQL::Translator::Producer::PostgreSQL; # 02111-1307 USA # ------------------------------------------------------------------- +=head1 NAME + +SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator + +=cut + use strict; -use vars qw($VERSION $DEBUG); -$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; +use vars qw[ $DEBUG $WARN $VERSION ]; +$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; $DEBUG = 1 unless defined $DEBUG; use Data::Dumper; @@ -61,51 +67,141 @@ my %translate = ( # # Oracle types # + number => 'integer', + char => 'char', + varchar2 => 'varchar', + long => 'text', + CLOB => 'bytea', + date => 'date', + + # + # Sybase types + # + int => 'integer', + money => 'money', + varchar => 'varchar', + datetime => 'timestamp', + text => 'text', + real => 'double precision', + comment => 'text', + bit => 'bit', + tinyint => 'smallint', + float => 'double precision', ); +my %reserved = map { $_, 1 } qw[ + 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 + 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 + 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 + UNION UNIQUE USER USING VERBOSE WHEN WHERE +]; -sub import { - warn "loading " . __PACKAGE__ . "...\n"; -} +my $max_id_length = 30; +my %used_identifiers = (); +my %global_names; +my %unreserve; +my %truncated; + +=pod + +=head1 PostgreSQL Create Table Syntax + + CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name ( + { column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ] + | table_constraint } [, ... ] + ) + [ INHERITS ( parent_table [, ... ] ) ] + [ WITH OIDS | WITHOUT OIDS ] + +where column_constraint is: + + [ CONSTRAINT constraint_name ] + { NOT NULL | NULL | UNIQUE | PRIMARY KEY | + CHECK (expression) | + REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ] + [ ON DELETE action ] [ ON UPDATE action ] } + [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ] + +and table_constraint is: + + [ CONSTRAINT constraint_name ] + { UNIQUE ( column_name [, ... ] ) | + PRIMARY KEY ( column_name [, ... ] ) | + CHECK ( expression ) | + FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ] + [ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] } + [ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ] + +=cut +# ------------------------------------------------------------------- sub produce { my ( $translator, $data ) = @_; - debug("Beginning production\n"); - my $create = sprintf "--\n-- Created by %s\n-- Created on %s\n-- \n\n", - __PACKAGE__, scalar localtime; - - for my $table ( keys %{ $data } ) { - debug( "Looking at table '$table'\n" ); - my $table_data = $data->{$table}; - my @fields = sort { - $table_data->{'fields'}->{$a}->{'order'} - <=> - $table_data->{'fields'}->{$b}->{'order'} - } keys %{ $table_data->{'fields'} }; - - $create .= "--\n-- Table: $table\n--\n"; - $create .= "CREATE TABLE $table (\n"; + $DEBUG = $translator->debug; + $WARN = $translator->show_warnings; + my $no_comments = $translator->no_comments; + my $add_drop_table = $translator->add_drop_table; + + my $create; + unless ( $no_comments ) { + $create .= sprintf + "--\n-- Created by %s\n-- Created on %s\n--\n\n", + __PACKAGE__, scalar localtime; + } + + for my $table ( + map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { [ $_->{'order'}, $_ ] } + values %$data + ) { + my $table_name = $table->{'table_name'}; + my @fields = + map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { [ $_->{'order'}, $_ ] } + values %{ $table->{'fields'} }; + + $create .= "--\n-- Table: $table_name\n--\n" unless $no_comments; + $create = "DROP TABLE $table_name;\n" if $add_drop_table; + $create .= "CREATE TABLE $table_name (\n"; # # Fields # + my %field_name_scope; my @field_statements; for my $field ( @fields ) { - debug("Looking at field '$field'\n"); - my $field_data = $table_data->{'fields'}->{ $field }; - my @fdata = ("", $field); + my @fdata = ("", $field); + + my $field_name = mk_name( + $field->{'name'}, '', \%field_name_scope, 1 + ); + my $field_name_ur = unreserve( $field_name, $table_name ); + my $field_str = $field_name_ur; # data type and size push @fdata, sprintf "%s%s", - $field_data->{'data_type'}, - ( defined $field_data->{'size'} ) - ? "($field_data->{'size'})" : ''; + $field->{'data_type'}, + ( defined $field->{'size'} ) + ? "($field->{'size'})" : ''; # Null? - push @fdata, "NOT NULL" unless $field_data->{'null'}; + push @fdata, "NOT NULL" unless $field->{'null'}; # Default? XXX Need better quoting! - my $default = $field_data->{'default'}; + my $default = $field->{'default'}; if ( defined $default ) { push @fdata, "DEFAULT '$default'"; # if (int $default eq "$default") { @@ -116,10 +212,10 @@ sub produce { } # auto_increment? - push @fdata, "auto_increment" if $field_data->{'is_auto_inc'}; + push @fdata, "auto_increment" if $field->{'is_auto_inc'}; # primary key? - push @fdata, "PRIMARY KEY" if $field_data->{'is_primary_key'}; + push @fdata, "PRIMARY KEY" if $field->{'is_primary_key'}; push @field_statements, join( " ", @fdata ); @@ -129,7 +225,7 @@ sub produce { # # Other keys # - my @indices = @{ $table_data->{'indices'} || [] }; + my @indices = @{ $table->{'indices'} || [] }; for ( my $i = 0; $i <= $#indices; $i++ ) { $create .= ",\n"; my $key = $indices[$i]; @@ -152,19 +248,67 @@ sub produce { return $create; } -use Carp; -sub debug { - if ( $DEBUG ) { - map { carp "[" . __PACKAGE__ . "] $_" } @_; +# ------------------------------------------------------------------- +sub mk_name { + my ($basename, $type, $scope, $critical) = @_; + my $basename_orig = $basename; + my $max_name = $max_id_length - (length($type) + 1); + $basename = substr( $basename, 0, $max_name ) + if length( $basename ) > $max_name; + my $name = $type ? "${type}_$basename" : $basename; + + if ( $basename ne $basename_orig and $critical ) { + my $show_type = $type ? "+'$type'" : ""; + warn "Truncating '$basename_orig'$show_type to $max_id_length ", + "character limit to make '$name'\n" if $WARN; + $truncated{ $basename_orig } = $name; + } + + $scope ||= \%global_names; + if ( my $prev = $scope->{ $name } ) { + my $name_orig = $name; + $name .= sprintf( "%02d", ++$prev ); + substr($name, $max_id_length - 3) = "00" + if length( $name ) > $max_id_length; + + warn "The name '$name_orig' has been changed to ", + "'$name' to make it unique.\n" if $WARN; + + $scope->{ $name_orig }++; } + + $scope->{ $name }++; + return $name; +} + +# ------------------------------------------------------------------- +sub unreserve { + my ( $name, $schema_obj_name ) = @_; + my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : ''; + + # also trap fields that don't begin with a letter + return $_[0] if !$reserved{ uc $name } && $name =~ /^[a-z]/i; + + if ( $schema_obj_name ) { + ++$unreserve{"$schema_obj_name.$name"}; + } + else { + ++$unreserve{"$name (table name)"}; + } + + my $unreserve = sprintf '%s_', $name; + return $unreserve.$suffix; } 1; -__END__ -=head1 NAME +# ------------------------------------------------------------------- +# Life is full of misery, loneliness, and suffering -- +# and it's all over much too soon. +# Woody Allen +# ------------------------------------------------------------------- -SQL::Translator::Producer::PostgreSQL - PostgreSQL-specific producer for SQL::Translator +=pod =head1 AUTHOR