factor out arg handling

[scpubgit/DKit.git] / t / basic_rule.t

use strictures 1;
use Test::More;
use DX::Solver;

my @servers = qw(
  kitty.scsys.co.uk
  jim.example.com
  joe.example.com
  pryde.scsys.co.uk
  bob.example.com
);

my %servers = map +($_ => { name => $_ }), @servers;

my @shells = qw(csh bash);

my %shells = (
  bash => { name => 'bash',
            installed_on => {
              map +($_ => 1),
                qw(joe.example.com kitty.scsys.co.uk)
            },
          },
  csh => { name => 'csh',
           installed_on => {
             map +($_ => 1),
               qw(jim.example.com joe.example.com bob.example.com)
            },
          },
);

my $solver = DX::Solver->new(
  facts => { servers => \%servers, shells => \%shells }
);

$solver->add_rule(
  server => [ 'S' ] => [ member_of => S => [ value => 'servers' ] ]
);

my $s = $solver->query([ 'S' ], [ call => server => 'S' ]);

is_deeply([ map $_->{S}{name}, $s->results ], [ sort @servers ]);

$solver->add_rule(
  shell => [ 'S' ] => [ member_of => S => [ value => 'shells' ] ])
       ->add_rule(name => [ qw(T N) ],
                    [ constrain => [ qw(T N) ],
                      sub { $_[0]->{name} eq $_[1] } ]
                 )
       ->add_rule(shell_installed_on => [ qw(Shell Srv) ],
                    [ constrain => [ qw(Shell Srv) ],
                      sub { $_[0]->{installed_on}{$_[1]->{name}} } ]
                 );

$s = $solver->query(
       [ qw(Shell Srv) ],
       [ shell => 'Shell' ],
       [ name => 'Shell', [ value => 'bash' ] ],
       [ server => 'Srv' ],
       [ shell_installed_on => qw(Shell Srv) ],
     );

is_deeply(
  [ sort map $_->{Srv}{name}, $s->results ],
  [ qw(joe.example.com kitty.scsys.co.uk) ]
);

done_testing;