[Bast-commits] r4556 - in DBIx-Class/0.08/branches/replication_dedux: . lib/DBIx lib/DBIx/Class lib/DBIx/Class/Manual lib/DBIx/Class/ResultClass lib/DBIx/Class/Schema lib/DBIx/Class/Storage t

jnapiorkowski at dev.catalyst.perl.org jnapiorkowski at dev.catalyst.perl.org
Mon Jul 7 14:08:34 BST 2008


Author: jnapiorkowski
Date: 2008-07-07 14:08:34 +0100 (Mon, 07 Jul 2008)
New Revision: 4556

Modified:
   DBIx-Class/0.08/branches/replication_dedux/
   DBIx-Class/0.08/branches/replication_dedux/Changes
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class.pm
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Cookbook.pod
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Troubleshooting.pod
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/ResultClass/HashRefInflator.pm
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.pm
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema/Versioned.pm
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/branches/replication_dedux/t/03podcoverage.t
   DBIx-Class/0.08/branches/replication_dedux/t/60core.t
   DBIx-Class/0.08/branches/replication_dedux/t/94versioning.t
Log:
 r14114 at dev (orig r4505):  gphat | 2008-06-19 08:06:57 -0500
 Add make_column_dirty to Row (per request from #dbix-class questions)
 
 r14293 at dev (orig r4514):  wdh | 2008-06-25 05:52:30 -0500
 clarify that ->resultset_class must be called after ->load_components and ->table when using custom resultsets
 r14324 at dev (orig r4518):  wdh | 2008-06-26 07:29:45 -0500
 add troubleshooting examples for quoting issues
 r14371 at dev (orig r4519):  castaway | 2008-06-26 14:51:35 -0500
 Remove setup_connection_class from POD, skip in podcoverage
 
 r14372 at dev (orig r4520):  lukes | 2008-06-27 05:18:08 -0500
 changed default behaviour of do_upgrade in versioned to just run everything
 r14600 at dev (orig r4540):  bricas | 2008-06-30 08:32:03 -0500
 change my nick
 r14601 at dev (orig r4541):  nigel | 2008-06-30 09:30:11 -0500
 Corrected spelling of TRANSACTION in code reading sql upgrade script.
 Pointed out by renormalist on IRC.
 
 r14602 at dev (orig r4542):  bricas | 2008-06-30 09:36:37 -0500
 update marcus in the authors
 r14603 at dev (orig r4543):  lukes | 2008-06-30 13:38:08 -0500
 added ignore_version connect attr and updated docs accordingly
 r14604 at dev (orig r4544):  lukes | 2008-06-30 15:07:13 -0500
 implemented versioning tests for version warns
 r14715 at dev (orig r4551):  ash | 2008-07-02 09:53:32 -0500
 Add caveat about prefetch
 r14716 at dev (orig r4552):  wreis | 2008-07-02 17:19:39 -0500
 updating changelog
 r14717 at dev (orig r4553):  ribasushi | 2008-07-03 18:52:31 -0500
 Minor cookbook fix (two adjacent examples were mixed up)
 r14718 at dev (orig r4554):  lukes | 2008-07-04 07:03:51 -0500
 made versioning overwrite ddl and diff files where appropriate and made arg order of ddl_filename consistent with create_ddl_filename
 r14719 at dev (orig r4555):  lukes | 2008-07-07 07:11:32 -0500
 moved schema_version from Versioning to core



Property changes on: DBIx-Class/0.08/branches/replication_dedux
___________________________________________________________________
Name: svk:merge
   - 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:4492
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
   + 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:4555
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510

Modified: DBIx-Class/0.08/branches/replication_dedux/Changes
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/Changes	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/Changes	2008-07-07 13:08:34 UTC (rev 4556)
@@ -1,5 +1,7 @@
 Revision history for DBIx::Class
 
+        - Added search_related_rs method to ResultSet
+        - add a make_column_dirty method to Row to force updates
         - throw a clear exception when user tries multi-has_many prefetch
         - SQLT parser prefixes index names with ${table}_idx_ to avoid clashes
         - mark ResultSetManager as deprecated and undocument it

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Cookbook.pod	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Cookbook.pod	2008-07-07 13:08:34 UTC (rev 4556)
@@ -194,8 +194,6 @@
     }
   );
 
