view release on metacpan or  search on metacpan

lib/Data/MuForm/Role/Model/DBIC.pm  view on Meta::CPAN

package Data::MuForm::Role::Model::DBIC;

# ABSTRACT: model role that interfaces with DBIx::Class

use Moo::Role;

use Carp;
use DBIx::Class::ResultClass::HashRefInflator;
use DBIx::Class::ResultSet::RecursiveUpdate;
use Scalar::Util ('blessed');
use Types::Standard -types;

has 'schema' => ( is => 'rw', );

has unique_constraints => (
    is         => 'ro',
    isa        => ArrayRef,
    lazy       => 1,
    builder => '_build_unique_constraints',
);

sub _build_unique_constraints {
    my $self = shift;
    return [ grep { $_ ne 'primary' }
            $self->resultset->result_source->unique_constraint_names ];
}

has unique_messages => (
    is      => 'ro',
    isa     => HashRef,
    default => sub { +{} },
);

sub use_model_for_defaults {
    my $self = shift;
    return ( $self->model && $self->model->in_storage ? 1 : 0 );
}

sub validate_model {
    my ($self) = @_;
    return unless $self->validate_unique;
    return 1;
}

sub clear_model {
    my $self = shift;
    $self->model(undef);
    $self->model_id(undef);
}

sub update_model {
    my $self   = shift;
    my $model   = $self->model;
    my $source = $self->source;

    my %update_params = (
        resultset => $self->resultset,
        updates   => $self->values,
        unknown_params_ok => 1,
    );
    $update_params{object} = $self->model if $self->model;
    my $new_model;

    # perform update in a transaction, since RecursiveUpdate may do multiple
    # updates if there are compound or multiple fields
    $self->schema->txn_do(
        sub {
            $new_model = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update(
                %update_params);
            $new_model->discard_changes;
        }
    );
    $self->model($new_model) if $new_model;
    return $self->model;
}


sub lookup_options {
    my ( $self, $field, $accessor_path ) = @_;

    return unless $self->schema;
    my $self_source = $self->get_source($accessor_path);

    my $accessor = $field->accessor;

    # if this field doesn't refer to a foreign key, return
    my $f_class;
    my $source;

    # belongs_to single select
    if ( $self_source->has_relationship($accessor) ) {
        $f_class = $self_source->related_class($accessor);
        $source  = $self->schema->source($f_class);
    }
    else {

        # check for many_to_many multiple select
        my $resultset = $self_source->resultset;
        my $new_result = $resultset->new_result( {} );
        if ( $new_result && $new_result->can("add_to_$accessor") ) {
            $source = $new_result->$accessor->result_source;
        }
    }
    return unless $source;

    my $label_column = $field->label_column;
    return
        unless ( $source->has_column($label_column) ||
        $source->result_class->can($label_column) );

    my $active_col = $field->active_column;