Commit | Line | Data |
b40e416a |
1 | use strictures 1; |
2 | use Test::More; |
3 | use DX::Solver; |
c2e9a3a3 |
4 | use DX::SetOver; |
b40e416a |
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( |
c2e9a3a3 |
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 | } |
b40e416a |
42 | ); |
43 | |
385fa954 |
44 | $solver->add_rule( |
45 | server => [ 'S' ] => [ member_of => S => [ value => 'servers' ] ] |
46 | ); |
b40e416a |
47 | |
71217e42 |
48 | my $s = $solver->query([ 'S' ], [ server => 'S' ]); |
b40e416a |
49 | |
deec7cc4 |
50 | is_deeply([ map $_->value_for('S')->{name}, $s->results ], [ sort @servers ]); |
b40e416a |
51 | |
385fa954 |
52 | $solver->add_rule( |
53 | shell => [ 'S' ] => [ member_of => S => [ value => 'shells' ] ]) |
b40e416a |
54 | ->add_rule(name => [ qw(T N) ], |
55 | [ constrain => [ qw(T N) ], |
6d533c9d |
56 | sub { $_[0]->{name} eq $_[1] } ] |
b40e416a |
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) ], |
6d533c9d |
65 | [ shell => 'Shell' ], |
66 | [ name => 'Shell', [ value => 'bash' ] ], |
67 | [ server => 'Srv' ], |
68 | [ shell_installed_on => qw(Shell Srv) ], |
b40e416a |
69 | ); |
70 | |
6d533c9d |
71 | is_deeply( |
deec7cc4 |
72 | [ sort map $_->value_for('Srv')->{name}, $s->results ], |
6d533c9d |
73 | [ qw(joe.example.com kitty.scsys.co.uk) ] |
74 | ); |
b40e416a |
75 | |
76 | done_testing; |