t/basic_rule.t

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