lib/DX/Op/Prop.pm

   1 package DX::Op::Prop;
   2
   3 use Moo;
   4
   5 with 'DX::Role::Op';
   6
   7 has of => (is => 'ro', required => 1);
   8 has name => (is => 'ro', required => 1);
   9 has value => (is => 'ro', required => 1);
  10
  11 sub run {
  12   my ($self, $state) = @_;
  13   ($state, my %args) = $self->_expand_args(
  14     $state, map +($_ => $self->$_), qw(of name value)
  15   );
  16   die "property name must be bound" unless $args{name}->is_bound;
  17   my $name = $args{name}->bound_value;
  18   if ($args{of}->is_bound) {
  19     if ($args{value}->is_bound) {
  20       if ($args{of}->bound_value->$name eq $args{value}->bound_value) {
  21         return $state->add_dependencies(
  22                          $args{of}->id => $args{value}->id,
  23                          $args{value}->id => $args{of}->id,
  24                        )
  25                      ->then($self->next);
  26       }
  27       return $state->backtrack;
  28     }
  29     my $value = $args{of}->bound_value;
  30     if ($value->can("has_${name}") and not $value->${\"has_${name}"}) {
  31       return $state->backtrack;
  32     }
  33     return $state->bind_value($args{value}->id, $value->$name)
  34                  ->add_dependencies($args{value}->id => $args{of}->id)
  35                  ->then($self->next);
  36   }
  37   die "Can't yet handle unbound 'of' argument";
  38 }
  39
  40 1;