[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