X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema.pm;h=e024b8bbe19ae0a6acfeb9d22247a820eabf9a61;hb=23875f0e10ed7f2fe3105bcf0e978dca0bd5a806;hp=6cf710c37bb4be12a64c530aabb5ec65d40eec13;hpb=5f7fd749ef9338e4a2df50f17a7ec16091a0c7f1;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm
index 6cf710c..e024b8b 100644
--- a/lib/SQL/Translator/Schema.pm
+++ b/lib/SQL/Translator/Schema.pm
@@ -32,43 +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::Schema::Role::Extra
-  SQL::Translator::Schema::Role::Error
-  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
@@ -100,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 {
 
@@ -108,7 +89,7 @@ sub add_table {
 
 =head2 add_table
 
-Add a table object.  Returns the new SQL::Translator::Schema::Table object.
+Add a table object.  Returns the new L<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
 not be created.
@@ -140,7 +121,7 @@ not be created.
     my $table_name = $table->name;
 
     if ( defined $self->_tables->{$table_name} ) {
-        return $self->error(qq[Can't create table: "$table_name" exists]);
+        return $self->error(qq[Can't use table name "$table_name": table exists]);
     }
     else {
         $self->_tables->{$table_name} = $table;
@@ -157,7 +138,7 @@ sub drop_table {
 
 Remove a table from the schema. Returns the table object if the table was found
 and removed, an error otherwise. The single parameter can be either a table
-name or an C<SQL::Translator::Schema::Table> object. The "cascade" parameter
+name or an L<SQL::Translator::Schema::Table> object. The "cascade" parameter
 can be set to 1 to also drop all triggers on the table, default is 0.
 
   $schema->drop_table('mytable');
@@ -179,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};
@@ -193,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 {
 
@@ -201,7 +182,7 @@ sub add_procedure {
 
 =head2 add_procedure
 
-Add a procedure object.  Returns the new SQL::Translator::Schema::Procedure
+Add a procedure object.  Returns the new L<SQL::Translator::Schema::Procedure>
 object.  The "name" parameter is required.  If you try to create a procedure
 with the same name as an existing procedure, you will get an error and the
 procedure will not be created.
@@ -251,7 +232,7 @@ sub drop_procedure {
 
 Remove a procedure from the schema. Returns the procedure object if the
 procedure was found and removed, an error otherwise. The single parameter
-can be either a procedure name or an C<SQL::Translator::Schema::Procedure>
+can be either a procedure name or an L<SQL::Translator::Schema::Procedure>
 object.
 
   $schema->drop_procedure('myprocedure');
@@ -271,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};
@@ -279,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 {
 
@@ -287,7 +268,7 @@ sub add_trigger {
 
 =head2 add_trigger
 
-Add a trigger object.  Returns the new SQL::Translator::Schema::Trigger object.
+Add a trigger object.  Returns the new L<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
 not be created.
@@ -335,7 +316,7 @@ sub drop_trigger {
 
 Remove a trigger from the schema. Returns the trigger object if the trigger was
 found and removed, an error otherwise. The single parameter can be either a
-trigger name or an C<SQL::Translator::Schema::Trigger> object.
+trigger name or an L<SQL::Translator::Schema::Trigger> object.
 
   $schema->drop_trigger('mytrigger');
 
@@ -354,7 +335,7 @@ trigger name or an C<SQL::Translator::Schema::Trigger> 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};
@@ -362,7 +343,7 @@ trigger name or an C<SQL::Translator::Schema::Trigger> 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 {
 
@@ -370,7 +351,7 @@ sub add_view {
 
 =head2 add_view
 
-Add a view object.  Returns the new SQL::Translator::Schema::View object.
+Add a view object.  Returns the new L<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
 not be created.
@@ -417,7 +398,7 @@ sub drop_view {
 
 Remove a view from the schema. Returns the view object if the view was found
 and removed, an error otherwise. The single parameter can be either a view
-name or an C<SQL::Translator::Schema::View> object.
+name or an L<SQL::Translator::Schema::View> object.
 
   $schema->drop_view('myview');
 
@@ -435,7 +416,7 @@ name or an C<SQL::Translator::Schema::View> 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};
@@ -451,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 {
 
@@ -518,7 +499,7 @@ Returns all the procedures as an array or array reference.
     }
     else {
         $self->error('No procedures');
-        return wantarray ? () : undef;
+        return;
     }
 }
 
@@ -572,7 +553,7 @@ Returns all the tables as an array or array reference.
     }
     else {
         $self->error('No tables');
-        return wantarray ? () : undef;
+        return;
     }
 }
 
@@ -590,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};
 }
@@ -618,7 +599,7 @@ Returns all the triggers as an array or array reference.
     }
     else {
         $self->error('No triggers');
-        return wantarray ? () : undef;
+        return;
     }
 }
 
@@ -664,7 +645,7 @@ Returns all the views as an array or array reference.
     }
     else {
         $self->error('No views');
-        return wantarray ? () : undef;
+        return;
     }
 }
 
@@ -674,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
@@ -747,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
 
@@ -757,13 +738,7 @@ Get the SQL::Translator instance that instantiated the parser.
 
 =cut
 
-has translator => ( is => 'rw' );
-
-sub DESTROY {
-    my $self = shift;
-    undef $_ for values %{ $self->_tables };
-    undef $_ for values %{ $self->_views };
-}
+has translator => ( is => 'rw', weak_ref => 1 );
 
 1;