view release on metacpan or  search on metacpan

lib/DBIx/Class/StateMigrations/Migration.pm  view on Meta::CPAN

package DBIx::Class::StateMigrations::Migration;

use strict;
use warnings;

# ABSTRACT: individual migration for a single version bump

use Moo;
use Types::Standard qw(:all);

use Scalar::Util 'blessed';
use Path::Class qw( file dir );
require Data::Dump;
require Module::Locate;
require Module::Runtime;
use Class::Inspector;
use Clone 'clone';
use Try::Tiny;

require DBIx::Class::StateMigrations;

use DBIx::Class::StateMigrations::Migration::Routine::PerlCode;
use DBIx::Class::StateMigrations::Migration::Routine::SQL;
use DBIx::Class::StateMigrations::Migration::Invalid;

our $LOADED_MIGRATION_SUBCLASSES = {};

sub BUILD {
  my $self = shift;
  
  my $name = $self->migration_name;
  
  die "invalid migration_name '$name' - can only contain alpha chars and underscore _" 
    unless($name =~ /^[a-zA-Z0-9\_]+$/);
  
  die "At least one trigger_SchemaState required" unless (
    scalar(@{ $self->trigger_SchemaStates }) > 0
  );
  
  $self->_validate_fingerprints;
}

sub invalid { 0 }

has 'migration_name', is => 'ro', lazy => 1, default => sub {
  my $self = shift;
  $self->_migration_name_from_classname
    ? $self->_migration_name_from_classname
    : join('_', 'sm', map { $_->fingerprint } @{ $self->trigger_SchemaStates })
}, isa => Str;

has 'trigger_SchemaStates', is => 'ro', required => 1, isa => ArrayRef[
  InstanceOf['DBIx::Class::StateMigrations::SchemaState']
];

has 'frozen_trigger_SchemaStates', is => 'ro', lazy => 1, default => sub {
  my $self = shift;
  clone( $self->trigger_SchemaStates )
}, isa => ArrayRef[InstanceOf['DBIx::Class::StateMigrations::SchemaState']];

has 'DBI_Driver_Name', is => 'ro', required => 1, isa => Str;

has 'completed_SchemaState', is => 'ro', isa => Maybe[
  InstanceOf['DBIx::Class::StateMigrations::SchemaState']
], default => sub { undef };

sub number_routines { scalar(@{ (shift)->Routines }) };

has 'Routines', is => 'ro', required => 1, lazy => 1, default => sub {
  my $self = shift;
  return [] unless ($self->is_migration_class && $self->directory);
  my $Dir = dir( $self->directory, 'routines' )->absolute;
  return [] unless (-d $Dir);
  
  my @routines = ();
  
  my @File_list = 
    sort { $a->basename cmp $b->basename }
    grep { ! $_->is_dir && -f $_ }
    $Dir->children;
  
  for my $File (@File_list) {

    if(my $ext = (reverse split(/\./,$File->basename))[0]) {
      if (lc($ext) eq 'pl') {
        push @routines, DBIx::Class::StateMigrations::Migration::Routine::PerlCode->new(
          file_path => $File->absolute->stringify,
          Migration => $self
        );
      }
      elsif (lc($ext) eq 'sql') {
        push @routines, DBIx::Class::StateMigrations::Migration::Routine::SQL->new(
          file_path => $File->absolute->stringify,
          Migration => $self
        );
      }
    }
  }
  
  return \@routines

}, isa => ArrayRef[InstanceOf['DBIx::Class::StateMigrations::Migration::Routine']];


sub routines_executed {
  my ($self, $set) = @_;
  $self->__routines_executed(1) if ($set && ! $self->__routines_executed);
  $self->__routines_executed
}
has '__routines_executed', is => 'rw', init_arg => undef, isa => Bool, default => sub { 0 };

sub execute_routines {