package SQL::Translator::Schema;
+# vim: sw=4: ts=4:
+
# ----------------------------------------------------------------------
-# $Id: Schema.pm,v 1.11 2003-10-08 18:30:15 phrrngtn Exp $
+# $Id: Schema.pm,v 1.22 2005-06-07 16:55:41 kycl4rk Exp $
# ----------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
+# 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
=head1 SYNOPSIS
use SQL::Translator::Schema;
- my $schema = SQL::Translator::Schema->new;
- my $table = $schema->add_table( name => 'foo' );
- my $view = $schema->add_view( name => 'bar', sql => '...' );
+ my $schema = SQL::Translator::Schema->new(
+ name => 'Foo',
+ database => 'MySQL',
+ );
+ my $table = $schema->add_table( name => 'foo' );
+ my $view = $schema->add_view( name => 'bar', sql => '...' );
+
=head1 DESCSIPTION
=cut
use strict;
-use Class::Base;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Schema::Procedure;
use SQL::Translator::Schema::Table;
use SQL::Translator::Schema::Trigger;
use SQL::Translator::Schema::View;
-use SQL::Translator::Schema::Procedure;
-
+use SQL::Translator::Schema::Graph;
use SQL::Translator::Utils 'parse_list_arg';
-
-use base 'Class::Base';
+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.11 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\d+)\.(\d+)/;
+
+__PACKAGE__->_attributes( qw/name database translator/ );
# ----------------------------------------------------------------------
-sub init {
+sub as_graph {
=pod
-=head2 new
-
-Object constructor.
+=head2 as_graph
- my $schema = SQL::Translator->new(
- name => 'Foo',
- database => 'MySQL',
- );
+Returns the schema as an L<SQL::Translator::Schema::Graph> object.
=cut
- my ( $self, $config ) = @_;
- $self->params( $config, qw[ name database ] ) || return undef;
- return $self;
+ my $self = @_;
+ return SQL::Translator::Schema::Graph->new(
+ translator => $self->translator
+ );
}
# ----------------------------------------------------------------------
}
$table->order( ++$TABLE_ORDER );
- my $table_name = $table->name or return $self->error('No table name');
+ # We know we have a name as the Table->new above errors if none given.
+ my $table_name = $table->name;
if ( defined $self->{'tables'}{ $table_name } ) {
return $self->error(qq[Can't create table: "$table_name" exists]);
}
# ----------------------------------------------------------------------
+sub drop_table {
+
+=pod
+
+=head2 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
+can be set to 1 to also drop all triggers on the table, default is 0.
+
+ $schema->drop_table('mytable');
+ $schema->drop_table('mytable', cascade => 1);
+
+=cut
+
+ my $self = shift;
+ my $table_class = 'SQL::Translator::Schema::Table';
+ my $table_name;
+
+ if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
+ $table_name = shift->name;
+ }
+ else {
+ $table_name = shift;
+ }
+ my %args = @_;
+ my $cascade = $args{'cascade'};
+
+ if ( ! exists $self->{'tables'}{ $table_name } ) {
+ return $self->error(qq[Can't drop table: $table_name" doesn't exist]);
+ }
+
+ my $table = delete $self->{'tables'}{ $table_name };
+
+ if ( $cascade ) {
+ # Drop all triggers on this table
+ $self->drop_trigger() for (grep { $_->on_table eq $table_name }
+ @{ $self->{'triggers'}}
+ );
+ }
+ return $table;
+}
+
+# ----------------------------------------------------------------------
sub add_procedure {
=pod
=head2 add_procedure
-Add a procedure object. Returns the new
-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.
+Add a procedure object. Returns the new 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.
my $p1 = $schema->add_procedure( name => 'foo' );
my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' );
return $procedure;
}
+# ----------------------------------------------------------------------
+sub drop_procedure {
+
+=pod
+
+=head2 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>
+object.
+
+ $schema->drop_procedure('myprocedure');
+
+=cut
+
+ my $self = shift;
+ my $proc_class = 'SQL::Translator::Schema::Procedure';
+ my $proc_name;
+
+ if ( UNIVERSAL::isa( $_[0], $proc_class ) ) {
+ $proc_name = shift->name;
+ }
+ else {
+ $proc_name = shift;
+ }
+
+ if ( ! exists $self->{'procedures'}{ $proc_name } ) {
+ return $self->error(qq[Can't drop procedure: $proc_name" doesn't exist]);
+ }
+
+ my $proc = delete $self->{'procedures'}{ $proc_name };
+
+ return $proc;
+}
# ----------------------------------------------------------------------
sub add_trigger {
return $trigger;
}
+# ----------------------------------------------------------------------
+sub drop_trigger {
+
+=pod
+
+=head2 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.
+
+ $schema->drop_trigger('mytrigger');
+
+=cut
+
+ my $self = shift;
+ my $trigger_class = 'SQL::Translator::Schema::Trigger';
+ my $trigger_name;
+
+ if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
+ $trigger_name = shift->name;
+ }
+ else {
+ $trigger_name = shift;
+ }
+
+ if ( ! exists $self->{'triggers'}{ $trigger_name } ) {
+ return $self->error(qq[Can't drop trigger: $trigger_name" doesn't exist]);
+ }
+
+ my $trigger = delete $self->{'triggers'}{ $trigger_name };
+
+ return $trigger;
+}
# ----------------------------------------------------------------------
sub add_view {
}
# ----------------------------------------------------------------------
-sub add_procedure {
+sub drop_view {
=pod
-=head2 add_procedure
+=head2 drop_view
-Add a procedure object. Returns the new
-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 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.
- my $p1 = $schema->add_procedure( name => 'foo' );
- my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' );
- $p2 = $schema->add_procedure( $p2 ) or die $schema->error;
+ $schema->drop_view('myview');
=cut
- my $self = shift;
- my $procedure_class = 'SQL::Translator::Schema::Procedure';
- my $procedure;
+ my $self = shift;
+ my $view_class = 'SQL::Translator::Schema::View';
+ my $view_name;
- if ( UNIVERSAL::isa( $_[0], $procedure_class ) ) {
- $procedure= shift;
- $procedure->schema( $self );
+ if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
+ $view_name = shift->name;
}
else {
- my %args = @_;
- return $self->error('No procedure name') unless $args{'name'};
- $args{'schema'} = $self;
- $procedure = $procedure_class->new( \%args ) or return $procedure_class->error;
+ $view_name = shift;
}
- my $procedure_name = $procedure->name or return $self->error('No procedure name');
-
- if ( defined $self->{'procedures'}{ $procedure_name } ) {
- return $self->error(qq[Can't create procedure: "$procedure_name" exists]);
- }
- else {
- $self->{'procedures'}{ $procedure_name } = $procedure;
+ if ( ! exists $self->{'views'}{ $view_name } ) {
+ return $self->error(qq[Can't drop view: $view_name" doesn't exist]);
}
- return $procedure;
-}
+ my $view = delete $self->{'views'}{ $view_name };
+ return $view;
+}
# ----------------------------------------------------------------------
sub database {
}
}
-
-
-# ----------------------------------------------------------------------
-sub get_procedure {
-
-=pod
-
-=head2 get_procedure
-
-Returns a procedure by the name provided.
-
- my $view = $schema->get_procedure('foo');
-
-=cut
-
- my $self = shift;
- my $procedure_name = shift or return $self->error('No procedure name');
- return $self->error('Procedure "$procedure_name" does not exist') unless
- exists $self->{'procedures'}{ $procedure_name };
- return $self->{'procedures'}{ $procedure_name };
-}
-
-# ----------------------------------------------------------------------
-sub get_procedures {
-
-=pod
-
-=head2 get_procedures
-
-Returns all the procedures as an array or array reference.
-
- my @procedures = $schema->get_procedures;
-
-=cut
-
- my $self = shift;
- my @procedures = values %{ $self->{'procedures'} };
-
- if ( @procedures ) {
- return wantarray ? @procedures : \@procedures;
- }
- else {
- $self->error('No procedures');
- return wantarray ? () : undef;
- }
-}
-
# ----------------------------------------------------------------------
sub make_natural_joins {
=over 4
-=item * join_pk_only
+=item * join_pk_only
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
reference_table => $table2->name,
reference_fields => $field,
);
- }
+ }
}
- }
+ }
return 1;
}
}
# ----------------------------------------------------------------------
+sub translator {
+
+=pod
+
+=head2 translator
+
+Get the SQL::Translator instance that instantiated the parser.
+
+=cut
+
+ my $self = shift;
+ $self->{'translator'} = shift if @_;
+ return $self->{'translator'};
+}
+
+# ----------------------------------------------------------------------
sub DESTROY {
my $self = shift;
undef $_ for values %{ $self->{'tables'} };
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=cut
projects / dbsrgits/SQL-Translator.git / blobdiff