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(server => [ 'S' ] => [ member_of => qw(S servers) ]);
  37
  38 my $s = $solver->query([ 'S' ], [ call => server => 'S' ]);
  39
  40 is_deeply([ map $_->{S}{name}, $s->results ], [ sort @servers ]);
  41
  42 $solver->add_rule(shell => [ 'S' ] => [ member_of => qw(S shells) ])
  43        ->add_rule(name => [ qw(T N) ],
  44                     [ constrain => [ qw(T N) ],
  45                       sub { ::Dwarn(\@_); $_[0]->{name} eq $_[1] } ]
  46                  )
  47        ->add_rule(shell_installed_on => [ qw(Shell Srv) ],
  48                     [ constrain => [ qw(Shell Srv) ],
  49                       sub { $_[0]->{installed_on}{$_[1]->{name}} } ]
  50                  );
  51
  52 $s = $solver->query(
  53        [ qw(Shell Srv) ],
  54        [ call => shell => 'Shell' ],
  55        [ call => name => 'Shell', [ value => 'bash' ] ],
  56        [ call => server => 'Srv' ],
  57        [ call => shell_installed_on => qw(Shell Srv) ],
  58      );
  59
  60 ::Dwarn($s->results);
  61
  62 done_testing;