view release on metacpan or  search on metacpan

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

    my $column = $field->name;

    $item ||= $self->item;
    return if $field->writeonly;
    return
        unless $item &&
            ( $item->can($column) ||
                ( ref $item eq 'HASH' && exists $item->{$column} ) );
    my @values;
    if ( ref $item eq 'HASH' ) {
        @values = $item->{$column} if ref($item) eq 'HASH';
    }
    elsif ( !$item->isa('Class::DBI') ) {
        @values = $item->$column;
    }
    else {
        @values =
            map { ref $_ && $_->isa('Class::DBI') ? $_->id : $_ } $item->$column;
    }

    my $value = @values > 1 ? \@values : shift @values;
    $field->init_value($value);
    $field->value($value);
}


sub validate_model {
    my ($self) = @_;

    return unless $self->validate_unique;
    return 1;
}


sub validate_unique {
    my ($self) = @_;

    my @unique = map { $_->name } grep { $_->unique } $self->fields;
    return 1 unless @unique;

    my $item = $self->item;

    my $class = ref($item) || $self->item_class;
    my $found_error = 0;
    for my $field ( map { $self->field($_) } @unique ) {
        next if $field->errors;
        my $value = $field->value;
        next unless defined $value;
        my $name = $field->name;
        # unique means there can only be on in the database like it.
        my $match = $class->search( { $name => $value } )->first || next;
        next if $self->items_same( $item, $match );
        my $field_error = $field->unique_message ||
            'Value must be unique in the database';
        $field->add_error($field_error);
        $found_error++;
    }
    return $found_error;
}

sub update_model {
    my ($self) = @_;

    # Grab either the item or the object class.
    my $item = $self->item;
    my $class = ref($item) || $self->item_class;
    my $updated_or_created;

    # get a hash of all fields
    my %fields = map { $_->name, $_ } grep { !$_->noupdate } $self->fields;
    # First process the normal and has_a columns
    # as that data is directly stored in the object
    my %data;
    # Loads columns (including has_a)
    foreach my $col ( $class->columns('All') ) {
        next unless exists $fields{$col};
        my $field = delete $fields{$col};
        # If the field is flagged "clear" then set to NULL.
        my $value = $field->value;
        if ($item) {
            my $cur = $item->$col;
            next unless $value || $cur;
            next if $value && $cur && $value eq $cur;
            $item->$col($value);
        }
        else {
            $data{$col} = $value;
        }
    }

    if ($item) {
        $item->update;
        $updated_or_created = 'updated';
    }
    else {
        $item = $class->create( \%data );
        $self->item($item);
        $updated_or_created = 'created';
    }

    # Now check for mapping/has_many in any left over fields

    for my $field_name ( keys %fields ) {
        next unless $class->meta_info('has_many');
        next unless my $meta = $class->meta_info('has_many')->{$field_name};

        my $field = delete $fields{$field_name};
        my $value = $field->value;

        # Figure out which values to keep and which to add
        my %keep;
        %keep = map { $_ => 1 } ref $value ? @$value : ($value)
            if defined $value;

        # Get foreign class and its key that points to $class
        my $foreign_class = $meta->foreign_class;
        my $foreign_key   = $meta->args->{foreign_key};
        my $related_key   = $meta->args->{mapping}->[0];
        die "Failed to find related_key for field [$field] in class [$class]"
            unless $related_key;