view release on metacpan or  search on metacpan

lib/DBIx/Schema/UpToDate.pm  view on Meta::CPAN

    $version = $v
      if defined $v;
  }

  return $version;
}


sub initialize_version_table {
  my ($self) = @_;
  my $dbh = $self->dbh;

  my ($version, $updated) = $self->quote_identifiers(qw(version updated));

  $self->begin_work();

  $dbh->do('CREATE TABLE ' . $self->quoted_table_name .
    " ($version integer, $updated timestamp)"
  )
    or croak $dbh->errstr;

  $self->set_version(0);

  $self->commit();
}


sub latest_version {
  my ($self) = @_;
  return scalar @{ $self->updates };
}


sub quoted_table_name {
  my ($self) = @_;
  return $self->dbh->quote_identifier($self->version_table_name);
}


sub quote_identifiers {
  my ($self, @names) = @_;
  my $dbh = $self->dbh;
  return map { $dbh->quote_identifier($_) } @names;
}


sub set_version {
  my ($self, $version) = @_;
  my $dbh = $self->dbh;

  $dbh->do('INSERT INTO ' . $self->quoted_table_name .
    ' (' .
      join(', ', $self->quote_identifiers(qw(version updated)))
    . ') VALUES(?, ?)',
    {}, $version, time()
  )
    or croak $dbh->errstr;
}


sub updates {
  my ($self) = @_;
  return $self->{updates} ||= [
  ];
}


sub update_to_version {
  my ($self, $version) = @_;

  $self->begin_work();

  # execute updates to bring database to $version
  $self->updates->[$version - 1]->($self);

  # save the version now in case we get interrupted before the next commit
  $self->set_version($version);

  $self->commit();
}


sub up_to_date {
  my ($self) = @_;

  my $current = $self->current_version;
  if( !defined($current) ){
    $self->initialize_version_table;
    $current = $self->current_version;
    die("Unable to initialize version table\n")
      if !defined($current);
  }

  my $latest = $self->latest_version;

  # execute each update required to go from current to latest version
  # (starting with next version, obviously (don't redo current))
  $self->update_to_version($_)
    foreach ($current + 1) .. $latest;
}


sub version_table_name {
  'schema_version'
}

1;


__END__
=pod

=for :stopwords Randy Stauner TODO dbh cpan testmatrix url annocpan anno bugtracker rt
cpants kwalitee diff irc mailto metadata placeholders

=head1 NAME

DBIx::Schema::UpToDate - Helps keep a database schema up to date

=head1 VERSION

version 1.001

=head1 SYNOPSIS

  package Local::Database;
  use parent 'DBIx::Schema::UpToDate';

  sub updates {
    shift->{updates} ||= [

      # version 1
      sub {
        my ($self) = @_;
        $self->dbh->do('-- sql');
        $self->do_something_else;
      },

      # version 2
      sub {
        my ($self) = @_;
        my $val = Local::Project::NewerClass->value;
        $self->dbh->do('INSERT INTO values (?)', {}, $val);
      },
    ];
  }

  package main;

  my $dbh = DBI->connect(@connection_args);
  Local::Database->new(dbh => $dbh);

  # do something with $dbh which now contains the schema you expect

=head1 DESCRIPTION

This module provides a base class for keeping a database schema up to date.
If you need to make changes to the schema
in remote databases in an automated manner
you may not be able to ensure what version of the database is installed
by the time it gets the update.
This module will apply updates (defined as perl subs (coderefs))
sequentially to bring the database schema
up to the latest version from whatever the current version is.

The aim of this module is to enable you to write incredibly simple subclasses
so that all you have to do is define the updates you want to apply.
This is done with subs (coderefs) so you can access the object
and its database handle.

It is intentionally simple and is not intended for large scale applications.
It may be a good fit for small embedded databases.
It can also be useful if you need to reference other parts of your application
as the subs allow you to utilize the object (and anything else you can reach).

Check L</SEE ALSO> for alternative solutions
and pick the one that's right for your situation.

=head1 USAGE

Subclasses should overwrite L</updates>
to return an arrayref of subs (coderefs) that will be executed
to bring the schema up to date.

Each sub (coderef) will be called as a method
(it will receive the object as its first parameter):

  sub { my ($self) = @_; $self->dbh->do('...'); }