-  my $count = $rs->next->get_column('count');
-
 =head2 SELECT COUNT(DISTINCT colname)
 
   my $rs = $schema->resultset('Foo')->search(
@@ -208,6 +206,8 @@
     }
   );
 
+  my $count = $rs->next->get_column('count');
+
 =head2 Grouping results
 
 L<DBIx::Class> supports C<GROUP BY> as follows:
@@ -255,8 +255,15 @@
 To use your resultset, first tell DBIx::Class to create an instance of it
 for you, in your My::DBIC::Schema::CD class:
 
+  # class definition as normal
+  __PACKAGE__->load_components(qw/ Core /);
+  __PACKAGE__->table('cd');
+
+  # tell DBIC to use the custom ResultSet class
   __PACKAGE__->resultset_class('My::DBIC::ResultSet::CD');
 
+Note that C<resultset_class> must be called after C<load_components> and C<table>, or you will get errors about missing methods.
+
 Then call your new method in your code:
 
    my $ordered_cds = $schema->resultset('CD')->search_cds_ordered();

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Troubleshooting.pod
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Troubleshooting.pod	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Manual/Troubleshooting.pod	2008-07-07 13:08:34 UTC (rev 4556)
@@ -55,5 +55,73 @@
 specify a fully qualified namespace: C< package MySchema::MyTable; >
 for example.
 
+=head2 syntax error at or near "<something>" ...
+
+This can happen if you have a relation whose name is a word reserved by your
+database, e.g. "user":
+
+  package My::Schema::User;
+  ...
+  __PACKAGE__->table('users');
+  __PACKAGE__->add_columns(qw/ id name /);
+  __PACKAGE__->set_primary_key('id');
+  ...
+  1;
+
+  package My::Schema::ACL;
+  ...
+  __PACKAGE__->table('acl');
+  __PACKAGE__->add_columns(qw/ user_id /);
+  __PACKAGE__->belongs_to( 'user' => 'My::Schema::User', 'user_id' );
+  ...
+  1;
+
+  $schema->resultset('ACL')->search(
+    {},
+    {
+      join => [qw/ user /],
+      '+select' => [ 'user.name' ]
+    }
+  );
+
+The SQL generated would resemble something like:
+
+  SELECT me.user_id, user.name FROM acl me
+  JOIN users user ON me.user_id = user.id
+
+If, as is likely, your database treats "user" as a reserved word, you'd end
+up with the following errors:
+
+1) syntax error at or near "." - due to "user.name" in the SELECT clause
+
+2) syntax error at or near "user" - due to "user" in the JOIN clause
+
+The solution is to enable quoting - see
+L<DBIx::Class::Manual::Cookbook/Setting_quoting_for_the_generated_SQL> for
+details.
+
+Note that quoting may lead to problems with C<order_by> clauses, see
+L<... column "foo DESC" does not exist ...> for info on avoiding those.
+
+=head2 column "foo DESC" does not exist ...
+
+This can happen if you've turned on quoting and then done something like
+this:
+
+  $rs->search( {}, { order_by => [ 'name DESC' ] } );
+
+This results in SQL like this:
+
+  ... ORDER BY "name DESC"
+
+The solution is to pass your order_by items as scalar references to avoid
+quoting:
+
+  $rs->search( {}, { order_by => [ \'name DESC' ] } );
+
+Now you'll get SQL like this:
+
+  ... ORDER BY name DESC
+
 =cut
 

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/ResultClass/HashRefInflator.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/ResultClass/HashRefInflator.pm	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/ResultClass/HashRefInflator.pm	2008-07-07 13:08:34 UTC (rev 4556)
@@ -87,4 +87,21 @@
     };
 }
 
