lib/Reaction/InterfaceModel/Action/DBIC/ResultSet/Create.pm

   1 package Reaction::InterfaceModel::Action::DBIC::ResultSet::Create;
   2
   3 use Reaction::Types::DBIC;
   4 use Reaction::Class;
   5 use Reaction::InterfaceModel::Action;
   6 use Reaction::InterfaceModel::Action::DBIC::Role::CheckUniques;
   7
   8 class Create is 'Reaction::InterfaceModel::Action', which {
   9
  10   does 'Reaction::InterfaceModel::Action::DBIC::Role::CheckUniques';
  11
  12   has '+target_model' => (isa => 'DBIx::Class::ResultSet');
  13
  14   implements do_apply => as {
  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) {
  20       my $tm_attr = $new->meta->find_attribute_by_name($name);
  21       unless ($tm_attr) {
  22         warn "Unable to find attr for ${name}";
  23         next;
  24       }
  25       my $tm_writer = $tm_attr->get_write_method;
  26       unless ($tm_writer) {
  27         warn "Unable to find writer for ${name}";
  28         next;
  29       }
  30       if ($tm_attr->type_constraint->name eq 'ArrayRef'
  31           || $tm_attr->type_constraint->is_subtype_of('ArrayRef')) {
  32         push(@delay, [ $tm_writer, $args->{$name} ]);
  33       } else {
  34         $new->$tm_writer($args->{$name});
  35       }
  36     }
  37     $new->insert;
  38     foreach my $d (@delay) {
  39       my ($meth, $val) = @$d;
  40       $new->$meth($val);
  41     }
  42     return $new;
  43   };
  44
  45 };
  46
  47 1;
  48
  49 =head1 NAME
  50
  51 Reaction::InterfaceModel::Action::DBIC::ResultSet::Create
  52
  53 =head1 DESCRIPTION
  54
  55 =head2 target_model
  56
  57 =head2 error_for_attribute
  58
  59 =head2 sync_all
  60
  61 =head1 AUTHORS
  62
  63 See L<Reaction::Class> for authors.
  64
  65 =head1 LICENSE
  66
  67 See L<Reaction::Class> for the license.
  68
  69 =cut