File Coverage

blib/lib/DBIx/Schema/UpToDate.pm

Criterion	Covered	Total	%
statement	71	72	98.6
branch	19	22	86.3
condition	2	2	100.0
subroutine	19	19	100.0
pod	12	12	100.0
total	123	127	96.8

# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
#
# This file is part of DBIx-Schema-UpToDate
#
# This software is copyright (c) 2011 by Randy Stauner.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;

package DBIx::Schema::UpToDate;
BEGIN {
  $DBIx::Schema::UpToDate::VERSION = '1.001';
}
BEGIN {
  $DBIx::Schema::UpToDate::AUTHORITY = 'cpan:RWSTAUNER';
}
# ABSTRACT: Helps keep a database schema up to date

use Carp qw(croak carp); # core


sub new {
  my $class = shift;
  my $self = {
    auto_update => 1,
    sql_limit    => 1,
    transactions => 1,
    @_ == 1 ? %{$_[0]} : @_
  };
  bless $self, $class;

  # make sure the database schema is current
  $self->up_to_date()
    if $self->{auto_update};

  return $self;
}


foreach my $action ( qw(begin_work commit) ){
  no strict 'refs'; ## no critic (NoStrict)
  *$action = sub {
    my ($self) = @_;
    if( $self->{transactions} ){
      my $dbh = $self->dbh;
      $dbh->$action()
        or croak $dbh->errstr;
    }
  }
}



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


sub current_version {
  my ($self) = @_;
  my $dbh = $self->dbh;
  my $table = $self->version_table_name;
  my $version;

  my $tables = $dbh->table_info('%', '%', $table, 'TABLE')
    ->fetchall_arrayref;

  # if table exists query it for current database version
  if( @$tables ){
    my $qtable = $self->quoted_table_name;
    my $field = $dbh->quote_identifier('version');

    my $v = $dbh->selectcol_arrayref(
      "SELECT $field from $qtable ORDER BY $field DESC"
      . ($self->{sql_limit} ? ' LIMIT 1' : '')
    )->[0];
    $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__