+=head1 CAVEAT
+
+This will not work for relationships that have been prefetched. Consider the
+following:
+
+ my $artist = $artitsts_rs->search({}, {prefetch => 'cds' })->first;
+
+ my $cds = $artist->cds;
+ $cds->result_class('DBIx::Class::ResultClass::HashRefInflator');
+ my $first = $cds->first; 
+
+C<$first> will B<not> be a hashref, it will be a normal CD row since 
+HashRefInflator only affects resultsets at inflation time, and prefetch causes
+relations to be inflated when the master C<$artist> row is inflated.
+
+=cut
+
 1;

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.pm	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.pm	2008-07-07 13:08:34 UTC (rev 4556)
@@ -451,6 +451,20 @@
            keys %{$self->{_dirty_columns}};
 }
 
+=head2 make_column_dirty
+
+Marks a column dirty regardless if it has really changed.  Throws an
+exception if the column does not exist.
+
+=cut
+sub make_column_dirty {
+  my ($self, $column) = @_;
+
+  $self->throw_exception( "No such column '${column}'" )
+    unless exists $self->{_column_data}{$column} || $self->has_column($column);
+  $self->{_dirty_columns}{$column} = 1;
+}
+
 =head2 get_inflated_columns
 
   my %inflated_data = $obj->get_inflated_columns;

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema/Versioned.pm	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema/Versioned.pm	2008-07-07 13:08:34 UTC (rev 4556)
@@ -129,26 +129,6 @@
 __PACKAGE__->mk_classdata('do_backup');
 __PACKAGE__->mk_classdata('do_diff_on_init');
 
-=head2 schema_version
-
-Returns the current schema class' $VERSION; does -not- use $schema->VERSION
-since that varies in results depending on if version.pm is installed, and if
-so the perl or XS versions. If you want this to change, bug the version.pm
-author to make vpp and vxs behave the same.
-
-=cut
-
-sub schema_version {
-  my ($self) = @_;
-  my $class = ref($self)||$self;
-  my $version;
-  {
-    no strict 'refs';
-    $version = ${"${class}::VERSION"};
-  }
-  return $version;
-}
-
 =head2 get_db_version
 
 Returns the version that your database is currently at. This is determined by the values in the
@@ -190,6 +170,8 @@
 
 This method should return the name of the backup file, if appropriate..
 
+This method is disabled by default. Set $schema->do_backup(1) to enable it.
+
 =cut
 
 sub backup
@@ -246,8 +228,8 @@
 
   my $filename = $self->ddl_filename(
                                          $db,
-                                         $self->upgrade_directory,
                                          $self->schema_version,
+                                         $self->upgrade_directory,
                                          'PRE',
                                     );
   my $file;
@@ -302,8 +284,8 @@
   
   my $upgrade_file = $self->ddl_filename(
                                          $self->storage->sqlt_type,
-                                         $self->upgrade_directory,
                                          $self->schema_version,
+                                         $self->upgrade_directory,
                                          $db_version,
                                         );
 
@@ -342,7 +324,7 @@
   @data = split(/;/, join('', @data));
   close($fh);
   @data = grep { $_ && $_ !~ /^-- / } @data;
-  @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
+  @data = grep { $_ !~ /^(BEGIN TRANSACTION|COMMIT)/m } @data;
   return \@data;
 }
 
@@ -353,22 +335,16 @@
 any number of times to run the actual SQL commands, and in between you can
 sandwich your data upgrading. For example, first run all the B<CREATE>
 commands, then migrate your data from old to new tables/formats, then 
-issue the DROP commands when you are finished.
+issue the DROP commands when you are finished. Will run the whole file as it is by default.
 
