that warning is just idiotic
[catagits/Reaction.git] / lib / Reaction / InterfaceModel / Action / DBIC / ResultSet / Create.pm
CommitLineData
7adfd53f 1package Reaction::InterfaceModel::Action::DBIC::ResultSet::Create;
2
e739c9a2 3use Reaction::Types::DBIC 'ResultSet';
7adfd53f 4use Reaction::Class;
5use Reaction::InterfaceModel::Action;
6use Reaction::InterfaceModel::Action::DBIC::Role::CheckUniques;
7
81393881 8use namespace::clean -except => [ qw(meta) ];
9extends 'Reaction::InterfaceModel::Action';
10
11with 'Reaction::InterfaceModel::Action::DBIC::Role::CheckUniques';
12
13has '+target_model' => (isa => ResultSet);
14sub do_apply {
15 my $self = shift;
16 my $args = $self->parameter_hashref;
17 my $new = $self->target_model->new({});
18 my @delay;
19 foreach my $name (keys %$args) {
d98c38f8 20 my $tm_attr = $new->meta->find_attribute_by_name($name) or next;
81393881 21 my $tm_writer = $tm_attr->get_write_method;
22 unless ($tm_writer) {
23 warn "Unable to find writer for ${name}";
24 next;
7adfd53f 25 }
81393881 26 if ($tm_attr->type_constraint->name eq 'ArrayRef'
27 || $tm_attr->type_constraint->is_subtype_of('ArrayRef')) {
28 push(@delay, [ $tm_writer, $args->{$name} ]);
29 } else {
30 $new->$tm_writer($args->{$name});
31 }
32 }
33 $new->insert;
34 foreach my $d (@delay) {
35 my ($meth, $val) = @$d;
36 $new->$meth($val);
37 }
38 return $new;
7adfd53f 39};
40
81393881 41__PACKAGE__->meta->make_immutable;
42
43
7adfd53f 441;
45
46=head1 NAME
47
48Reaction::InterfaceModel::Action::DBIC::ResultSet::Create
49
50=head1 DESCRIPTION
51
52=head2 target_model
53
54=head2 error_for_attribute
55
56=head2 sync_all
57
58=head1 AUTHORS
59
60See L<Reaction::Class> for authors.
61
62=head1 LICENSE
63
64See L<Reaction::Class> for the license.
65
66=cut