File Coverage

blib/lib/Data/Generator/FromDDL/Builder.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	3	4	75.0
condition			n/a
subroutine	13	13	100.0
pod	0	5	0.0
total	67	73	91.7

package Data::Generator::FromDDL::Builder;
use strict;
use warnings;
use Carp qw(croak);
use Class::Data::Inheritable;
use Data::Generator::FromDDL::RecordSet;
use Data::Generator::FromDDL::Util qw(need_quote_data_type);
use Class::Accessor::Lite (
    new => 1,
    rw => [qw(table recordsets)],
);

use base qw(Exporter Class::Data::Inheritable);
our @EXPORT = qw(datatype);

__PACKAGE__->mk_classdata('dispatch_table', {});


sub generate {
    my ($self, $n) = @_;
    my $table = $self->table;
    my $recordset = Data::Generator::FromDDL::RecordSet->new($table, $n);
    for my $field ($table->get_fields) {
        my @values = $self->generate_field_values($field, $n);
        $recordset->set_column_values($field, \@values);
    }
    return $recordset;
}

sub generate_field_values {
    my ($self, $field, $n) = @_;
    my $data_type = lc($field->data_type);

    my @values = $self->dispatch($data_type, $field, $n);

    if (need_quote_data_type($data_type)) {
        @values = map { q{'} . $_ . q{'} } @values;
    }
    return @values;
}

sub dispatch {
    my ($self, $data_type, $field, $n) = @_;
    my $class = ref $self;
    my $code = $class->dispatch_table->{$data_type};
    croak "Unsupported data type: $data_type \n"
        unless $code;

    return $code->($self, $field, $n, $self->recordsets);
}

sub redispatch {
    my ($self, $new_data_type, $field, $n) = @_;
    return $self->dispatch($new_data_type, $field, $n);
}

## DSL
sub datatype($&) {
    my ($data_types, $code) = @_;
    my ($class) = caller;

    # update dispatch table
    my $dispatch_table = $class->dispatch_table;
    for my $data_type (split /,\s*/, $data_types) {
        $dispatch_table->{$data_type} = $code;
    }
    $class->dispatch_table($dispatch_table);
}

1;