t/basic_rule.t

   1 use strictures 1;
   2 use Test::More;
   3 use DX::Solver;
   4
   5 my @servers = qw(
   6   kitty.scsys.co.uk
   7   jim.example.com
   8   joe.example.com
   9   pryde.scsys.co.uk
  10   bob.example.com
  11 );
  12
  13 my %servers = map +($_ => { name => $_ }), @servers;
  14
  15 my @shells = qw(csh bash);
  16
  17 my %shells = (
  18   bash => { name => 'bash',
  19             installed_on => {
  20               map +($_ => 1),
  21                 qw(joe.example.com kitty.scsys.co.uk)
  22             },
  23           },
  24   csh => { name => 'csh',
  25            installed_on => {
  26              map +($_ => 1),
  27                qw(jim.example.com joe.example.com bob.example.com)
  28             },
  29           },
  30 );
  31
  32 my $solver = DX::Solver->new(
  33   facts => { servers => \%servers, shells => \%shells }
  34 );
  35
  36 $solver->add_rule(
  37   server => [ 'S' ] => [ member_of => S => [ value => 'servers' ] ]
  38 );
  39
  40 my $s = $solver->query([ 'S' ], [ call => server => 'S' ]);
  41
  42 is_deeply([ map $_->{S}{name}, $s->results ], [ sort @servers ]);
  43
  44 $solver->add_rule(
  45   shell => [ 'S' ] => [ member_of => S => [ value => 'shells' ] ])
  46        ->add_rule(name => [ qw(T N) ],
  47                     [ constrain => [ qw(T N) ],
  48                       sub { $_[0]->{name} eq $_[1] } ]
  49                  )
  50        ->add_rule(shell_installed_on => [ qw(Shell Srv) ],
  51                     [ constrain => [ qw(Shell Srv) ],
  52                       sub { $_[0]->{installed_on}{$_[1]->{name}} } ]
  53                  );
  54
  55 $s = $solver->query(
  56        [ qw(Shell Srv) ],
  57        [ shell => 'Shell' ],
  58        [ name => 'Shell', [ value => 'bash' ] ],
  59        [ server => 'Srv' ],
  60        [ shell_installed_on => qw(Shell Srv) ],
  61      );
  62
  63 is_deeply(
  64   [ sort map $_->{Srv}{name}, $s->results ],
  65   [ qw(joe.example.com kitty.scsys.co.uk) ]
  66 );
  67
  68 done_testing;