expunge [ value => $value ] style in favour of scalarrefs

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

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

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 => DX::SetOver->new(
      over => sub { $_[0]->{name} }, values => \%servers,
    ),
    shells => DX::SetOver->new(
      over => sub { $_[0]->{name} }, values => \%shells,
    ),
  }
);

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

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

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

$solver->add_rule(
  shell => [ 'S' ] => [ member_of => S => \'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(
       [ shell => 'Shell' ],
       [ name => 'Shell', \'bash' ],
       [ server => 'Srv' ],
       [ shell_installed_on => qw(Shell Srv) ],
     );

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

done_testing;