8 package My::PathStatus;
12 has path => (is => 'ro', required => 1);
13 has info => (is => 'ro', required => 1);
15 package My::PathStatusInfo;
19 has is_directory => (is => 'ro', default => 0);
20 has is_file => (is => 'ro', default => 0);
21 has mode => (is => 'ro', required => 1);
24 @INC{qw(My/PathStatus.pm My/PathStatusInfo.pm)} = (__FILE__,__FILE__);
27 '.ssh' => My::PathStatus->new(
29 info => My::PathStatusInfo->new(is_directory => 1, mode => '0755')
31 '.ssh/authorized_keys' => My::PathStatus->new(
32 path => '.ssh/authorized_keys',
33 info => My::PathStatusInfo->new(is_file => 1, mode => '0644')
39 my $solver = DX::Solver->new(
40 facts => { path_status => DX::SetOver->new(
42 values => \%path_status,
46 $solver->add_rule(@$_) for (
47 [ path_status => [ qw(PS) ],
48 [ member_of => 'PS', [ value => 'path_status' ] ] ],
49 [ path => [ qw(PS P) ],
50 [ constrain => [ qw(PS P) ], sub { $_[0]->path eq $_[1] } ] ],
51 [ mode => [ qw(PS M) ],
52 [ constrain => [ qw(PS M) ],
53 sub { $_[0]->info and $_[0]->info->mode eq $_[1] } ] ],
54 [ is_directory => [ qw(PS) ],
55 [ constrain => [ qw(PS) ],
56 sub { $_[0]->info and $_[0]->info->is_directory } ] ],
57 [ is_file => [ qw(PS) ],
58 [ constrain => [ qw(PS) ],
59 sub { $_[0]->info and $_[0]->info->is_file } ] ],
62 %path_status = %protos;
65 join ' ', map $_->{PS}->path, $solver->query(
66 [ qw(PS) ], [ path_status => 'PS' ], @_
70 is(paths_for(), '.ssh .ssh/authorized_keys');
72 is(paths_for([ is_directory => 'PS' ]), '.ssh');
74 is(paths_for([ is_file => 'PS' ]), '.ssh/authorized_keys');
76 is(paths_for([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
79 path_status_at => [ 'PS', 'P' ],
80 [ path_status => 'PS' ],
84 path_status_at => [ 'PS', 'P' ],
85 [ constrain => [] => sub { die "ARGH" } ]
91 [ path_status_at => 'PS', [ value => '.ssh' ] ]
95 delete $solver->rule_set->rules->{'path_status_at/2'};
98 path_status_at => [ 'PS', 'P' ],
99 [ path_status => 'PS' ],
100 [ path => qw(PS P) ],
104 path_status_at => [ 'PS', 'P' ],
105 [ constrain => [] => sub { die "ARGH" } ]
111 @res = $solver->query(
113 [ path_status_at => 'PS', [ value => '.ssh' ] ]
117 is(join(' ', map $_->{PS}->path, @res), '.ssh');
119 #::Dwarn($solver->query([ qw(PS) ], [ path_status_at => 'PS', [ value => '.ssh' ] ])->results);