From: Ken Youens-Clark Date: Thu, 1 May 2003 04:25:00 +0000 (+0000) Subject: Adding new objects for handing schema data. Not being used while I work X-Git-Tag: v0.02~161 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3c5de62a52d2d49bd3de3768d6f649565fa620e9;p=dbsrgits%2FSQL-Translator.git Adding new objects for handing schema data. Not being used while I work out the tests and the general idea. --- diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm new file mode 100644 index 0000000..0d91e8b --- /dev/null +++ b/lib/SQL/Translator/Schema.pm @@ -0,0 +1,172 @@ +package SQL::Translator::Schema; + +# ---------------------------------------------------------------------- +# $Id: Schema.pm,v 1.1 2003-05-01 04:24:59 kycl4rk Exp $ +# ---------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=pod + +=head1 NAME + +SQL::Translator::Schema - SQL::Translator schema object + +=head1 SYNOPSIS + + use SQL::Translator::Schema; + my $schema = SQL::Translator::Schema->new; + my $foo_table = $schema->add_table( name => 'foo' ); + + $foo_table->add_field( + name => 'foo_id', + data_type => 'integer', + size => 11, + is_primary_key => 1, + ); + + $foo_table->add_field( + name => 'foo_name', + data_type => 'char', + size => 10, + ); + + $foo_table->add_index( + name => '', + fields => [ 'foo_name' ], + ); + + my $view = $schema->add_view(...); + +=head1 DESCSIPTION + +C is the object that accepts, validates, and +returns the database structure. + +=head1 METHODS + +=cut + +use strict; +use Class::Base; +use SQL::Translator::Schema::Table; +use SQL::Translator::Schema::View; + +use base 'Class::Base'; +use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); + +$VERSION = 1.00; + +# ---------------------------------------------------------------------- +sub init { + +=pod + +=head2 new + +Object constructor. + + my $schema = SQL::Translator->new; + +=cut + + my ( $self, $config ) = @_; + # empty for now + return $self; +} + +# ---------------------------------------------------------------------- +sub add_constraint { + +=pod + +=head2 add_constraint + +Add a constraint object. Returns the new +SQL::Translator::Schema::Constraint object. + + my $constraint = $table->add_constraint( name => 'foo' ); + +=cut + + my $self = shift; + my $table = SQL::Translator::Schema::Constraint->new( @_ ) or return + SQL::Translator::Schema::Constraint->error; + + $self->{'tables'}{ $table->name } = $table; + $self->{'tables'}{ $table->name }{'order'} = ++$TABLE_COUNT; + + return $table; +} + +# ---------------------------------------------------------------------- +sub add_table { + +=pod + +=head2 add_table + +Add a table object. Returns the new SQL::Translator::Schema::Table object. + + my $table = $schema->add_table( name => 'foo' ); + +=cut + + my $self = shift; + my $table = SQL::Translator::Schema::Table->new( @_ ) or return + SQL::Translator::Schema::Table->error; + + $self->{'tables'}{ $table->name } = $table; + $self->{'tables'}{ $table->name }{'order'} = ++$TABLE_COUNT; + + return $table; +} + +# ---------------------------------------------------------------------- +sub add_view { + +=pod + +=head2 add_view + +Add a view object. Returns the new SQL::Translator::Schema::View object. + + my $view = $schema->add_view( name => 'foo' ); + +=cut + + my $self = shift; + my $view = SQL::Translator::Schema::View->new( @_ ) or return + SQL::Translator::Schema::View->error; + + $self->{'views'}{ $view->name } = $view; + $self->{'views'}{ $view->name }{'order'} = ++$VIEW_COUNT; + + return $view; +} + +1; + +# ---------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Ken Y. Clark Ekclark@cpan.orgE + +=cut diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm new file mode 100644 index 0000000..b091de0 --- /dev/null +++ b/lib/SQL/Translator/Schema/Constraint.pm @@ -0,0 +1,190 @@ +package SQL::Translator::Schema::Constraint; + +# ---------------------------------------------------------------------- +# $Id: Constraint.pm,v 1.1 2003-05-01 04:24:59 kycl4rk Exp $ +# ---------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=pod + +=head1 NAME + +SQL::Translator::Schema::Constraint - SQL::Translator constraint object + +=head1 SYNOPSIS + + use SQL::Translator::Schema::Constraint; + my $constraint = SQL::Translator::Schema::Constraint->new( + name => 'foo', + fields => [ id ], + type => 'primary_key', + ); + +=head1 DESCRIPTION + +C is the constraint object. + +=head1 METHODS + +=cut + +use strict; +use Class::Base; + +use base 'Class::Base'; +use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); + +$VERSION = 1.00; + +use constant VALID_TYPE => { + primary_key => 1, + unique => 1, + check => 1, + foreign_key => 1, +}; + +# ---------------------------------------------------------------------- +sub init { + +=pod + +=head2 new + +Object constructor. + + my $schema = SQL::Translator::Schema::Constraint->new( + type => 'foreign_key', # type of table constraint + name => 'fk_phone_id', # the name of the constraint + fields => 'phone_id', # the field in the referring table + reference_fields => 'phone_id', # the referenced table + reference_table => 'phone', # the referenced fields + match_type => 'full', # how to match + on_delete_do => 'cascade', # what to do on deletes + on_update_do => '', # what to do on updates + ); + +=cut + + my ( $self, $config ) = @_; +# reference_fields reference_table +# match_type on_delete_do on_update_do + my @fields = qw[ name type fields ]; + + for my $arg ( @fields ) { + next unless $config->{ $arg }; + $self->$arg( $config->{ $arg } ) or return; + } + + return $self; +} + +# ---------------------------------------------------------------------- +sub fields { + +=pod + +=head2 fields + +Gets and set the fields the constraint is on. Accepts a list or arrayref, +return both, too. + + my @fields = $constraint->fields( 'id' ); + +=cut + + my $self = shift; + my $fields = ref $_[0] eq 'ARRAY' ? shift : [ @_ ]; + + if ( @$fields ) { + $self->{'fields'} = $fields; + } + + return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'}; +} + +# ---------------------------------------------------------------------- +sub name { + +=pod + +=head2 name + +Get or set the constraint's name. + + my $name = $constraint->name('foo'); + +=cut + + my $self = shift; + $self->{'name'} = shift if @_; + return $self->{'name'} || ''; +} + +# ---------------------------------------------------------------------- +sub type { + +=pod + +=head2 type + +Get or set the constraint's type. + + my $type = $constraint->type('primary_key'); + +=cut + + my $self = shift; + + if ( my $type = shift ) { + return $self->error("Invalid constraint type: $type") + unless VALID_TYPE->{ $type }; + $self->{'type'} = $type; + } + + return $self->{'type'} || ''; +} + + +# ---------------------------------------------------------------------- +sub is_valid { + +=pod + +=head2 is_valid + +Determine whether the constraint is valid or not. + + my $ok = $constraint->is_valid; + +=cut + + my $self = shift; + return ( $self->name && $self->{'type'} && @{ $self->fields } ) ? 1 : 0; +} + +1; + +# ---------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Ken Y. Clark Ekclark@cpan.orgE + +=cut diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm new file mode 100644 index 0000000..00b03cc --- /dev/null +++ b/lib/SQL/Translator/Schema/Field.pm @@ -0,0 +1,178 @@ +package SQL::Translator::Schema::Field; + +# ---------------------------------------------------------------------- +# $Id: Field.pm,v 1.1 2003-05-01 04:25:00 kycl4rk Exp $ +# ---------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=pod + +=head1 NAME + +SQL::Translator::Schema::Field - SQL::Translator field object + +=head1 SYNOPSIS + + use SQL::Translator::Schema::Field; + my $field = SQL::Translator::Schema::Field->new( + name => 'foo', + sql => 'select * from foo', + ); + +=head1 DESCRIPTION + +C is the field object. + +=head1 METHODS + +=cut + +use strict; +use Class::Base; + +use base 'Class::Base'; +use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); + +$VERSION = 1.00; + +# ---------------------------------------------------------------------- +sub init { + +=pod + +=head2 new + +Object constructor. + + my $schema = SQL::Translator::Schema::Field->new; + +=cut + + my ( $self, $config ) = @_; + $self->params( $config, qw[ name data_type size is_primary_key ] ); + return $self; +} + +# ---------------------------------------------------------------------- +sub data_type { + +=pod + +=head2 data_type + +Get or set the field's data_type. + + my $data_type = $field->data_type('integer'); + +=cut + + my $self = shift; + $self->{'data_type'} = shift if @_; + return $self->{'data_type'} || ''; +} + +# ---------------------------------------------------------------------- +sub is_primary_key { + +=pod + +=head2 is_primary_key + +Get or set the field's is_primary_key attribute. + + my $is_pk = $field->is_primary_key(1); + +=cut + + my ( $self, $arg ) = @_; + + if ( defined $arg ) { + $self->{'is_primary_key'} = $arg ? 1 : 0; + } + + return $self->{'is_primary_key'} || 0; +} + +# ---------------------------------------------------------------------- +sub name { + +=pod + +=head2 name + +Get or set the field's name. + + my $name = $field->name('foo'); + +=cut + + my $self = shift; + $self->{'name'} = shift if @_; + return $self->{'name'} || ''; +} + +# ---------------------------------------------------------------------- +sub size { + +=pod + +=head2 size + +Get or set the field's size. + + my $size = $field->size('25'); + +=cut + + my ( $self, $arg ) = @_; + + if ( $arg =~ m/^\d+(?:\.\d+)?$/ ) { + $self->{'size'} = $arg; + } + + return $self->{'size'} || 0; +} + +# ---------------------------------------------------------------------- +sub is_valid { + +=pod + +=head2 is_valid + +Determine whether the field is valid or not. + + my $ok = $field->is_valid; + +=cut + + my $self = shift; + return 1 if $self->name && $self->data_type; +} + +1; + +# ---------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Ken Y. Clark Ekclark@cpan.orgE + +=cut diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm new file mode 100644 index 0000000..3ee0e4c --- /dev/null +++ b/lib/SQL/Translator/Schema/Index.pm @@ -0,0 +1,177 @@ +package SQL::Translator::Schema::Index; + +# ---------------------------------------------------------------------- +# $Id: Index.pm,v 1.1 2003-05-01 04:25:00 kycl4rk Exp $ +# ---------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=pod + +=head1 NAME + +SQL::Translator::Schema::Index - SQL::Translator index object + +=head1 SYNOPSIS + + use SQL::Translator::Schema::Index; + my $index = SQL::Translator::Schema::Index->new( + name => 'foo', + fields => [ id ], + type => 'unique', + ); + +=head1 DESCRIPTION + +C is the index object. + +Primary keys will be considered table constraints, not indices. + +=head1 METHODS + +=cut + +use strict; +use Class::Base; + +use base 'Class::Base'; +use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); + +$VERSION = 1.00; + +use constant VALID_TYPE => { + unique => 1, + normal => 1, + full_text => 1, # MySQL only (?) +}; + +# ---------------------------------------------------------------------- +sub init { + +=pod + +=head2 new + +Object constructor. + + my $schema = SQL::Translator::Schema::Index->new; + +=cut + + my ( $self, $config ) = @_; + for my $arg ( qw[ name type fields ] ) { + next unless $config->{ $arg }; + $self->$arg( $config->{ $arg } ) or return; + } + return $self; +} + +# ---------------------------------------------------------------------- +sub fields { + +=pod + +=head2 fields + +Gets and set the fields the index is on. Accepts a list or arrayref, +return both, too. + + my @fields = $index->fields( 'id' ); + +=cut + + my $self = shift; + my $fields = ref $_[0] eq 'ARRAY' ? shift : [ @_ ]; + + if ( @$fields ) { + $self->{'fields'} = $fields; + } + + return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'}; +} + +# ---------------------------------------------------------------------- +sub name { + +=pod + +=head2 name + +Get or set the index's name. + + my $name = $index->name('foo'); + +=cut + + my $self = shift; + $self->{'name'} = shift if @_; + return $self->{'name'} || ''; +} + +# ---------------------------------------------------------------------- +sub type { + +=pod + +=head2 type + +Get or set the index's type. + + my $type = $index->type('unique'); + +=cut + + my $self = shift; + + if ( my $type = shift ) { + return $self->error("Invalid index type: $type") + unless VALID_TYPE->{ $type }; + $self->{'type'} = $type; + } + + return $self->{'type'} || ''; +} + + +# ---------------------------------------------------------------------- +sub is_valid { + +=pod + +=head2 is_valid + +Determine whether the index is valid or not. + + my $ok = $index->is_valid; + +=cut + + my $self = shift; + return ( $self->name && $self->{'type'} && @{ $self->fields } ) ? 1 : 0; +} + +1; + +# ---------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Ken Y. Clark Ekclark@cpan.orgE + +=cut diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm new file mode 100644 index 0000000..69ad4f3 --- /dev/null +++ b/lib/SQL/Translator/Schema/Table.pm @@ -0,0 +1,225 @@ +package SQL::Translator::Schema::Table; + +# ---------------------------------------------------------------------- +# $Id: Table.pm,v 1.1 2003-05-01 04:25:00 kycl4rk Exp $ +# ---------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=pod + +=head1 NAME + +SQL::Translator::Schema::Table - SQL::Translator table object + +=head1 SYNOPSIS + + use SQL::Translator::Schema::Table; + my $foo_table = SQL::Translator::Schema::Table->new('foo'); + + $foo_table->add_field( + name => 'foo_id', + data_type => 'integer', + size => 11, + is_primary_key => 1, + ); + + $foo_table->add_field( + name => 'foo_name', + data_type => 'char', + size => 10, + ); + + $foo_table->add_index( + name => '', + fields => [ 'foo_name' ], + ); + +=head1 DESCSIPTION + +C is the table object. + +=head1 METHODS + +=cut + +use strict; +use Class::Base; +use SQL::Translator::Schema::Constraint; +use SQL::Translator::Schema::Field; +use SQL::Translator::Schema::Index; + +use base 'Class::Base'; +use vars qw($VERSION); + +$VERSION = 1.00; + +# ---------------------------------------------------------------------- +sub init { + +=pod + +=head2 new + +Object constructor. + + my $schema = SQL::Translator::Schema::Table->new( name => 'foo' ); + +=cut + + my ( $self, $config ) = @_; + $self->params( $config, qw[ name ] ) || return undef; + return $self; +} + +# ---------------------------------------------------------------------- +sub name { + +=pod + +=head2 name + +Get or set the table's name. + + my $table_name = $table->name('foo'); + +=cut + + my $self = shift; + $self->{'name'} = shift if @_; + return $self->{'name'} || ''; +} + +# ---------------------------------------------------------------------- +sub add_constraint { + +=pod + +=head2 add_constraint + +Add a constraint to the table. + + $table->add_constraint( + name => 'pk', + fields => [ 'foo_id' ], + type => 'primary_key', + ); + +=cut + + my $self = shift; + my $constraint = SQL::Translator::Schema::Constraint->new( @_ ) or + return SQL::Translator::Schema::Constraint->error; + push @{ $self->{'constraints'} }, $constraint; + return $constraint; +} + +# ---------------------------------------------------------------------- +sub add_index { + +=pod + +=head2 add_index + +Add an index to the table. + + $table->add_index( + name => 'name', + fields => [ 'name' ], + type => 'normal', + ); + +=cut + + my $self = shift; + my $index = SQL::Translator::Schema::Index->new( @_ ) or return + SQL::Translator::Schema::Index->error; + push @{ $self->{'indices'} }, $index; + return $index; +} + +# ---------------------------------------------------------------------- +sub add_field { + +=pod + +=head2 add_field + +Add an field to the table. Returns the SQL::Translator::Schema::Field +object. + + my $field = $table->add_field( + name => 'foo_id', + data_type => 'integer', + size => 11, + is_primary_key => 1, + ); + +=cut + + my $self = shift; + my $field = SQL::Translator::Schema::Field->new( @_ ) or return; + SQL::Translator::Schema::Field->error; + $self->{'fields'}{ $field->name } = $field; + return $field; +} + +# ---------------------------------------------------------------------- +sub fields { + +=pod + +=head2 fields + +Returns all the fields. + + my @fields = $table->fields; + +=cut + + my $self = shift; + return wantarray ? %{ $self->{'fields'} || {} } : $self->{'fields'}; +} + +# ---------------------------------------------------------------------- +sub is_valid { + +=pod + +=head2 is_valid + +Determine whether the view is valid or not. + + my $ok = $view->is_valid; + +=cut + + my $self = shift; + return ( $self->name && $self->fields ) ? 1 : 0; +} + +1; + +# ---------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Ken Y. Clark Ekclark@cpan.orgE + +=cut diff --git a/lib/SQL/Translator/Schema/View.pm b/lib/SQL/Translator/Schema/View.pm new file mode 100644 index 0000000..0f9a1bd --- /dev/null +++ b/lib/SQL/Translator/Schema/View.pm @@ -0,0 +1,134 @@ +package SQL::Translator::Schema::View; + +# ---------------------------------------------------------------------- +# $Id: View.pm,v 1.1 2003-05-01 04:25:00 kycl4rk Exp $ +# ---------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=pod + +=head1 NAME + +SQL::Translator::Schema::View - SQL::Translator view object + +=head1 SYNOPSIS + + use SQL::Translator::Schema::View; + my $view = SQL::Translator::Schema::View->new( + name => 'foo', + sql => 'select * from foo', + ); + +=head1 DESCRIPTION + +C is the view object. + +=head1 METHODS + +=cut + +use strict; +use Class::Base; + +use base 'Class::Base'; +use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); + +$VERSION = 1.00; + +# ---------------------------------------------------------------------- +sub init { + +=pod + +=head2 new + +Object constructor. + + my $schema = SQL::Translator::Schema::View->new; + +=cut + + my ( $self, $config ) = @_; + $self->params( $config, qw[ name sql ] ); + return $self; +} + +# ---------------------------------------------------------------------- +sub name { + +=pod + +=head2 name + +Get or set the view's name. + + my $name = $view->name('foo'); + +=cut + + my $self = shift; + $self->{'name'} = shift if @_; + return $self->{'name'} || ''; +} + +# ---------------------------------------------------------------------- +sub sql { + +=pod + +=head2 sql + +Get or set the view's SQL. + + my $sql = $view->sql('select * from foo'); + +=cut + + my $self = shift; + $self->{'sql'} = shift if @_; + return $self->{'sql'} || ''; +} + +# ---------------------------------------------------------------------- +sub is_valid { + +=pod + +=head2 is_valid + +Determine whether the view is valid or not. + + my $ok = $view->is_valid; + +=cut + + my $self = shift; + return 1 if $self->name && $self->sql; +} + +1; + +# ---------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Ken Y. Clark Ekclark@cpan.orgE + +=cut