From: Ash Berlin Date: Fri, 12 Oct 2007 10:26:55 +0000 (+0000) Subject: Add an add_index method on ResultSource (and proxy classes) X-Git-Tag: v0.08010~52 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c385ecea5ec4297f269bcc2b8db8e08f5772196d;p=dbsrgits%2FDBIx-Class.git Add an add_index method on ResultSource (and proxy classes) --- diff --git a/Changes b/Changes index 3246944..48f5c5a 100644 --- a/Changes +++ b/Changes @@ -8,6 +8,8 @@ Revision history for DBIx::Class clash - InflateColumn::DateTime now accepts an extra parameter of timezone to set timezone on the DT object (thanks Sergio Salvi) + - ResultSource now has an add_index method to add indices for when + using SQL::Translator to create tables/SQL. 0.08007 2007-09-04 19:36:00 - patch for Oracle datetime inflation (abram@arin.net) diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 4efa0d7..11f2b09 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -13,7 +13,7 @@ use base qw/DBIx::Class/; __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns _columns _primaries _unique_constraints name resultset_attributes schema from _relationships column_info_from_storage source_info - source_name/); + source_name _indices/); __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class result_class/); @@ -55,6 +55,7 @@ sub new { $new->{_relationships} = { %{$new->{_relationships}||{}} }; $new->{name} ||= "!!NAME NOT SET!!"; $new->{_columns_info_loaded} ||= 0; + $new->_indices([]) unless $new->_indices; return $new; } @@ -449,6 +450,30 @@ See also: L sub storage { shift->schema->storage; } +=head2 add_index + +Add an index to the result source. This has no effect for DBIx::Class - it is +just used for creating SQL with L. Takes the same arguments +as L. + +=cut + +sub add_index { + my ($self, $idx) = @_; + + push @{ $self->_indices }, $idx; +} + +=head2 indicies + +Returns list of secondary (i.e. non unique) indicies created on this table. + +=cut + +sub indices { + return @{ shift->_indices }; +} + =head2 add_relationship $source->add_relationship('relname', 'related_source', $cond, $attrs); diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm index 696c9a5..2ac1228 100644 --- a/lib/DBIx/Class/ResultSourceProxy.pm +++ b/lib/DBIx/Class/ResultSourceProxy.pm @@ -104,4 +104,12 @@ sub relationship_info { shift->result_source_instance->relationship_info(@_); } +sub add_index { + shift->result_source_instance->add_index(@_); +} + +sub indices { + shift->result_source_instance->indices(@_); +} + 1; diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm index 1f09482..a0f37b6 100644 --- a/lib/SQL/Translator/Parser/DBIx/Class.pm +++ b/lib/SQL/Translator/Parser/DBIx/Class.pm @@ -5,6 +5,8 @@ package # hide from PAUSE # Some mistakes the fault of Matt S Trout +# Others the fault of Ash Berlin + use strict; use warnings; use vars qw($DEBUG $VERSION @EXPORT_OK); @@ -107,6 +109,11 @@ sub parse { } } + foreach my $idx ( $source->indices ) { + my $ret = $table->add_index(%$idx) + or die $table->error; + } + my @rels = $source->relationships(); my %created_FK_rels; diff --git a/t/86sqlt.t b/t/86sqlt.t index 095a878..7a76f79 100644 --- a/t/86sqlt.t +++ b/t/86sqlt.t @@ -10,7 +10,7 @@ plan skip_all => 'SQL::Translator required' if $@; my $schema = DBICTest->init_schema; -plan tests => 54; +plan tests => 55; my $translator = SQL::Translator->new( parser_args => { @@ -28,6 +28,7 @@ my $output = $translator->translate(); ok($output, "SQLT produced someoutput") or diag($translator->error); + # Note that the constraints listed here are the only ones that are tested -- if # more exist in the Schema than are listed here and all listed constraints are # correct, the test will still pass. If you add a class with UNIQUE or FOREIGN @@ -213,6 +214,14 @@ my %unique_constraints = ( # ], ); +my %indices = ( + artist => [ + { + 'fields' => ['name'] + }, + ] +); + my $tschema = $translator->schema(); # Test that nonexistent constraints are not found @@ -244,6 +253,13 @@ for my $expected_constraints (keys %unique_constraints) { } } +for my $table_index (keys %indices) { + for my $expected_index ( @{ $indices{$table_index} } ) { + + ok ( get_index($table_index, $expected_index), "Got a matching index on $table_index table"); + } +} + # Returns the Constraint object for the specified constraint type, table and # columns from the SQL::Translator schema, or undef if no matching constraint # is found. @@ -293,6 +309,34 @@ sub get_constraint { return undef; # didn't find a matching constraint } +sub get_index { + my ($table_name, $index) = @_; + + my $table = $tschema->get_table($table_name); + + CAND_INDEX: + for my $cand_index ( $table->get_indices ) { + + next CAND_INDEX if $index->{name} && $cand_index->name ne $index->{name} + || $index->{type} && $cand_index->type ne $index->{type}; + + my %idx_fields = map { $_ => 1 } $cand_index->fields; + + for my $field ( @{ $index->{fields} } ) { + next CAND_INDEX unless $idx_fields{$field}; + } + + %idx_fields = map { $_ => 1 } @{$index->{fields}}; + for my $field ( $cand_index->fields) { + next CAND_INDEX unless $idx_fields{$field}; + } + + return $cand_index; + } + + return undef; # No matching idx +} + # Test parameters in a FOREIGN KEY constraint other than columns sub test_fk { my ($expected, $got) = @_; diff --git a/t/lib/DBICTest/Schema/Artist.pm b/t/lib/DBICTest/Schema/Artist.pm index 90eb7bf..a412bf0 100644 --- a/t/lib/DBICTest/Schema/Artist.pm +++ b/t/lib/DBICTest/Schema/Artist.pm @@ -41,4 +41,6 @@ __PACKAGE__->has_many( { cascade_copy => 0 } # this would *so* not make sense ); +__PACKAGE__->add_index({ name => 'artist_name', fields => ['name'],}); + 1;