-Will run the whole file as it is by default.
-
 =cut
 
 sub do_upgrade
 {
-    my ($self) = @_;
+  my ($self) = @_;
 
-    ## overridable sub, per default just run all the commands.
-    $self->run_upgrade(qr/create/i);
-    $self->run_upgrade(qr/alter table .*? add/i);
-    $self->run_upgrade(qr/alter table .*? (?!drop)/i);
-    $self->run_upgrade(qr/alter table .*? drop/i);
-    $self->run_upgrade(qr/drop/i);
+  # just run all the commands (including inserts) in order                                                        
+  $self->run_upgrade(qr/.*?/);
 }
 
 =head2 run_upgrade
@@ -408,21 +384,29 @@
 compatibility between the old versions table (SchemaVersions) and the new one
 (dbix_class_schema_versions).
 
-To avoid the checks on connect, set the env var DBIC_NO_VERSION_CHECK. This can be
-useful for scripts.
+To avoid the checks on connect, set the env var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth arg like so:
 
+  my $schema = MyApp::Schema->connect(
+    $dsn,
+    $user,
+    $password,
+    { ignore_version => 1 },
+  );
+
 =cut
 
 sub connection {
   my $self = shift;
   $self->next::method(@_);
-  $self->_on_connect;
+  $self->_on_connect($_[3]);
   return $self;
 }
 
 sub _on_connect
 {
-  my ($self) = @_;
+  my ($self, $args) = @_;
+
+  $args = {} unless $args;
   $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
   my $vtable = $self->{vschema}->resultset('Table');
 
@@ -436,10 +420,9 @@
       $self->storage->dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
     }
   }
-  
+
   # useful when connecting from scripts etc
-  return if ($ENV{DBIC_NO_VERSION_CHECK});
-  
+  return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
   my $pversion = $self->get_db_version();
 
   if($pversion eq $self->schema_version)

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm	2008-07-07 13:08:34 UTC (rev 4556)
@@ -62,6 +62,29 @@
 
 =head1 METHODS
 
+=head2 schema_version
+
+Returns the current schema class' $VERSION
+
+=cut
+
+sub schema_version {
+  my ($self) = @_;
+  my $class = ref($self)||$self;
+
+  # does -not- use $schema->VERSION
+  # since that varies in results depending on if version.pm is installed, and if
+  # so the perl or XS versions. If you want this to change, bug the version.pm
+  # author to make vpp and vxs behave the same.
+
+  my $version;
+  {
+    no strict 'refs';
+    $version = ${"${class}::VERSION"};
+  }
+  return $version;
+}
+
 =head2 register_class
 
 =over 4
@@ -613,19 +636,6 @@
   return $schema;
 }
 
