File Coverage

blib/lib/Geoffrey/Changelog/Database.pm

Criterion	Covered	Total	%
statement	17	108	15.7
branch	0	48	0.0
condition	0	22	0.0
subroutine	6	23	26.0
pod	10	10	100.0
total	33	211	15.6

package Geoffrey::Changelog::Database;

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

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

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( { 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__