X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema.pm;h=a8a775fbee365a8036ccf8228e88a1655e32f066;hb=97382c6da785347f14ca08acb9582437b6e1547d;hp=02962d29482431f5125629355f4e01ed0e311088;hpb=201642eed3f61181d877fa8af819c3cc624c5646;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm index 02962d2..a8a775f 100644 --- a/lib/SQL/Translator/Schema.pm +++ b/lib/SQL/Translator/Schema.pm @@ -1,9 +1,11 @@ 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 +# 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 @@ -29,9 +31,13 @@ SQL::Translator::Schema - SQL::Translator schema object =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 @@ -43,41 +49,36 @@ returns the database structure. =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 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 + ); } # ---------------------------------------------------------------------- @@ -114,7 +115,8 @@ not be created. } $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]); @@ -127,17 +129,61 @@ not be created. } # ---------------------------------------------------------------------- +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 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' ); @@ -176,6 +222,41 @@ be created. 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 +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 { @@ -223,6 +304,40 @@ not be created. 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 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 { @@ -271,51 +386,39 @@ not be created. } # ---------------------------------------------------------------------- -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 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 { @@ -555,53 +658,6 @@ Returns all the views as an array or array reference. } } - - -# ---------------------------------------------------------------------- -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 { @@ -614,7 +670,7 @@ tables. Accepts the following arguments: =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 @@ -668,9 +724,9 @@ A list of fields to skip in the joins reference_table => $table2->name, reference_fields => $field, ); - } + } } - } + } return 1; } @@ -694,6 +750,22 @@ Get or set the schema's name. (optional) } # ---------------------------------------------------------------------- +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'} }; @@ -708,6 +780,6 @@ sub DESTROY { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE +Ken Youens-Clark Ekclark@cpan.orgE. =cut