X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema.pm;h=efa5bda02f8f588bc18849f3a1f1ce5bd3a52643;hb=3ab19c1b31fa1fef8284a271afd282736242dd8f;hp=d05ebd0a99d50fa279791a45065a21b35b504bd2;hpb=45595850cc8937473606c3430c5fcbbd4b07a294;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm index d05ebd0..efa5bda 100644 --- a/lib/SQL/Translator/Schema.pm +++ b/lib/SQL/Translator/Schema.pm @@ -32,44 +32,24 @@ use SQL::Translator::Schema::Procedure; use SQL::Translator::Schema::Table; use SQL::Translator::Schema::Trigger; use SQL::Translator::Schema::View; +use Sub::Quote qw(quote_sub); use SQL::Translator::Utils 'parse_list_arg'; use Carp; -with qw( - SQL::Translator::Role::Error - SQL::Translator::Role::BuildArgs - SQL::Translator::Schema::Role::Extra - SQL::Translator::Schema::Role::Compare -); +extends 'SQL::Translator::Schema::Object'; our $VERSION = '1.59'; -has _order => (is => 'ro', default => sub { +{ map { $_ => 0 } qw/ +has _order => (is => 'ro', default => quote_sub(q{ +{ map { $_ => 0 } qw/ table view trigger proc - /} }, + /} }), ); -# 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 { - - eval { require Class::MakeMethods } - or croak 'You need to install the CPAN dependency Class::MakeMethods to use as_graph()'; - - require SQL::Translator::Schema::Graph; - - my $self = shift; - - return SQL::Translator::Schema::Graph->new( - translator => $self->translator ); -} - sub as_graph_pm { =pod @@ -101,7 +81,7 @@ Returns a Graph::Directed object with the table names for nodes. return $g; } -has _tables => ( is => 'ro', init_arg => undef, default => sub { +{} } ); +has _tables => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) ); sub add_table { @@ -180,7 +160,7 @@ can be set to 1 to also drop all triggers on the table, default is 0. my $cascade = $args{'cascade'}; if ( !exists $self->_tables->{$table_name} ) { - return $self->error(qq[Can't drop table: $table_name" doesn't exist]); + return $self->error(qq[Can't drop table: "$table_name" doesn't exist]); } my $table = delete $self->_tables->{$table_name}; @@ -194,7 +174,7 @@ can be set to 1 to also drop all triggers on the table, default is 0. return $table; } -has _procedures => ( is => 'ro', init_arg => undef, default => sub { +{} } ); +has _procedures => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) ); sub add_procedure { @@ -272,7 +252,7 @@ object. if ( !exists $self->_procedures->{$proc_name} ) { return $self->error( - qq[Can't drop procedure: $proc_name" doesn't exist]); + qq[Can't drop procedure: "$proc_name" doesn't exist]); } my $proc = delete $self->_procedures->{$proc_name}; @@ -280,7 +260,7 @@ object. return $proc; } -has _triggers => ( is => 'ro', init_arg => undef, default => sub { +{} } ); +has _triggers => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) ); sub add_trigger { @@ -355,7 +335,7 @@ trigger name or an C object. if ( !exists $self->_triggers->{$trigger_name} ) { return $self->error( - qq[Can't drop trigger: $trigger_name" doesn't exist]); + qq[Can't drop trigger: "$trigger_name" doesn't exist]); } my $trigger = delete $self->_triggers->{$trigger_name}; @@ -363,7 +343,7 @@ trigger name or an C object. return $trigger; } -has _views => ( is => 'ro', init_arg => undef, default => sub { +{} } ); +has _views => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) ); sub add_view { @@ -436,7 +416,7 @@ name or an C object. } if ( !exists $self->_views->{$view_name} ) { - return $self->error(qq[Can't drop view: $view_name" doesn't exist]); + return $self->error(qq[Can't drop view: "$view_name" doesn't exist]); } my $view = delete $self->_views->{$view_name}; @@ -452,7 +432,7 @@ Get or set the schema's database. (optional) =cut -has database => ( is => 'rw', default => sub { '' } ); +has database => ( is => 'rw', default => quote_sub(q{ '' }) ); sub is_valid { @@ -519,7 +499,7 @@ Returns all the procedures as an array or array reference. } else { $self->error('No procedures'); - return wantarray ? () : undef; + return; } } @@ -573,7 +553,7 @@ Returns all the tables as an array or array reference. } else { $self->error('No tables'); - return wantarray ? () : undef; + return; } } @@ -591,7 +571,7 @@ Returns a trigger by the name provided. my $self = shift; my $trigger_name = shift or return $self->error('No trigger name'); - return $self->error(qq[Table "$trigger_name" does not exist]) + return $self->error(qq[Trigger "$trigger_name" does not exist]) unless exists $self->_triggers->{$trigger_name}; return $self->_triggers->{$trigger_name}; } @@ -619,7 +599,7 @@ Returns all the triggers as an array or array reference. } else { $self->error('No triggers'); - return wantarray ? () : undef; + return; } } @@ -665,7 +645,7 @@ Returns all the views as an array or array reference. } else { $self->error('No views'); - return wantarray ? () : undef; + return; } } @@ -675,14 +655,14 @@ sub make_natural_joins { =head2 make_natural_joins -Creates foriegn key relationships among like-named fields in different +Creates foreign key relationships among like-named fields in different tables. Accepts the following arguments: =over 4 =item * join_pk_only -A True or False argument which determins whether or not to perform +A True or False argument which determines whether or not to perform the joins from primary keys to fields of the same name in other tables =item * skip_fields @@ -748,7 +728,7 @@ Get or set the schema's name. (optional) =cut -has name => ( is => 'rw', default => sub { '' } ); +has name => ( is => 'rw', default => quote_sub(q{ '' }) ); =pod