-=head2 setup_connection_class
-
-=over 4
-
-=item Arguments: $target, @info
-
-=back
-
-Sets up a database connection class to inject between the schema and the
-subclasses that the schema creates.
-
-=cut
-
 sub setup_connection_class {
   my ($class, $target, @info) = @_;
   $class->inject_base($target => 'DBIx::Class::DB');
@@ -1139,11 +1149,11 @@
 
 =over 4
 
-=item Arguments: $directory, $database-type, $version, $preversion
+=item Arguments: $database-type, $version, $directory, $preversion
 
 =back
 
-  my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
+  my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
 
 This method is called by C<create_ddl_dir> to compose a file name out of
 the supplied directory, database type and version number. The default file
@@ -1155,14 +1165,14 @@
 =cut
 
 sub ddl_filename {
-    my ($self, $type, $dir, $version, $pversion) = @_;
+  my ($self, $type, $version, $dir, $preversion) = @_;
 
-    my $filename = ref($self);
-    $filename =~ s/::/-/g;
-    $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
-    $filename =~ s/$version/$pversion-$version/ if($pversion);
-
-    return $filename;
+  my $filename = ref($self);
+  $filename =~ s/::/-/g;
+  $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
+  $filename =~ s/$version/$preversion-$version/ if($preversion);
+  
+  return $filename;
 }
 
 =head2 sqlt_deploy_hook($sqlt_schema)

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm	2008-07-07 13:08:34 UTC (rev 4556)
@@ -1451,12 +1451,10 @@
 
 =cut
 
-sub create_ddl_dir
-{
+sub create_ddl_dir {
   my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_;
 
-  if(!$dir || !-d $dir)
-  {
+  if(!$dir || !-d $dir) {
     warn "No directory given, using ./\n";
     $dir = "./";
   }
@@ -1479,97 +1477,89 @@
   $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
   my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error;
 
-  foreach my $db (@$databases)
-  {
+  foreach my $db (@$databases) {
     $sqlt->reset();
     $sqlt = $self->configure_sqlt($sqlt, $db);
     $sqlt->{schema} = $sqlt_schema;
     $sqlt->producer($db);
 
     my $file;
-    my $filename = $schema->ddl_filename($db, $dir, $version);
-    if(-e $filename)
-    {
-      warn("$filename already exists, skipping $db");
-      next unless ($preversion);
-    } else {
-      my $output = $sqlt->translate;
-      if(!$output)
-      {
-        warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
-        next;
-      }
-      if(!open($file, ">$filename"))
-      {
-          $self->throw_exception("Can't open $filename for writing ($!)");
-          next;
-      }
-      print $file $output;
-      close($file);
-    } 
-    if($preversion)
-    {
-      require SQL::Translator::Diff;
+    my $filename = $schema->ddl_filename($db, $version, $dir);
+    if (-e $filename && (!$version || ($version == $schema->schema_version()))) {
+      # if we are dumping the current version, overwrite the DDL
+      warn "Overwriting existing DDL file - $filename";
+      unlink($filename);
+    }
 
-      my $prefilename = $schema->ddl_filename($db, $dir, $preversion);
-#      print "Previous version $prefilename\n";
-      if(!-e $prefilename)
-      {
-        warn("No previous schema file found ($prefilename)");
-        next;
-      }
+    my $output = $sqlt->translate;
+    if(!$output) {
+      warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
+      next;
+    }
+    if(!open($file, ">$filename")) {
+      $self->throw_exception("Can't open $filename for writing ($!)");
+      next;
+    }
+    print $file $output;
+    close($file);
+  
+    next unless ($preversion);
 
-      my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion);
-      print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n";
-      if(-e $difffile)
-      {
-        warn("$difffile already exists, skipping");
-        next;
-      }
+    require SQL::Translator::Diff;
 
-      my $source_schema;
-      {
-        my $t = SQL::Translator->new($sqltargs);
-        $t->debug( 0 );
-        $t->trace( 0 );
-        $t->parser( $db )                       or die $t->error;
-        $t = $self->configure_sqlt($t, $db);
-        my $out = $t->translate( $prefilename ) or die $t->error;
-        $source_schema = $t->schema;
-        unless ( $source_schema->name ) {
-          $source_schema->name( $prefilename );
-        }
-      }
+    my $prefilename = $schema->ddl_filename($db, $preversion, $dir);
+    if(!-e $prefilename) {
+      warn("No previous schema file found ($prefilename)");
+      next;
+    }
 
-      # The "new" style of producers have sane normalization and can support 
-      # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
-      # And we have to diff parsed SQL against parsed SQL.
-      my $dest_schema = $sqlt_schema;
-
-      unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
-        my $t = SQL::Translator->new($sqltargs);
-        $t->debug( 0 );
-        $t->trace( 0 );
-        $t->parser( $db )                    or die $t->error;
-        $t = $self->configure_sqlt($t, $db);
-        my $out = $t->translate( $filename ) or die $t->error;
-        $dest_schema = $t->schema;
-        $dest_schema->name( $filename )
-          unless $dest_schema->name;
+    my $difffile = $schema->ddl_filename($db, $version, $dir, $preversion);
+    if(-e $difffile) {
+      warn("Overwriting existing diff file - $difffile");
+      unlink($difffile);
+    }
+    
+    my $source_schema;
+    {
+      my $t = SQL::Translator->new($sqltargs);
+      $t->debug( 0 );
+      $t->trace( 0 );
+      $t->parser( $db )                       or die $t->error;
+      $t = $self->configure_sqlt($t, $db);
+      my $out = $t->translate( $prefilename ) or die $t->error;
+      $source_schema = $t->schema;
+      unless ( $source_schema->name ) {
+        $source_schema->name( $prefilename );
       }
+    }
 
-      my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
-                                                    $dest_schema,   $db,
-                                                    $sqltargs
-                                                   );
-      if(!open $file, ">$difffile")
-      { 
-        $self->throw_exception("Can't write to $difffile ($!)");
-        next;
-      }
-      print $file $diff;
-      close($file);
+    # The "new" style of producers have sane normalization and can support 
+    # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
+    # And we have to diff parsed SQL against parsed SQL.
+    my $dest_schema = $sqlt_schema;
+    
+    unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
+      my $t = SQL::Translator->new($sqltargs);
+      $t->debug( 0 );
+      $t->trace( 0 );
+      $t->parser( $db )                    or die $t->error;
+      $t = $self->configure_sqlt($t, $db);
+      my $out = $t->translate( $filename ) or die $t->error;
+      $dest_schema = $t->schema;
+      $dest_schema->name( $filename )
+        unless $dest_schema->name;
     }
+    
+    my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
+                                                  $dest_schema,   $db,
+                                                  $sqltargs
+                                                 );
+    if(!open $file, ">$difffile") { 
+      $self->throw_exception("Can't write to $difffile ($!)");
+      next;
+    }
+    print $file $diff;
+    close($file);
   }
 }
 

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class.pm	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class.pm	2008-07-07 13:08:34 UTC (rev 4556)
@@ -215,6 +215,8 @@
 
 bluefeet: Aran Deltac <bluefeet at cpan.org>
 
+bricas: Brian Cassidy <bricas at cpan.org>
+
 captainL: Luke Saunders <luke.saunders at gmail.com>
 
 castaway: Jess Robinson
@@ -231,8 +233,6 @@
 
 dnm: Justin Wheeler <jwheeler at datademons.com>
 
-draven: Marcus Ramberg <mramberg at cpan.org>
-
 dwc: Daniel Westermann-Clark <danieltwc at cpan.org>
 
 dyfrgi: Michael Leuchtenburg <michael at slashhome.org>
@@ -251,7 +251,7 @@
 
 konobi: Scott McWhirter
 
-LTJake: Brian Cassidy <bricas at cpan.org>
+marcus: Marcus Ramberg <mramberg at cpan.org>
 
 mattlaw: Matt Lawrence
 

Modified: DBIx-Class/0.08/branches/replication_dedux/t/03podcoverage.t
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/03podcoverage.t	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/t/03podcoverage.t	2008-07-07 13:08:34 UTC (rev 4556)
@@ -31,6 +31,11 @@
             qw(cursor)
         ]
     },
