reordered methods of Versioned.pm and factored the initialisation stuff from upgrade...
Luke Saunders [Mon, 14 Jul 2008 14:01:50 +0000 (14:01 +0000)]
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Schema/Versioned.pm
lib/DBIx/Class/Storage/DBI.pm

index 21f055b..ce2a026 100644 (file)
@@ -62,29 +62,6 @@ particular which module inherits off which.
 
 =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 @@ sub dclone {
   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
index 1b864cc..3777ea5 100644 (file)
@@ -103,6 +103,12 @@ 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.
 
+
+=head1 GETTING STARTED
+
+
+=cut
+
 =head1 METHODS
 
 =head2 upgrade_directory
@@ -129,119 +135,39 @@ __PACKAGE__->mk_classdata('backup_directory');
 __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.
+=head2 install
 
-=cut
+=over 4
 
-sub get_db_version
-{
-    my ($self, $rs) = @_;
+=item Arguments: $db_version
 
-    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;
-}
-
-sub _source_exists
-{
-    my ($self, $rs) = @_;
-
-    my $c = eval {
-        $rs->search({ 1, 0 })->count;
-    };
-    return 0 if $@ || !defined $c;
-
-    return 1;
-}
-
-=head2 backup
+=back
 
-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. 
+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.
 
-This method should return the name of the backup file, if appropriate..
+Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
 
-This method is disabled by default. Set $schema->do_backup(1) to enable it.
+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;
-
-  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");
-  }
-
-  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');
+  # default to current version if none passed
+  $new_version ||= $self->schema_version();
 
-  # 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 @@ sub upgrade
 
   # 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 @@ sub upgrade
   $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 @@ sub run_upgrade
     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 @@ sub _on_connect
     ", 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;
 
 
index 9cfb860..efd6cd2 100644 (file)
@@ -1630,9 +1630,6 @@ sub deployment_statements {
   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 {