File Coverage

blib/lib/Geoffrey/Changelog/Database.pm

Criterion	Covered	Total	%
statement	17	116	14.6
branch	0	52	0.0
condition	0	25	0.0
subroutine	6	24	25.0
pod	11	11	100.0
total	34	228	14.9

package Geoffrey::Changelog::Database;

use utf8;
use 5.024;
use strict;
use warnings;
use Geoffrey::Exception::Database;

$Geoffrey::Changelog::Database::VERSION = '0.000202';

use parent 'Geoffrey::Role::Changelog';

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->{needs_converter} = 1;
    $self->{needs_dbh}       = 1;
    $self->{generated_sql}   = [];
    $self = bless $self, $class;
    $self->_prepare_tables if ($self->converter && $self->dbh);
    return $self;
}

sub _action_entry {
    my ($self, $o_action_entry) = @_;
    $self->{action_entry} = $o_action_entry if $o_action_entry;
    require Geoffrey::Action::Entry;
    $self->{action_entry} //= Geoffrey::Action::Entry->new(dbh => $self->dbh, converter => $self->converter);
    return $self->{action_entry};
}

sub _sql_abstract {
    my ($self) = @_;
    require SQL::Abstract;
    $self->{sql_abstract} //= SQL::Abstract->new;
    return $self->{sql_abstract};
}

sub _changlog_entries_table_name {
    $_[0]->{changlog_entries_table} //= 'geoffrey_changlog_entries';
    return $_[0]->{changlog_entries_table};
}

sub _changlog_entries_table {
    my ($self) = @_;
    return [
        {name => 'id',        type => 'integer', primarykey => 1, notnull => 1, default => 'autoincrement',},
        {name => 'action',    type => 'varchar', lenght     => 64,},
        {name => 'name',      type => 'varchar', lenght     => 64,},
        {name => 'template',  type => 'varchar', lenght     => 64,},
        {name => 'type',      type => 'varchar', lenght     => 64,},
        {name => 'plain_sql', type => 'text'},
        {name => 'refcolumn', type => 'varchar', lenght     => 64,},
        {name => 'reftable',  type => 'varchar', lenght     => 64,},
        {name => 'columns',   type => 'varchar', lenght     => 64,},
        {
            name       => 'geoffrey_changelog',
            type       => 'varchar',
            lenght     => 64,
            notnull    => 1,
            foreignkey => {reftable => $self->geoffrey_changelogs, refcolumn => 'id'},
        },
    ];
}

