cleanup, call-as-default
Matt S Trout [Sun, 2 Feb 2014 23:29:51 +0000 (23:29 +0000)]
lib/DX/RuleSet.pm
lib/DX/State.pm
t/basic_rule.t

index 692ac8e..328eb85 100644 (file)
@@ -27,7 +27,10 @@ sub _make_rule {
 
 sub expand {
   my ($self, $type, @rest) = @_;
-  $self->${\"_expand_${type}"}(@rest);
+  if ($self->can(my $expand_meth = "_expand_${type}")) {
+    return $self->$expand_meth(@rest);
+  }
+  return $self->_expand_call($type, @rest);
 }
 
 sub _expand_call {
index 379b41f..6f8a1f5 100644 (file)
@@ -37,7 +37,6 @@ sub assign_vars {
   my %by_id = %{$self->by_id};
   my $state = $self->but(id_gen => { %{$self->id_gen} });
   foreach my $name (keys %vars) {
-warn "assign: ${name}";
     unless (blessed($vars{$name})) {
       my $var = $vars{$name} = $state->allocate_var($name, $vars{$name});
       $by_id{$var->id} = $var;
@@ -51,7 +50,6 @@ warn "assign: ${name}";
 
 sub bind_var_then {
   my ($self, $var, $value, $then) = @_;
-  warn "Binding ".$var->id." to $value";
   my $bound = $var->with_value($value);
   $self->but(
     by_id => { %{$self->by_id}, $var->id => $bound },
@@ -61,7 +59,6 @@ sub bind_var_then {
 
 sub bind_stream_then {
   my ($self, $var, $stream, $then) = @_;
-  warn "Binding ".$var->id." to $stream";
   my $bound = $var->with_stream($stream);
   $self->but(
     by_id => { %{$self->by_id}, $var->id => $bound },
@@ -100,7 +97,6 @@ sub run {
     my ($return) = @_;
     local our $Nonlocal_Return = $return;
     while (my $op = $state->next_op) {
-#::Dwarn($op);
       $state = $op->run($state);
     }
     return $state;
index 01a5e99..6c78c96 100644 (file)
@@ -42,7 +42,7 @@ is_deeply([ map $_->{S}{name}, $s->results ], [ sort @servers ]);
 $solver->add_rule(shell => [ 'S' ] => [ member_of => qw(S shells) ])
        ->add_rule(name => [ qw(T N) ],
                     [ constrain => [ qw(T N) ],
-                      sub { ::Dwarn(\@_); $_[0]->{name} eq $_[1] } ]
+                      sub { $_[0]->{name} eq $_[1] } ]
                  )
        ->add_rule(shell_installed_on => [ qw(Shell Srv) ],
                     [ constrain => [ qw(Shell Srv) ],
@@ -51,12 +51,15 @@ $solver->add_rule(shell => [ 'S' ] => [ member_of => qw(S shells) ])
 
 $s = $solver->query(
        [ qw(Shell Srv) ],
-       [ call => shell => 'Shell' ],
-       [ call => name => 'Shell', [ value => 'bash' ] ],
-       [ call => server => 'Srv' ],
-       [ call => shell_installed_on => qw(Shell Srv) ],
+       [ shell => 'Shell' ],
+       [ name => 'Shell', [ value => 'bash' ] ],
+       [ server => 'Srv' ],
+       [ shell_installed_on => qw(Shell Srv) ],
      );
 
-::Dwarn($s->results);
+is_deeply(
+  [ sort map $_->{Srv}{name}, $s->results ],
+  [ qw(joe.example.com kitty.scsys.co.uk) ]
+);
 
 done_testing;