From: Luke Saunders <luke.saunders@gmail.com>
Date: Tue, 10 Jun 2008 19:09:24 +0000 (+0000)
Subject: added some perldoc
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0e2c68097a6c35e41ad9daee61957ca0ed871cdd;p=dbsrgits%2FDBIx-Class-Historic.git

added some perldoc
---

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index df6131d..7e18f58 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -1028,7 +1028,9 @@ produced include a DROP TABLE statement for each table created.
 
 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash 
 ref or an array ref, containing a list of source to deploy. If present, then 
-only the sources listed will get deployed.
+only the sources listed will get deployed. Furthermore, you can use the
+C<add_fk_index> parser parameter to prevent the parser from creating an index for each
+FK.
 
 =cut
 
@@ -1082,6 +1084,8 @@ override this method in your schema if you would like a different file
 name format. For the ALTER file, the same format is used, replacing
 $version in the name with "$preversion-$version".
 
+See L<DBIx::Class::Schema/deploy> for details of $sqlt_args.
+
 If no arguments are passed, then the following default values are used:
 
 =over 4
diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index bdcc9a3..ad314b2 100644
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -23,6 +23,9 @@ use base qw(Exporter);
 # -------------------------------------------------------------------
 # parse($tr, $data)
 #
+# setting parser_args => { add_fk_index => 0 } will prevent
+# the auto-generation of an index for each FK.
+#
 # Note that $data, in the case of this parser, is not useful.
 # We're working with DBIx::Class Schemas, not data streams.
 # -------------------------------------------------------------------
@@ -173,15 +176,17 @@ sub parse {
                                     (defined $is_deferrable ? ( deferrable => $is_deferrable ) : ()),
                   );
                     
-                  my $index = $table->add_index(
-                                    name   => join('_', $table->name, 'idx', @keys),
-                                    fields => \@keys,
-                                    type   => 'NORMAL',
-                  );
-                }
+                  unless (exists $args->{add_fk_index} && ($args->{add_fk_index} == 0)) {
+                      my $index = $table->add_index(
+                                                    name   => join('_', $table->name, 'idx', @keys),
+                                                    fields => \@keys,
+                                                    type   => 'NORMAL',
+                                                    );
+                  }
+              }
             }
         }
-
+		
         if ($source->result_class->can('sqlt_deploy_hook')) {
           $source->result_class->sqlt_deploy_hook($table);
         }
diff --git a/t/94versioning.t b/t/94versioning.t
index 3667c52..3324745 100644
--- a/t/94versioning.t
+++ b/t/94versioning.t
@@ -15,9 +15,9 @@ BEGIN {
     unless ($dsn);
 
 
-    eval "use DBD::mysql; use SQL::Translator 0.08;";
+    eval "use DBD::mysql; use SQL::Translator 0.09;";
     plan $@
-        ? ( skip_all => 'needs DBD::mysql and SQL::Translator 0.08 for testing' )
+        ? ( skip_all => 'needs DBD::mysql and SQL::Translator 0.09 for testing' )
         : ( tests => 13 );
 }
 
diff --git a/t/99dbic_sqlt_parser.t b/t/99dbic_sqlt_parser.t
new file mode 100644
index 0000000..900e124
--- /dev/null
+++ b/t/99dbic_sqlt_parser.t
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+BEGIN {
+    eval "use DBD::mysql; use SQL::Translator 0.09;";
+    plan $@
+        ? ( skip_all => 'needs SQL::Translator 0.09 for testing' )
+        : ( tests => 99 );
+}
+
+my $schema = DBICTest->init_schema();
+
+{ 
+	my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
+
+	foreach my $source ($schema->sources) {
+		my $table = $sqlt_schema->get_table($schema->source($source)->from);
+
+		my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
+		my @indices = $table->get_indices;
+		my $index_count = scalar(@indices);
+		is($index_count, $fk_count, "correct number of indices for $source with no args");
+	}
+}
+
+{ 
+	my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
+
+	foreach my $source ($schema->sources) {
+		my $table = $sqlt_schema->get_table($schema->source($source)->from);
+
+		my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
+		my @indices = $table->get_indices;
+		my $index_count = scalar(@indices);
+		is($index_count, $fk_count, "correct number of indices for $source with add_fk_index => 1");
+	}
+}
+
+{ 
+	my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
+
+	foreach my $source ($schema->sources) {
+		my $table = $sqlt_schema->get_table($schema->source($source)->from);
+
+		my @indices = $table->get_indices;
+		my $index_count = scalar(@indices);
+		is($index_count, 0, "correct number of indices for $source with add_fk_index => 0");
+	}
+}
+
+sub create_schema {
+	my $args = shift;
+
+	my $schema = $args->{schema};
+	my $additional_sqltargs = $args->{args} || {};
+
+	my $sqltargs = {
+		add_drop_table => 1, 
+		ignore_constraint_names => 1,
+		ignore_index_names => 1,
+		%{$additional_sqltargs}
+		};
+
+	my $sqlt = SQL::Translator->new( $sqltargs );
+
+	$sqlt->parser('SQL::Translator::Parser::DBIx::Class');
+	return $sqlt->translate({ data => $schema }) or die $sqlt->error;
+}