sub _get_changesets {
    my ($self, $hr_params) = @_;
    $self->_prepare_tables;
    my $s_changeset_sql = $self->_sql_abstract->select(
        ($self->schema ? $self->schema . q/./ : q//) . $self->geoffrey_changelogs,
        qw/*/,
        {
            ($hr_params->{changeset_id} ? (id => $hr_params->{changeset_id}) : ()),
            ($hr_params->{not_executed} ? (md5sum => undef) : ()),
        });
    return $self->dbh->selectall_arrayref(
        $s_changeset_sql,
        {Slice => {}},
        ($hr_params->{changeset_id} ? ($hr_params->{changeset_id}) : ())
    ) || Geoffrey::Exception::Database::throw_sql_handle($!, $s_changeset_sql);
}

sub _prepare_tables {
    my ($self) = @_;
    require Geoffrey::Action::Table;
    my $o_action_able = Geoffrey::Action::Table->new(dbh => $self->dbh, converter => $self->converter);
    my $hr_params = $self->converter->get_changelog_table_hashref($self->dbh, $self->schema);
    if ($hr_params) {
        $hr_params->{schema} = $self->schema;
        Geoffrey::Action::Table->new(dbh => $self->dbh, converter => $self->converter)->add($hr_params);
    }

    my $o_statement_handle = $self->dbh->prepare($self->converter->select_get_table);
    if ($self->schema) {
        $o_statement_handle->execute($self->schema, $self->_changlog_entries_table_name) or Carp::confess $!;
    }
    else {
        $o_statement_handle->execute($self->_changlog_entries_table_name) or Carp::confess $!;
    }
    $hr_params = $o_statement_handle->fetchrow_hashref;
    return $hr_params ? undef : $o_action_able->add({
        name    => $self->_changlog_entries_table_name,
        columns => $self->_changlog_entries_table,
        schema  => $self->schema,
    });
}

sub file_extension { return $_[0]->{file_extension}; }

sub _get_changeset_entries {
    my ($self, $hr_unhandeled_changelog) = @_;
    my $s_table_name = ($self->schema ? $self->schema . q/./ : q//) . $self->_changlog_entries_table_name;
    my $s_entries_sql = $self->_sql_abstract->select($s_table_name, qw/*/, {geoffrey_changelog => {'=', '?'}});

    my $ar_entries = $self->dbh->selectall_arrayref($s_entries_sql, {Slice => {}}, ($hr_unhandeled_changelog->{ID}))
        || Geoffrey::Exception::Database::throw_sql_handle($!, $s_entries_sql);
    return $ar_entries;
}

sub load {
    my ($self, $s_changeset_id) = @_;
    my $ar_changesets = $self->_get_changesets($s_changeset_id ? ({changeset_id => $s_changeset_id}) : ());
    $_->{entries} = $self->_get_changeset_entries($_) for @{$ar_changesets};
    require Geoffrey::Utils;
    Geoffrey::Utils::to_lowercase($_) for @{$ar_changesets};
    return ($s_changeset_id && scalar @{$ar_changesets} == 1) ? $ar_changesets->[0] : $ar_changesets;
}


sub load_changeset {
    my ($self, $s_changeset_id) = @_;
    my $ar_changesets = $self->_get_changesets({changeset_id => $s_changeset_id});
    $_->{entries} = $self->_get_changeset_entries($_) for @{$ar_changesets};
    require Geoffrey::Utils;
    Geoffrey::Utils::to_lowercase($_) for @{$ar_changesets};
    return ($s_changeset_id && scalar @{$ar_changesets} == 1) ? $ar_changesets->[0] : $ar_changesets;
}

sub write {
    my ($self, $s_file, $ur_data) = @_;
    return shift->insert(@_);
}

sub delete {
    my ($self, $s_changeset_id) = @_;
    my $ar_changesets = $self->_get_changesets({changeset_id => $s_changeset_id, not_executed => 1});
    return unless scalar @{$ar_changesets};
    my @a_statements = ();
    push @a_statements,
        $self->_action_entry->drop({
            schema     => $self->schema,
            table      => $self->_changlog_entries_table_name,
            conditions => {geoffrey_changelog => $s_changeset_id,}});
    push @a_statements,
        $self->_action_entry->drop(
        {schema => $self->schema, table => $self->geoffrey_changelogs, conditions => {id => $s_changeset_id,}});
    return \@a_statements;
}

sub insert {
    my ($self, $s_file, $ur_data) = @_;
    $self->_prepare_tables;
    require Ref::Util;
    return $self->{generated_sql} if Ref::Util::is_hashref($ur_data);
    for my $hr_changeset (@{$ur_data}) {
        next unless (exists $hr_changeset->{id});
        next unless scalar @{$hr_changeset->{entries}};

        push(
            @{$self->{generated_sql}},
            $self->_action_entry->add({
                    schema => $self->schema,
                    table  => $self->geoffrey_changelogs,
                    values => [{
                            id         => $hr_changeset->{id},
                            filename   => __PACKAGE__ . '::' . __LINE__,
                            created_by => $hr_changeset->{created_by} ? $hr_changeset->{created_by}
                            : $hr_changeset->{author} ? $hr_changeset->{author}
                            : undef,
                            geoffrey_version => $Geoffrey::Changelog::Database::VERSION,
                            ($hr_changeset->{comment} ? (comment => $hr_changeset->{comment}) : ()),
                        }]}));

        for my $hr_entry (@{$hr_changeset->{entries}}) {
            push(
                @{$self->{generated_sql}},
                $self->_action_entry->add({
                        schema => $self->schema,
                        table  => $self->_changlog_entries_table_name,
                        values => [{
                                geoffrey_changelog => $hr_changeset->{id},
                                action             => $hr_entry->{action},
                                name               => $hr_entry->{entry_name},
                                (exists $hr_entry->{as} ? (plain_sql => $hr_entry->{as}) : ()),
                            }]}));
        }
    }
    return $self->{generated_sql};
}

## GETTER / SETTER

sub schema {
    my ($self, $s_schema) = @_;
    $self->{schema} = $s_schema if $s_schema;
    return $self->{schema};
}

sub converter {
    my ($self, $o_converter) = @_;
    $self->{converter} = $o_converter if $o_converter;
    return $self->{converter};
}

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

sub geoffrey_changelogs {
    my ($self, $s_geoffrey_changelogs) = @_;
    $self->{geoffrey_changelogs} = $s_geoffrey_changelogs if $s_geoffrey_changelogs;
    $self->{geoffrey_changelogs} //= 'geoffrey_changelogs';
    return $self->{geoffrey_changelogs};
}

## END GETTER / SETTER

1;    # End of Geoffrey::Changelog

__END__