view release on metacpan or  search on metacpan

lib/HTML/FormHandler/TraitFor/Model/DBIC.pm  view on Meta::CPAN

use Moose::Role;

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

our $VERSION = '0.26';


has 'schema' => ( is => 'rw', );
has 'source_name' => (
    isa     => 'Str',
    is      => 'rw',
    lazy    => 1,
    builder => 'build_source_name'
);

has unique_constraints => (
    is         => 'ro',
    isa        => 'ArrayRef',
    lazy_build => 1,
);

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 { +{} },
);

has 'ru_flags' => (
    is      => 'rw',
    isa     => 'HashRef',
    traits  => ['Hash'],
    builder => '_build_ru_flags',
    handles => { set_ru_flag => 'set', }
);

sub _build_ru_flags {
    { unknown_params_ok => 1 };
}

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

sub clear_model {
    my $self = shift;
    $self->item(undef);
    $self->item_id(undef);
}

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

    warn "HFH: update_model for ", $self->name, "\n" if $self->verbose;

    #warn "fif: " . Dumper ( $self->fif ); use Data::Dumper;
    my %update_params = (
        resultset => $self->resultset,
        updates   => $self->values,
        %{ $self->ru_flags },
    );
    $update_params{object} = $self->item if $self->item;
    my $new_item;

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

# undocumented because this is going to be replaced
# by a better method
sub guess_field_type {
    my ( $self, $column ) = @_;
    my $source = $self->source;
    my @return;

    #  TODO: Should be able to use $source->column_info

    # Is it a direct has_a relationship?
    if (
        $source->has_relationship($column) &&
        ( $source->relationship_info($column)->{attrs}->{accessor} eq 'single' ||
            $source->relationship_info($column)->{attrs}->{accessor} eq 'filter' )
        )
    {
        my $f_class = $source->related_class($column);
        @return =
            $f_class->isa('DateTime') ? ('DateTime') :
                                        ('Select');
    }

    # Else is it has_many?
    elsif ( $source->has_relationship($column) &&
        $source->relationship_info($column)->{attrs}->{accessor} eq 'multi' )
    {
        @return = ('Multiple');
    }
    elsif ( $column =~ /_time$/ )    # ends in time, must be time value
    {
        @return = ('DateTime');
    }