lib/DX/Op/Prop.pm

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