[Bast-commits] r4574 - in
DBIx-Class/0.08/branches/versioning/lib/DBIx/Class: . Schema Storage
lukes at dev.catalyst.perl.org
lukes at dev.catalyst.perl.org
Mon Jul 14 15:01:50 BST 2008
Author: lukes
Date: 2008-07-14 15:01:50 +0100 (Mon, 14 Jul 2008)
New Revision: 4574
Modified:
DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Storage/DBI.pm
Log:
reordered methods of Versioned.pm and factored the initialisation stuff from upgrade to install
Modified: DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Schema/Versioned.pm 2008-07-14 12:11:13 UTC (rev 4573)
+++ DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Schema/Versioned.pm 2008-07-14 14:01:50 UTC (rev 4574)
@@ -103,6 +103,12 @@
spotty behaviour in the SQL::Translator producers, please help us by
them.
+
+=head1 GETTING STARTED
+
+
+=cut
+
=head1 METHODS
=head2 upgrade_directory
@@ -129,119 +135,39 @@
__PACKAGE__->mk_classdata('do_backup');
__PACKAGE__->mk_classdata('do_diff_on_init');
-=head2 get_db_version
+=head2 install
-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.
+=over 4
-=cut
+=item Arguments: $db_version
-sub get_db_version
-{
- my ($self, $rs) = @_;
+=back
- 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;
-}
+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.
-sub _source_exists
-{
- my ($self, $rs) = @_;
+Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
- my $c = eval {
- $rs->search({ 1, 0 })->count;
- };
- return 0 if $@ || !defined $c;
+See L</getting_started> for more details.
- return 1;
-}
-
-=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
+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;
-
- 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;
+ # must be called on a fresh database
+ if ($self->get_db_version()) {
+ warn 'Install not possible as versions table already exists in database';
}
- eval 'require SQL::Translator "0.09"';
- if ($@) {
- $self->throw_exception("SQL::Translator 0.09 required");
- }
+ # default to current version if none passed
+ $new_version ||= $self->schema_version();
- 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);
+ unless ($new_version) {
+ # create versions table and version row
+ $self->{vschema}->deploy;
+ $self->_set_db_version;
}
-
- 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";
}
=head2 upgrade
@@ -261,12 +187,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 +224,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
@@ -377,6 +273,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 $self->upgrade writes 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
@@ -441,6 +383,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/versioning/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Schema.pm 2008-07-14 12:11:13 UTC (rev 4573)
+++ DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Schema.pm 2008-07-14 14:01:50 UTC (rev 4574)
@@ -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
@@ -1201,6 +1178,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/versioning/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Storage/DBI.pm 2008-07-14 12:11:13 UTC (rev 4573)
+++ DBIx-Class/0.08/branches/versioning/lib/DBIx/Class/Storage/DBI.pm 2008-07-14 14:01:50 UTC (rev 4574)
@@ -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 {
More information about the Bast-commits
mailing list