File Coverage

blib/lib/Geoffrey.pm

Criterion	Covered	Total	%
statement	54	55	98.1
branch	4	8	50.0
condition	3	6	50.0
subroutine	17	17	100.0
pod	9	9	100.0
total	87	95	91.5

package Geoffrey;

use utf8;
use 5.016;
use strict;
use warnings;
use Readonly;
use Geoffrey::Action::Table;

$Geoffrey::VERSION = '0.000204';

use parent 'Geoffrey::Role::Core';

Readonly::Scalar my $IDX_DATABASE_DRIVER => 18;    #ok

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    bless $self, $class;
    $self->converter->check_version($self->dbh->get_info($IDX_DATABASE_DRIVER));
    $self->_prepare_tables;
    return $self;
}

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

    my $o_action_table = Geoffrey::Action::Table->new(dbh => $self->dbh, converter => $self->converter);

    my $hr_changelog_table = $self->converter->get_changelog_table_hashref($self->dbh, $self->schema);
    $o_action_table->add($hr_changelog_table) if $hr_changelog_table;
    return $hr_changelog_table;
}

sub reader {
    my $self = shift;
    require Geoffrey::Read;
    $self->{reader} //= Geoffrey::Read->new(
        converter => $self->converter,
        dbh       => $self->dbh,
        io_name   => $self->io_name,
        schema    => $self->schema,
    );
    return $self->{reader};
}

sub writer {
    my $self = shift;
    require Geoffrey::Write;
    $self->{writer} //= Geoffrey::Write->new(
        converter => $self->converter,
        dbh       => $self->dbh,
        io_name   => $self->io_name,
        schema    => $self->schema,
    );
    return $self->{writer};
}

sub read {
    my ($self, $s_changelog_root) = @_;
    return $self->reader->run($s_changelog_root);
}

sub write {
    my ($self, $s_changelog_root, $s_schema, $dump) = @_;
    return $self->writer->run($s_changelog_root, $s_schema, $dump);
}

sub delete {
    my ($self, $s_changeset_id) = @_;
    return $self->changelog_io->delete($s_changeset_id);
}

sub insert {
    my ($self, $s_file, $hr_changeset) = @_;
    return $self->changelog_io->insert($s_file, $hr_changeset);
}

sub rewrite {
    my ($self, $hr_changeset) = @_;
    return unless $hr_changeset->{id};
    return $self->delete($hr_changeset->{id}) ? $self->insert(q//, [$hr_changeset]) : 0;
}

sub load_changeset {
    my ($self, $s_changeset_id, $s_file) = @_;
    if (!$s_changeset_id) {
        require Geoffrey::Exception::RequiredValue;
        Geoffrey::Exception::RequiredValue::throw_id();
    }

    return $self->changelog_io->load_changeset($s_changeset_id, $s_file);
}

1;

__END__