From: Matt S Trout Date: Sat, 22 Feb 2014 05:48:50 +0000 (+0000) Subject: eliminate variable name requirement from query() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d384ecaab6d7440b19924dd45040a01345b4392;p=scpubgit%2FDKit.git eliminate variable name requirement from query() --- diff --git a/bin/dx-shell b/bin/dx-shell index 6848ed6..1865982 100644 --- a/bin/dx-shell +++ b/bin/dx-shell @@ -47,8 +47,8 @@ sub expand_body { } $tcl->CreateCommand(query => sub { - my (undef, undef, undef, $vars, $body) = @_; - @last_q = expand_def($vars, $body); + my (undef, undef, undef, $body) = @_; + @last_q = expand_body($body); do_query(); return; }); @@ -92,12 +92,6 @@ foreach my $rule (keys %{$solver->rule_set->rules}) { $tcl->CreateCommand($rule => $rule_sub); } -$tcl->CreateCommand(exists => sub { - my (undef, undef, undef, $vars, $body) = @_; - push our @Body_Parts, [ exists => expand_def($vars, $body) ]; - return; -}); - $tcl->CreateCommand(foreach => sub { my (undef, undef, undef, $var, $body, $each_body) = @_; push our @Body_Parts, [ diff --git a/lib/DX/Op/FindAll.pm b/lib/DX/Op/FindAll.pm index f8770fb..ff22ce4 100644 --- a/lib/DX/Op/FindAll.pm +++ b/lib/DX/Op/FindAll.pm @@ -17,7 +17,7 @@ sub make_result_handler { DX::Op::FromCode->new( code => sub { my ($self, $state) = @_; - $state->bind_value($state->scope->{$coll_name} => $coll) + $state->assign_vars($coll_name => { bound_value => $coll }) ->then($self->next); }, next => $self->next diff --git a/lib/DX/Op/Materialize.pm b/lib/DX/Op/Materialize.pm index ee17e55..b9814fd 100644 --- a/lib/DX/Op/Materialize.pm +++ b/lib/DX/Op/Materialize.pm @@ -4,15 +4,13 @@ use Moo; with 'DX::Role::Op'; -has var_name => (is => 'ro', required => 1); - sub run { my ($self, $state) = @_; - my $var = $state->scope_var($self->var_name); - unless ($var->is_bound) { - die "Can't materialize unbound ".$self->var_name; + foreach my $k (keys %{$state->scope}) { + my $var = $state->scope_var($k); + next unless $var->is_bound; + $state->resolve_value($var); } - $state->resolve_value($var); $state->then($self->next); } diff --git a/lib/DX/Result.pm b/lib/DX/Result.pm index d409b55..3740cc7 100644 --- a/lib/DX/Result.pm +++ b/lib/DX/Result.pm @@ -6,7 +6,8 @@ use Moo; has _state => (is => 'ro', required => 1, init_arg => 'state'); sub var_names { - sort keys %{$_[0]->_state->scope}; + grep $_[0]->_state->scope_var($_)->is_bound, + sort keys %{$_[0]->_state->scope}; } sub actions { diff --git a/lib/DX/RuleSet.pm b/lib/DX/RuleSet.pm index 9449f92..f0ee6ed 100644 --- a/lib/DX/RuleSet.pm +++ b/lib/DX/RuleSet.pm @@ -139,8 +139,8 @@ sub _expand_op_react { } sub _expand_op_materialize { - my ($self, $var_name) = @_; - DX::Op::Materialize->new(var_name => $var_name); + my ($self) = @_; + DX::Op::Materialize->new; } sub _expand_op_prop { diff --git a/lib/DX/Solver.pm b/lib/DX/Solver.pm index 6626840..6300b23 100644 --- a/lib/DX/Solver.pm +++ b/lib/DX/Solver.pm @@ -19,10 +19,9 @@ has facts => (is => 'ro', default => sub { {} }); has observation_policy => (is => 'ro'); sub query { - my ($self, $vars, @terms) = @_; + my ($self, @terms) = @_; my $rule_set = $self->rule_set; - push @terms, map +[ materialize => $_ ], @$vars; - my $head = $rule_set->expand_and_link(undef, @terms); + my $head = $rule_set->expand_and_link(undef, @terms, [ 'materialize' ]); my $state = DX::State->new( next_op => $head, return_stack => [], @@ -31,7 +30,7 @@ sub query { last_choice => [], facts => $self->facts, rule_set => $rule_set, - )->assign_vars(map +($_ => {}), @$vars); + ); return DX::ResultStream->new( for_state => $state, ($self->observation_policy diff --git a/t/basic_rule.t b/t/basic_rule.t index 95d2666..1922d7e 100644 --- a/t/basic_rule.t +++ b/t/basic_rule.t @@ -45,7 +45,7 @@ $solver->add_rule( server => [ 'S' ] => [ member_of => S => [ value => 'servers' ] ] ); -my $s = $solver->query([ 'S' ], [ server => 'S' ]); +my $s = $solver->query([ server => 'S' ]); is_deeply([ map $_->value_for('S')->{name}, $s->results ], [ sort @servers ]); @@ -61,7 +61,6 @@ $solver->add_rule( ); $s = $solver->query( - [ qw(Shell Srv) ], [ shell => 'Shell' ], [ name => 'Shell', [ value => 'bash' ] ], [ server => 'Srv' ], diff --git a/t/dot_ssh.t b/t/dot_ssh.t index 9619022..aac7c71 100644 --- a/t/dot_ssh.t +++ b/t/dot_ssh.t @@ -83,7 +83,7 @@ $solver->add_rule(@$_) for ( sub paths_for_simple { join ' ', map $_->value_for('PS')->path, $solver->query( - [ qw(PS) ], [ path_status => 'PS' ], @_ + [ path_status => 'PS' ], @_ )->results; } @@ -107,8 +107,7 @@ $solver->add_rule( throws_ok { $solver->query( - [ qw(PS) ], - [ path_status_at => 'PS', [ value => '.ssh' ] ] + [ path_status_at => 'PS', [ value => '.ssh' ] ] )->results } qr/ARGH/; @@ -129,8 +128,7 @@ my @res; lives_ok { @res = $solver->query( - [ qw(PS) ], - [ path_status_at => 'PS', [ value => '.ssh' ] ] + [ path_status_at => 'PS', [ value => '.ssh' ] ] )->results }; @@ -166,7 +164,7 @@ $solver->add_rule( $ob_res{'.ssh'} = $protos{'.ssh'}; sub paths_for { - join ' ', map $_->value_for('PS')->path, $solver->query([ 'PS' ], @_)->results; + join ' ', map $_->value_for('PS')->path, $solver->query(@_)->results; } is( @@ -219,7 +217,7 @@ $ob_res{'.ssh'} = $empty{'.ssh'}; $solver->{observation_policy} = sub { 1 }; sub dot_ssh_query { - $solver->query([ 'PS' ], [ directory_at => 'PS' => [ value => '.ssh' ] ]); + $solver->query([ directory_at => 'PS' => [ value => '.ssh' ] ]); } is_deeply( @@ -315,7 +313,7 @@ $solver->add_rule(@$_) for ( %ob_res = %empty; sub keys_file { - $solver->query([ qw(D F) ], + $solver->query( [ directory_at => 'D' => \'.ssh' ], [ file_in => 'D' => \'authorized_keys' => 'F' ], ); diff --git a/t/findall.t b/t/findall.t index df84bfe..47fee23 100644 --- a/t/findall.t +++ b/t/findall.t @@ -28,15 +28,13 @@ $solver->facts->{shell_installed} = DX::OrderedSet->new( ); $solver->add_rule(has_shell => [ 'Srv', 'Shell' ], - [ exists => [ qw(Name SI) ] => - [ member_of => 'SI', \'shell_installed' ], - [ prop => 'SI' => \'server' => 'Name' ], - [ prop => 'Srv' => \'name' => 'Name' ], - [ prop => 'SI' => \'shell' => 'Shell' ] - ], + [ member_of => 'SI', \'shell_installed' ], + [ prop => 'SI' => \'server' => 'Name' ], + [ prop => 'Srv' => \'name' => 'Name' ], + [ prop => 'SI' => \'shell' => 'Shell' ] ); -my @r = $solver->query([ 'X' ], +my @r = $solver->query( [ findall => X => S => [ member_of => 'S', \'server' ], [ has_shell => 'S', \'bash' ], @@ -48,7 +46,7 @@ is_deeply( [ qw(one three four) ] ); -@r = $solver->query([], +@r = $solver->query( [ foreach => S => [ [ member_of => 'S', \'server' ] ], [ [ has_shell => 'S' => \'bash' ] ] ] )->results; @@ -58,7 +56,7 @@ ok(!@r, 'No results for only bash'); $solver->add_rule(has_any_shell => [ 'S' ] => [ has_shell => 'S' => \'bash' ]); $solver->add_rule(has_any_shell => [ 'S' ] => [ has_shell => 'S' => \'csh' ]); -@r = $solver->query([], +@r = $solver->query( [ foreach => S => [ [ member_of => 'S', \'server' ] ], [ [ has_any_shell => 'S' ] ] ] )->results;