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';
+our $VERSION = '1.59_01';
-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
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 {
=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.
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');
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};
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 {
=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.
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');
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};
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 {
=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.
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');
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};
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 {
=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.
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');
}
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};
=cut
-has database => ( is => 'rw', default => sub { '' } );
+has database => ( is => 'rw', default => quote_sub(q{ '' }) );
sub is_valid {
}
else {
$self->error('No procedures');
- return wantarray ? () : undef;
+ return;
}
}
}
else {
$self->error('No tables');
- return wantarray ? () : undef;
+ return;
}
}
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};
}
}
else {
$self->error('No triggers');
- return wantarray ? () : undef;
+ return;
}
}
}
else {
$self->error('No views');
- return wantarray ? () : undef;
+ return;
}
}
=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
=cut
-has name => ( is => 'rw', default => sub { '' } );
+has name => ( is => 'rw', default => quote_sub(q{ '' }) );
=pod
=cut
-has translator => ( is => 'rw' );
+has translator => ( is => 'rw', weak_ref => 1 );
1;