[Bast-commits] r4584 - in
DBIx-Class/0.08/branches/complex_join_rels: . lib/DBIx/Class
lib/DBIx/Class/Schema lib/DBIx/Class/Storage
lib/SQL/Translator/Parser/DBIx t
groditi at dev.catalyst.perl.org
groditi at dev.catalyst.perl.org
Wed Jul 16 18:35:07 BST 2008
Author: groditi
Date: 2008-07-16 18:35:07 +0100 (Wed, 16 Jul 2008)
New Revision: 4584
Modified:
DBIx-Class/0.08/branches/complex_join_rels/
DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage.pm
DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/complex_join_rels/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/branches/complex_join_rels/t/94versioning.t
Log:
r20681 at martha (orig r4575): plu | 2008-07-15 04:36:20 -0400
Skip custom query sources
r20685 at martha (orig r4579): lukes | 2008-07-15 18:13:08 -0400
r9099 at luke-mbp (orig r4573): lukes | 2008-07-14 13:11:13 +0100
new branch
r9100 at luke-mbp (orig r4574): lukes | 2008-07-14 15:01:50 +0100
reordered methods of Versioned.pm and factored the initialisation stuff from upgrade to install
r9128 at luke-mbp (orig r4576): lukes | 2008-07-15 23:07:38 +0100
major versioning doc refactor
r9129 at luke-mbp (orig r4577): lukes | 2008-07-15 23:11:10 +0100
removed EXPERIMENTAL notices
r20687 at martha (orig r4581): ash | 2008-07-16 12:41:52 -0400
Update docs re txn_scope_guard
Property changes on: DBIx-Class/0.08/branches/complex_join_rels
___________________________________________________________________
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:/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/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:4581
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/complex_join_rels/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Schema/Versioned.pm 2008-07-16 17:13:35 UTC (rev 4583)
+++ DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Schema/Versioned.pm 2008-07-16 17:35:07 UTC (rev 4584)
@@ -71,48 +71,109 @@
=head1 SYNOPSIS
package Library::Schema;
- use base qw/DBIx::Class::Schema/;
+ use base qw/DBIx::Class::Schema/;
+
+ our $VERSION = 0.001;
+
# load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
__PACKAGE__->load_classes(qw/CD Book DVD/);
- __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
+ __PACKAGE__->load_components(qw/Schema::Versioned/);
__PACKAGE__->upgrade_directory('/path/to/upgrades/');
- __PACKAGE__->backup_directory('/path/to/backups/');
=head1 DESCRIPTION
-This module is a component designed to extend L<DBIx::Class::Schema>
-classes, to enable them to upgrade to newer schema layouts. To use this
-module, you need to have called C<create_ddl_dir> on your Schema to
-create your upgrade files to include with your delivery.
+This module provides methods to apply DDL changes to your database using SQL
+diff files. Normally these diff files would be created using
+L<DBIx::Class::Schema/create_ddl_dir>.
A table called I<dbix_class_schema_versions> is created and maintained by the
-module. This contains two fields, 'Version' and 'Installed', which
-contain each VERSION of your Schema, and the date+time it was installed.
+module. This is used to determine which version your database is currently at.
+Similarly the $VERSION in your DBIC schema class is used to determine the
+current DBIC schema version.
-The actual upgrade is called manually by calling C<upgrade> on your
-schema object. Code is run at connect time to determine whether an
-upgrade is needed, if so, a warning "Versions out of sync" is
-produced.
+The upgrade is initiated manually by calling C<upgrade> on your schema object,
+this will attempt to upgrade the database from its current version to the current
+schema version using a diff from your I<upgrade_directory>. If a suitable diff is
+not found then no upgrade is possible.
-So you'll probably want to write a script which generates your DDLs and diffs
-and another which executes the upgrade.
-
NB: At the moment, only SQLite and MySQL are supported. This is due to
spotty behaviour in the SQL::Translator producers, please help us by
-them.
+enhancing them. Ask on the mailing list or IRC channel for details (community details
+in L<DBIx::Class>).
-=head1 METHODS
+=head1 GETTING STARTED
-=head2 upgrade_directory
+Firstly you need to setup your schema class as per the L</SYNOPSIS>, make sure
+you have specified an upgrade_directory and an initial $VERSION.
-Use this to set the directory your upgrade files are stored in.
+Then you'll need two scripts, one to create DDL files and diffs and another to perform
+upgrades. Your creation script might look like a bit like this:
-=head2 backup_directory
+ use strict;
+ use Pod::Usage;
+ use Getopt::Long;
+ use MyApp::Schema;
-Use this to set the directory you want your backups stored in.
+ my ( $preversion, $help );
+ GetOptions(
+ 'p|preversion:s' => \$preversion,
+ ) or die pod2usage;
+ my $schema = MyApp::Schema->connect(
+ $dsn,
+ $user,
+ $password,
+ );
+ my $sql_dir = './sql';
+ my $version = $schema->schema_version();
+ $schema->create_ddl_dir( 'MySQL', $version, $sql_dir, $preversion );
+
+Then your upgrade script might look like so:
+
+ use strict;
+ use MyApp::Schema;
+
+ my $schema = MyApp::Schema->connect(
+ $dsn,
+ $user,
+ $password,
+ );
+
+ if (!$schema->get_db_version()) {
+ # schema is unversioned
+ $schema->deploy();
+ } else {
+ $schema->upgrade();
+ }
+
+The script above assumes that if the database is unversioned then it is empty
+and we can safely deploy the DDL to it. However things are not always so simple.
+
+if you want to initialise a pre-existing database where the DDL is not the same
+as the DDL for your current schema version then you will need a diff which
+converts the database's DDL to the current DDL. The best way to do this is
+to get a dump of the database schema (without data) and save that in your
+SQL directory as version 0.000 (the filename must be as with
+L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL
+script given above from version 0.000 to the current version. Then hand check
+and if necessary edit the resulting diff to ensure that it will apply. Once you have
+done all that you can do this:
+
+ if (!$schema->get_db_version()) {
+ # schema is unversioned
+ $schema->install("0.000");
+ }
+
+ # this will now apply the 0.000 to current version diff
+ $schema->upgrade();
+
+In the case of an unversioned database the above code will create the
+dbix_class_schema_versions table and write version 0.000 to it, then
+upgrade will then apply the diff we talked about creating in the previous paragraph
+and then you're good to go.
+
=cut
package DBIx::Class::Schema::Versioned;
@@ -129,129 +190,78 @@
__PACKAGE__->mk_classdata('do_backup');
__PACKAGE__->mk_classdata('do_diff_on_init');
-=head2 get_db_version
-Returns the version that your database is currently at. This is determined by the values in the
-dbix_class_schema_versions table that $self->upgrade writes to.
+=head1 METHODS
-=cut
+=head2 upgrade_directory
-sub get_db_version
-{
- my ($self, $rs) = @_;
+Use this to set the directory your upgrade files are stored in.
- my $vtable = $self->{vschema}->resultset('Table');
- my $version = 0;
- eval {
- my $stamp = $vtable->get_column('installed')->max;
- $version = $vtable->search({ installed => $stamp })->first->version;
- };
- return $version;
-}
+=head2 backup_directory
-sub _source_exists
-{
- my ($self, $rs) = @_;
+Use this to set the directory you want your backups stored in (note that backups
+are disabled by default).
- my $c = eval {
- $rs->search({ 1, 0 })->count;
- };
- return 0 if $@ || !defined $c;
+=cut
- return 1;
-}
+=head2 install
-=head2 backup
+=over 4
-This is an overwritable method which is called just before the upgrade, to
-allow you to make a backup of the database. Per default this method attempts
-to call C<< $self->storage->backup >>, to run the standard backup on each
-database type.
+=item Arguments: $db_version
-This method should return the name of the backup file, if appropriate..
+=back
-This method is disabled by default. Set $schema->do_backup(1) to enable it.
+Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database version.
+Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
+
+See L</getting_started> for more details.
+
=cut
-sub backup
+sub install
{
- my ($self) = @_;
- ## Make each ::DBI::Foo do this
- $self->storage->backup($self->backup_directory());
-}
+ my ($self, $new_version) = @_;
-# is this just a waste of time? if not then merge with DBI.pm
-sub _create_db_to_schema_diff {
- my $self = shift;
+ # must be called on a fresh database
+ if ($self->get_db_version()) {
+ warn 'Install not possible as versions table already exists in database';
+ }
- my %driver_to_db_map = (
- 'mysql' => 'MySQL'
- );
+ # default to current version if none passed
+ $new_version ||= $self->schema_version();
- my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
- unless ($db) {
- print "Sorry, this is an unsupported DB\n";
- return;
+ if ($new_version) {
+ # create versions table and version row
+ $self->{vschema}->deploy;
+ $self->_set_db_version;
}
+}
- eval 'require SQL::Translator "0.09"';
- if ($@) {
- $self->throw_exception("SQL::Translator 0.09 required");
- }
+=head2 deploy
- my $db_tr = SQL::Translator->new({
- add_drop_table => 1,
- parser => 'DBI',
- parser_args => { dbh => $self->storage->dbh }
- });
+Same as L<DBIx::Class::Schema/deploy> but also calls C<install>.
- $db_tr->producer($db);
- my $dbic_tr = SQL::Translator->new;
- $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
- $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db);
- $dbic_tr->data($self);
- $dbic_tr->producer($db);
+=cut
- $db_tr->schema->name('db_schema');
- $dbic_tr->schema->name('dbic_schema');
-
- # is this really necessary?
- foreach my $tr ($db_tr, $dbic_tr) {
- my $data = $tr->data;
- $tr->parser->($tr, $$data);
- }
-
- my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
- $dbic_tr->schema, $db,
- { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
-
- my $filename = $self->ddl_filename(
- $db,
- $self->schema_version,
- $self->upgrade_directory,
- 'PRE',
- );
- my $file;
- if(!open($file, ">$filename"))
- {
- $self->throw_exception("Can't open $filename for writing ($!)");
- next;
- }
- print $file $diff;
- close($file);
-
- print "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n";
+sub deploy {
+ my $self = shift;
+ $self->next::method(@_);
+ $self->install();
}
=head2 upgrade
Call this to attempt to upgrade your database from the version it is at to the version
-this DBIC schema is at.
+this DBIC schema is at. If they are the same it does nothing.
-It requires an SQL diff file to exist in $schema->upgrade_directory, normally you will
-have created this using $schema->create_ddl_dir.
+It requires an SQL diff file to exist in you I<upgrade_directory>, normally you will
+have created this using L<DBIx::Class::Schema/create_ddl_dir>.
+If successful the dbix_class_schema_versions table is updated with the current
+DBIC schema version.
+
=cut
sub upgrade
@@ -261,12 +271,7 @@
# db unversioned
unless ($db_version) {
- # set version in dbix_class_schema_versions table, can't actually upgrade as we don 't know what version the DB is at
- $self->_create_db_to_schema_diff() if ($self->do_diff_on_init);
-
- # create versions table and version row
- $self->{vschema}->deploy;
- $self->_set_db_version;
+ warn 'Upgrade not possible as database is unversioned. Please call install first.';
return;
}
@@ -303,31 +308,6 @@
$self->_set_db_version;
}
-sub _set_db_version {
- my $self = shift;
-
- my $vtable = $self->{vschema}->resultset('Table');
- $vtable->create({ version => $self->schema_version,
- installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
- });
-
-}
-
-sub _read_sql_file {
- my $self = shift;
- my $file = shift || return;
-
- my $fh;
- open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
- my @data = split(/\n/, join('', <$fh>));
- @data = grep(!/^--/, @data);
- @data = split(/;/, join('', @data));
- close($fh);
- @data = grep { $_ && $_ !~ /^-- / } @data;
- @data = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @data;
- return \@data;
-}
-
=head2 do_upgrade
This is an overwritable method used to run your upgrade. The freeform method
@@ -353,7 +333,7 @@
Runs a set of SQL statements matching a passed in regular expression. The
idea is that this method can be called any number of times from your
-C<upgrade> method, running whichever commands you specify via the
+C<do_upgrade> method, running whichever commands you specify via the
regex in the parameter. Probably won't work unless called from the overridable
do_upgrade method.
@@ -377,6 +357,52 @@
return 1;
}
+=head2 get_db_version
+
+Returns the version that your database is currently at. This is determined by the values in the
+dbix_class_schema_versions table that C<upgrade> and C<install> write to.
+
+=cut
+
+sub get_db_version
+{
+ my ($self, $rs) = @_;
+
+ my $vtable = $self->{vschema}->resultset('Table');
+ my $version = 0;
+ eval {
+ my $stamp = $vtable->get_column('installed')->max;
+ $version = $vtable->search({ installed => $stamp })->first->version;
+ };
+ return $version;
+}
+
+=head2 schema_version
+
+Returns the current schema class' $VERSION
+
+=cut
+
+=head2 backup
+
+This is an overwritable method which is called just before the upgrade, to
+allow you to make a backup of the database. Per default this method attempts
+to call C<< $self->storage->backup >>, to run the standard backup on each
+database type.
+
+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
+{
+ my ($self) = @_;
+ ## Make each ::DBI::Foo do this
+ $self->storage->backup($self->backup_directory());
+}
+
=head2 connection
Overloaded method. This checks the DBIC schema version against the DB version and
@@ -384,7 +410,7 @@
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 or alternatively you can set the ignore_version attr in the forth arg like so:
+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 argument like so:
my $schema = MyApp::Schema->connect(
$dsn,
@@ -441,6 +467,107 @@
", your database contains version $pversion, please call upgrade on your Schema.\n";
}
+# is this just a waste of time? if not then merge with DBI.pm
+sub _create_db_to_schema_diff {
+ my $self = shift;
+
+ my %driver_to_db_map = (
+ 'mysql' => 'MySQL'
+ );
+
+ my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
+ unless ($db) {
+ print "Sorry, this is an unsupported DB\n";
+ return;
+ }
+
+ eval 'require SQL::Translator "0.09"';
+ if ($@) {
+ $self->throw_exception("SQL::Translator 0.09 required");
+ }
+
+ my $db_tr = SQL::Translator->new({
+ add_drop_table => 1,
+ parser => 'DBI',
+ parser_args => { dbh => $self->storage->dbh }
+ });
+
+ $db_tr->producer($db);
+ my $dbic_tr = SQL::Translator->new;
+ $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
+ $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db);
+ $dbic_tr->data($self);
+ $dbic_tr->producer($db);
+
+ $db_tr->schema->name('db_schema');
+ $dbic_tr->schema->name('dbic_schema');
+
+ # is this really necessary?
+ foreach my $tr ($db_tr, $dbic_tr) {
+ my $data = $tr->data;
+ $tr->parser->($tr, $$data);
+ }
+
+ my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
+ $dbic_tr->schema, $db,
+ { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
+
+ my $filename = $self->ddl_filename(
+ $db,
+ $self->schema_version,
+ $self->upgrade_directory,
+ 'PRE',
+ );
+ my $file;
+ if(!open($file, ">$filename"))
+ {
+ $self->throw_exception("Can't open $filename for writing ($!)");
+ next;
+ }
+ print $file $diff;
+ close($file);
+
+ print "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n";
+}
+
+
+sub _set_db_version {
+ my $self = shift;
+
+ my $vtable = $self->{vschema}->resultset('Table');
+ $vtable->create({ version => $self->schema_version,
+ installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
+ });
+
+}
+
+sub _read_sql_file {
+ my $self = shift;
+ my $file = shift || return;
+
+ my $fh;
+ open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
+ my @data = split(/\n/, join('', <$fh>));
+ @data = grep(!/^--/, @data);
+ @data = split(/;/, join('', @data));
+ close($fh);
+ @data = grep { $_ && $_ !~ /^-- / } @data;
+ @data = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @data;
+ return \@data;
+}
+
+sub _source_exists
+{
+ my ($self, $rs) = @_;
+
+ my $c = eval {
+ $rs->search({ 1, 0 })->count;
+ };
+ return 0 if $@ || !defined $c;
+
+ return 1;
+}
+
1;
Modified: DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Schema.pm 2008-07-16 17:13:35 UTC (rev 4583)
+++ DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Schema.pm 2008-07-16 17:35:07 UTC (rev 4584)
@@ -62,29 +62,6 @@
=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
@@ -744,9 +721,10 @@
$self->storage->txn_do(@_);
}
-=head2 txn_scope_guard
+=head2 txn_scope_guard (EXPERIMENTAL)
-Runs C<txn_scope_guard> on the schema's storage.
+Runs C<txn_scope_guard> on the schema's storage. See
+L<DBIx::Class::Storage/txn_scope_guard>.
=cut
@@ -1124,7 +1102,7 @@
$self->storage->create_ddl_dir($self, @_);
}
-=head2 ddl_filename (EXPERIMENTAL)
+=head2 ddl_filename
=over 4
@@ -1201,6 +1179,29 @@
return Storable::dclone($obj);
}
+=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;
+}
+
1;
=head1 AUTHORS
Modified: DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage/DBI.pm 2008-07-16 17:13:35 UTC (rev 4583)
+++ DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage/DBI.pm 2008-07-16 17:35:07 UTC (rev 4584)
@@ -1630,9 +1630,6 @@
my $tr = SQL::Translator->new(%$sqltargs);
SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
-
- return;
-
}
sub deploy {
Modified: DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage.pm
===================================================================
--- DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage.pm 2008-07-16 17:13:35 UTC (rev 4583)
+++ DBIx-Class/0.08/branches/complex_join_rels/lib/DBIx/Class/Storage.pm 2008-07-16 17:35:07 UTC (rev 4584)
@@ -299,10 +299,22 @@
=for comment
-=head2 txn_scope_guard
+=head2 txn_scope_guard (EXPERIMENTAL)
-Return an object that does stuff.
+An alternative way of using transactions to C<txn_do>:
+ my $txn = $storage->txn_scope_guard;
+
+ $row->col1("val1");
+ $row->update;
+
+ $txn->commit;
+
+If a exception occurs, the transaction will be rolled back. This is still very
+experiemental, and we are not 100% sure it is working right when nested. The
+onus is on you as the user to make sure you dont forget to call
+$C<$txn->commit>.
+
=cut
sub txn_scope_guard {
Modified: DBIx-Class/0.08/branches/complex_join_rels/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/complex_join_rels/lib/SQL/Translator/Parser/DBIx/Class.pm 2008-07-16 17:13:35 UTC (rev 4583)
+++ DBIx-Class/0.08/branches/complex_join_rels/lib/SQL/Translator/Parser/DBIx/Class.pm 2008-07-16 17:35:07 UTC (rev 4584)
@@ -69,6 +69,9 @@
foreach my $moniker (sort @monikers)
{
my $source = $dbicschema->source($moniker);
+
+ # Skip custom query sources
+ next if ref($source->name);
# Its possible to have multiple DBIC source using same table
next if $seen_tables{$source->name}++;
Modified: DBIx-Class/0.08/branches/complex_join_rels/t/94versioning.t
===================================================================
--- DBIx-Class/0.08/branches/complex_join_rels/t/94versioning.t 2008-07-16 17:13:35 UTC (rev 4583)
+++ DBIx-Class/0.08/branches/complex_join_rels/t/94versioning.t 2008-07-16 17:35:07 UTC (rev 4584)
@@ -37,7 +37,6 @@
ok(-f 't/var/DBICVersion-Schema-1.0-MySQL.sql', 'Created DDL file');
$schema_orig->deploy({ add_drop_table => 1 });
-$schema_orig->upgrade();
my $tvrs = $schema_orig->{vschema}->resultset('Table');
is($schema_orig->_source_exists($tvrs), 1, 'Created schema from DDL file');
More information about the Bast-commits
mailing list