Add an add_index method on ResultSource (and proxy classes)

diff --git a/Changes b/Changes
index 3246944..48f5c5a 100644 (file)
--- 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 (file)
--- 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<DBIx::Class::Storage>
 
 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<SQL::Translator>. Takes the same arguments
+as L<SQL::Translator::Schema::Table::add_index>.
+
+=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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;