File Coverage

blib/lib/Geoffrey/Changelog/Database.pm

Criterion	Covered	Total	%
statement	20	93	21.5
branch	0	40	0.0
condition	0	13	0.0
subroutine	7	21	33.3
pod	10	10	100.0
total	37	177	20.9

package Geoffrey::Changelog::Database;

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

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

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

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->{needs_converter} = 1;
    $self->{needs_dbh}       = 1;
    $self->{sql_abstract}    = SQL::Abstract->new;
    $self->{generated_sql}   = [];
    return bless $self, $class;
}

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 _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 tpl_main { }
sub tpl_sub  { }

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, $i_changeset_id) = @_;
    $self->_prepare_tables;
    my $s_changelog_name = ($self->schema ? $self->schema . q/./ : q//) . $self->geoffrey_changelogs;
    my $hr_changeset_sql_params = $i_changeset_id ? {id => $i_changeset_id} : {};
    my $s_changeset_sql = $self->{sql_abstract}->select($s_changelog_name, qw/*/, $hr_changeset_sql_params);
    my $ar_changesets
        = $self->dbh->selectall_arrayref($s_changeset_sql, {Slice => {}}, ($i_changeset_id ? ($i_changeset_id) : ()))
        || Geoffrey::Exception::Database::throw_sql_handle($!, $s_changeset_sql);
    $_->{entries} = $self->_get_changeset_entries($_) for @{$ar_changesets};
    require Geoffrey::Utils;
    Geoffrey::Utils::to_lowercase($_) for @{$ar_changesets};
    return ($i_changeset_id && scalar @{$ar_changesets} == 1) ? $ar_changesets->[0] : $ar_changesets;
}

sub write {
    my ($self, $s_file, $ur_data) = @_;
    require Ref::Util;
    return $self->{generated_sql} if Ref::Util::is_hashref($ur_data);
    $self->_prepare_tables;
    require Geoffrey::Action::Entry;
    my $o_action_entry = Geoffrey::Action::Entry->new(dbh => $self->dbh, converter => $self->converter);

    for my $hr_changeset (@{$ur_data}) {
        next unless (exists $hr_changeset->{id});
        next unless scalar @{$hr_changeset->{entries}};

        push(
            @{$self->{generated_sql}},
            $o_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}},
                $o_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};
}

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};
}

1;    # End of Geoffrey::Changelog

__END__