+    'DBIx::Class::Schema' => {
+        ignore => [
+            qw(setup_connection_class)
+        ]
+    },
     'DBIx::Class::CDBICompat::AccessorMapping'          => { skip => 1 },
     'DBIx::Class::CDBICompat::AbstractSearch' => {
         ignore => [qw(search_where)]

Modified: DBIx-Class/0.08/branches/replication_dedux/t/60core.t
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/60core.t	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/t/60core.t	2008-07-07 13:08:34 UTC (rev 4556)
@@ -7,7 +7,7 @@
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 78;
+plan tests => 84;
 
 eval { require DateTime::Format::MySQL };
 my $NO_DTFM = $@ ? 1 : 0;
@@ -37,10 +37,26 @@
 
 is($art->name, 'We Are In Rehab', "Accessor update ok");
 
+my %dirty = $art->get_dirty_columns();
+cmp_ok(scalar(keys(%dirty)), '==', 1, '1 dirty column');
+ok(grep($_ eq 'name', keys(%dirty)), 'name is dirty');
+
 is($art->get_column("name"), 'We Are In Rehab', 'And via get_column');
 
 ok($art->update, 'Update run');
 
+my %not_dirty = $art->get_dirty_columns();
+cmp_ok(scalar(keys(%not_dirty)), '==', 0, 'Nothing is dirty');
+
+eval {
+  my $ret = $art->make_column_dirty('name2');
+};
+ok(defined($@), 'Failed to make non-existent column dirty');
+$art->make_column_dirty('name');
+my %fake_dirty = $art->get_dirty_columns();
+cmp_ok(scalar(keys(%fake_dirty)), '==', 1, '1 fake dirty column');
+ok(grep($_ eq 'name', keys(%fake_dirty)), 'name is fake dirty');
+
 my $record_jp = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search(undef, { prefetch => 'cds' })->next;
 
 ok($record_jp, "prefetch on same rel okay");

Modified: DBIx-Class/0.08/branches/replication_dedux/t/94versioning.t
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/94versioning.t	2008-07-07 12:11:32 UTC (rev 4555)
+++ DBIx-Class/0.08/branches/replication_dedux/t/94versioning.t	2008-07-07 13:08:34 UTC (rev 4556)
@@ -18,7 +18,7 @@
     eval "use DBD::mysql; use SQL::Translator 0.09;";
     plan $@
         ? ( skip_all => 'needs DBD::mysql and SQL::Translator 0.09 for testing' )
-        : ( tests => 13 );
+        : ( tests => 17 );
 }
 
 my $version_table_name = 'dbix_class_schema_versions';
