File Coverage

blib/lib/DBIx/Migration/Directories/Base.pm

Criterion	Covered	Total	%
statement	65	74	87.8
branch	13	22	59.0
condition	7	10	70.0
subroutine	17	18	94.4
pod	8	13	61.5
total	110	137	80.2

#!perl

package DBIx::Migration::Directories::Base;

use strict;
use warnings;
use Carp qw(croak);
use DBIx::Migration::Directories::Database;

our $number = qr{[0-9]+(?:\.[0-9]+)?};

return 1;

sub new {
  my($class, %args) = @_;
  ($class, %args) = ($class->set_preinit_defaults(%args));
  if(ref($class)) {
    $class = ref($class);
  }
  if(my $self = $class->driver_new(%args)) {
    $self->set_postinit_defaults();
    return $self;
  } else {
    return;
  }
}

sub set_preinit_defaults {
  return(@_);
}

sub set_postinit_defaults {
  my $self = shift;
  my $db = DBIx::Migration::Directories::Database->new(dbh => $self->{dbh});
  $self->{db} = $db;
  return $self;
}

sub db {
  my $self = shift;
  return $self->{db};
}

sub driver_new {
  my($class, %args) = @_;
  my $self = bless \%args, $class;
  return $self;
}

sub read_file {
    my($self, $file) = @_;
    if(open(my $fh, '<', $file)) {
        my $data = join('', <$fh>);
        close($fh);
        return $data;
    } else {
        croak qq{open("$file") failed: $!};
    }
}

sub direction {
    my($self, $from, $to) = @_;
    return $to <=> $from;
}

sub version_as_number {
    my($self, $version) = @_;
    return ($version || 0) + 0;
}

sub versions {
    my($self, $string) = @_;
    if($string =~ m{^($number)$}) {
        return($self->version_as_number(0), $self->version_as_number($1));
    } elsif($string =~ m{^($number)-($number)$}) {
        return($self->version_as_number($1), $self->version_as_number($2));
    } else {
        return;
    }
}

sub run_sql {
    my($self, @sql) = @_;
    my $dbh = $self->{dbh};

    return $dbh->transaction(sub {
        my $marker = '';
        my $good = 1;
        my $qn = 0;

        while($good && (my $query = shift(@sql))) {
            if(ref($query)) {
                $marker = $$query;
                $qn = 0;
            } else {
                $qn++;
                eval { $good = $dbh->do($query); };

                if($@) {
                    die "[$marker#$qn]$@";
                } elsif(!$good) {
                    $dbh->set_err(undef, '');
                    $dbh->set_err(
                        $dbh->err,
                        join('', "[$marker#$qn] ", $dbh->errstr || ''),
                        $dbh->state
                    );
                }
            }
        }

        return $good;
    });
}

sub require_schema {
    my($self, $schema, $version) = @_;
    my $schemas = $self->schemas;
    die qq{Schema "$schema" not installed!\n}
        unless($schemas->{$schema});
    if($version) {
        die qq{Schema "$schema" is version $schemas->{$schema}{version}, we want $version.\n}
            unless($schemas->{$schema}{version} == $version);
    }
    return 1;
}

sub schemas {
  my $self = shift;
  return $self->db->db_schemas;
}

sub schema_version_log {
  my $self = shift;
  my $myschema = shift || $self->{schema} ||
    croak "schema_version_log() called without a schema name";
  return $self->db->db_schema_version_log($myschema);
}


__END__