X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema.pm;h=2c725ba8652aa375999d710bdce9813f1a20a219;hb=6a84bf09201d18709c5328fc6c22a68f95c709c8;hp=86ceb676ddab620184044deb323f80f5e2015690;hpb=4c4636ed5857768d97998c890154211a0751ac5a;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm index 86ceb67..2c725ba 100644 --- a/lib/SQL/Translator/Schema.pm +++ b/lib/SQL/Translator/Schema.pm @@ -1,27 +1,5 @@ package SQL::Translator::Schema; -# vim: sw=4: ts=4: - -# ---------------------------------------------------------------------- -# $Id: Schema.pm,v 1.27 2007-10-24 10:58:35 schiffbruechige Exp $ -# ---------------------------------------------------------------------- -# Copyright (C) 2002-4 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 -# ------------------------------------------------------------------- - =pod =head1 NAME @@ -49,6 +27,7 @@ returns the database structure. =cut use strict; +use warnings; use SQL::Translator::Schema::Constants; use SQL::Translator::Schema::Procedure; use SQL::Translator::Schema::Table; @@ -56,24 +35,36 @@ use SQL::Translator::Schema::Trigger; use SQL::Translator::Schema::View; use SQL::Translator::Utils 'parse_list_arg'; +use Carp; use base 'SQL::Translator::Schema::Object'; -use vars qw[ $VERSION $TABLE_ORDER $VIEW_ORDER $TRIGGER_ORDER $PROC_ORDER ]; - -$VERSION = sprintf "%d.%02d", q$Revision: 1.27 $ =~ /(\d+)\.(\d+)/; +our $VERSION = '1.59'; __PACKAGE__->_attributes(qw/name database translator/); -# ---------------------------------------------------------------------- -sub as_graph { +sub new { + my $class = shift; + my $self = $class->SUPER::new (@_) + or return; -=pod + $self->{_order} = { map { $_ => 0 } qw/ + table + view + trigger + proc + /}; + + return $self; +} -=head2 as_graph +# FIXME - to be removed, together with the SQL::Translator::Schema::Graph* stuff +# looks like a remnant of the Turnkey project integration back in 2003-4 +# Appears to be quite dead +sub as_graph { -Returns the schema as an L object. + eval { require Class::MakeMethods } + or croak 'You need to install the CPAN dependency Class::MakeMethods to use as_graph()'; -=cut require SQL::Translator::Schema::Graph; my $self = shift; @@ -82,7 +73,6 @@ Returns the schema as an L object. translator => $self->translator ); } -# ---------------------------------------------------------------------- sub as_graph_pm { =pod @@ -97,11 +87,11 @@ Returns a Graph::Directed object with the table names for nodes. my $self = shift; my $g = Graph::Directed->new; - - for my $table ( $self->get_tables ) { + + for my $table ( $self->get_tables ) { my $tname = $table->name; $g->add_vertex( $tname ); - + for my $field ( $table->get_fields ) { if ( $field->is_foreign_key ) { my $fktable = $field->foreign_key_reference->reference_table; @@ -114,7 +104,6 @@ Returns a Graph::Directed object with the table names for nodes. return $g; } -# ---------------------------------------------------------------------- sub add_table { =pod @@ -123,7 +112,7 @@ sub add_table { Add a table object. Returns the new SQL::Translator::Schema::Table object. The "name" parameter is required. If you try to create a table with the -same name as an existing table, you will get an error and the table will +same name as an existing table, you will get an error and the table will not be created. my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error; @@ -141,13 +130,13 @@ not be created. $table->schema($self); } else { - my %args = @_; + my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; $args{'schema'} = $self; $table = $table_class->new( \%args ) or return $self->error( $table_class->error ); } - $table->order( ++$TABLE_ORDER ); + $table->order( ++$self->{_order}{table} ); # We know we have a name as the Table->new above errors if none given. my $table_name = $table->name; @@ -162,7 +151,6 @@ not be created. return $table; } -# ---------------------------------------------------------------------- sub drop_table { =pod @@ -207,7 +195,6 @@ can be set to 1 to also drop all triggers on the table, default is 0. return $table; } -# ---------------------------------------------------------------------- sub add_procedure { =pod @@ -234,14 +221,14 @@ procedure will not be created. $procedure->schema($self); } else { - my %args = @_; + my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; $args{'schema'} = $self; return $self->error('No procedure name') unless $args{'name'}; $procedure = $procedure_class->new( \%args ) or return $self->error( $procedure_class->error ); } - $procedure->order( ++$PROC_ORDER ); + $procedure->order( ++$self->{_order}{proc} ); my $procedure_name = $procedure->name or return $self->error('No procedure name'); @@ -256,7 +243,6 @@ procedure will not be created. return $procedure; } -# ---------------------------------------------------------------------- sub drop_procedure { =pod @@ -293,7 +279,6 @@ object. return $proc; } -# ---------------------------------------------------------------------- sub add_trigger { =pod @@ -302,7 +287,7 @@ sub add_trigger { Add a trigger object. Returns the new SQL::Translator::Schema::Trigger object. The "name" parameter is required. If you try to create a trigger with the -same name as an existing trigger, you will get an error and the trigger will +same name as an existing trigger, you will get an error and the trigger will not be created. my $t1 = $schema->add_trigger( name => 'foo' ); @@ -320,14 +305,14 @@ not be created. $trigger->schema($self); } else { - my %args = @_; + my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; $args{'schema'} = $self; return $self->error('No trigger name') unless $args{'name'}; $trigger = $trigger_class->new( \%args ) or return $self->error( $trigger_class->error ); } - $trigger->order( ++$TRIGGER_ORDER ); + $trigger->order( ++$self->{_order}{trigger} ); my $trigger_name = $trigger->name or return $self->error('No trigger name'); if ( defined $self->{'triggers'}{$trigger_name} ) { @@ -340,7 +325,6 @@ not be created. return $trigger; } -# ---------------------------------------------------------------------- sub drop_trigger { =pod @@ -376,7 +360,6 @@ trigger name or an C object. return $trigger; } -# ---------------------------------------------------------------------- sub add_view { =pod @@ -385,7 +368,7 @@ sub add_view { Add a view object. Returns the new SQL::Translator::Schema::View object. The "name" parameter is required. If you try to create a view with the -same name as an existing view, you will get an error and the view will +same name as an existing view, you will get an error and the view will not be created. my $v1 = $schema->add_view( name => 'foo' ); @@ -403,13 +386,13 @@ not be created. $view->schema($self); } else { - my %args = @_; + my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; $args{'schema'} = $self; return $self->error('No view name') unless $args{'name'}; $view = $view_class->new( \%args ) or return $view_class->error; } - $view->order( ++$VIEW_ORDER ); + $view->order( ++$self->{_order}{view} ); my $view_name = $view->name or return $self->error('No view name'); if ( defined $self->{'views'}{$view_name} ) { @@ -422,7 +405,6 @@ not be created. return $view; } -# ---------------------------------------------------------------------- sub drop_view { =pod @@ -457,7 +439,6 @@ name or an C object. return $view; } -# ---------------------------------------------------------------------- sub database { =pod @@ -475,7 +456,6 @@ Get or set the schema's database. (optional) return $self->{'database'} || ''; } -# ---------------------------------------------------------------------- sub is_valid { =pod @@ -499,7 +479,6 @@ Returns true if all the tables and views are valid. return 1; } -# ---------------------------------------------------------------------- sub get_procedure { =pod @@ -519,7 +498,6 @@ Returns a procedure by the name provided. return $self->{'procedures'}{$procedure_name}; } -# ---------------------------------------------------------------------- sub get_procedures { =pod @@ -547,7 +525,6 @@ Returns all the procedures as an array or array reference. } } -# ---------------------------------------------------------------------- sub get_table { =pod @@ -564,18 +541,17 @@ Returns a table by the name provided. my $table_name = shift or return $self->error('No table name'); my $case_insensitive = shift; if ( $case_insensitive ) { - $table_name = uc($table_name); - foreach my $table ( keys %{$self->{tables}} ) { - return $self->{tables}{$table} if $table_name eq uc($table); - } - return $self->error(qq[Table "$table_name" does not exist]); + $table_name = uc($table_name); + foreach my $table ( keys %{$self->{tables}} ) { + return $self->{tables}{$table} if $table_name eq uc($table); + } + return $self->error(qq[Table "$table_name" does not exist]); } return $self->error(qq[Table "$table_name" does not exist]) unless exists $self->{'tables'}{$table_name}; return $self->{'tables'}{$table_name}; } -# ---------------------------------------------------------------------- sub get_tables { =pod @@ -603,7 +579,6 @@ Returns all the tables as an array or array reference. } } -# ---------------------------------------------------------------------- sub get_trigger { =pod @@ -623,7 +598,6 @@ Returns a trigger by the name provided. return $self->{'triggers'}{$trigger_name}; } -# ---------------------------------------------------------------------- sub get_triggers { =pod @@ -651,7 +625,6 @@ Returns all the triggers as an array or array reference. } } -# ---------------------------------------------------------------------- sub get_view { =pod @@ -671,7 +644,6 @@ Returns a view by the name provided. return $self->{'views'}{$view_name}; } -# ---------------------------------------------------------------------- sub get_views { =pod @@ -699,7 +671,6 @@ Returns all the views as an array or array reference. } } -# ---------------------------------------------------------------------- sub make_natural_joins { =pod @@ -713,14 +684,14 @@ tables. Accepts the following arguments: =item * join_pk_only -A True or False argument which determins whether or not to perform +A True or False argument which determins whether or not to perform the joins from primary keys to fields of the same name in other tables =item * skip_fields A list of fields to skip in the joins -=back 4 +=back $schema->make_natural_joins( join_pk_only => 1, @@ -771,7 +742,6 @@ A list of fields to skip in the joins return 1; } -# ---------------------------------------------------------------------- sub name { =pod @@ -789,7 +759,6 @@ Get or set the schema's name. (optional) return $self->{'name'} || ''; } -# ---------------------------------------------------------------------- sub translator { =pod @@ -805,7 +774,6 @@ Get the SQL::Translator instance that instantiated the parser. return $self->{'translator'}; } -# ---------------------------------------------------------------------- sub DESTROY { my $self = shift; undef $_ for values %{ $self->{'tables'} }; @@ -814,8 +782,6 @@ sub DESTROY { 1; -# ---------------------------------------------------------------------- - =pod =head1 AUTHOR