@@ -27,11 +27,11 @@
 use lib qw(t/lib);
 use_ok('DBICVersionOrig');
 
-my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass);
+my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
 eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) };
 eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) };
 
-is($schema_orig->ddl_filename('MySQL', 't/var', '1.0'), File::Spec->catfile('t', 'var', 'DBICVersion-Schema-1.0-MySQL.sql'), 'Filename creation working');
+is($schema_orig->ddl_filename('MySQL', '1.0', 't/var'), File::Spec->catfile('t', 'var', 'DBICVersion-Schema-1.0-MySQL.sql'), 'Filename creation working');
 unlink('t/var/DBICVersion-Schema-1.0-MySQL.sql') if (-e 't/var/DBICVersion-Schema-1.0-MySQL.sql');
 $schema_orig->create_ddl_dir('MySQL', undef, 't/var');
 
@@ -47,7 +47,7 @@
   unlink('t/var/DBICVersion-Schema-2.0-MySQL.sql');
   unlink('t/var/DBICVersion-Schema-1.0-2.0-MySQL.sql');
 
-  my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass);
+  my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
   is($schema_upgrade->get_db_version(), '1.0', 'get_db_version ok');
   is($schema_upgrade->schema_version, '2.0', 'schema version ok');
   $schema_upgrade->create_ddl_dir('MySQL', '2.0', 't/var', '1.0');
@@ -59,6 +59,9 @@
     $schema_upgrade->storage->dbh->do('select NewVersionName from TestVersion');
   };
   is($@, '', 'new column created');
+
+  # should overwrite files
+  $schema_upgrade->create_ddl_dir('MySQL', '2.0', 't/var', '1.0');
 }
 
 {
@@ -83,3 +86,35 @@
   ok($@, 'old version table gone');
 
 }
+
+# check behaviour of DBIC_NO_VERSION_CHECK env var and ignore_version connect attr
+{
+  my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
+  eval {
+    $schema_version->storage->dbh->do("DELETE from $version_table_name");
+  };
+
+
+  my $warn = '';
+  $SIG{__WARN__} = sub { $warn = shift };
+  $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
+  like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
+
+
+  # should warn
+  $warn = '';
+  $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
+  is($warn, '', 'warning not detected with attr set');
+  # should not warn
+
+  $ENV{DBIC_NO_VERSION_CHECK} = 1;
+  $warn = '';
+  $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
+  is($warn, '', 'warning not detected with env var set');
+  # should not warn
+
+  $warn = '';
+  $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 });
+  like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
+  # should warn
+}




More information about the Bast-commits mailing list