4 use List::Util qw(reduce);
5 use aliased 'DX::Op::FromCode';
10 [ssh-key-installed [keyline]
12 [directory-at d [string t/scratch/.ssh]]
13 [directory-perms d [string 0755]]]
15 [file-at f [string t/scratch/.ssh/authorized_keys]]
16 [file-perms f [string 0644]]
17 [file-contains-line f keyline]]
28 my ($self, $state, $thing, $key) = @_;
29 die "key unbound" unless $key->is_bound;
30 die "thing bound" if $thing->is_bound;
31 if (my $value = $set->{$key->bound_value}) {
32 return $state->bind_var_then($thing, $value, $self->next);
34 return $state->backtrack;
41 my ($self, $state, @args) = @_;
43 return $state->then($self->next);
45 return $state->backtrack;
49 my $pop_ret = FromCode->new(code => sub { $_[1]->pop_return_stack });
53 reduce { FromCode->new(next => $a, code => $b) } $pop_ret, reverse @to_link;
57 my ($var_names, @body) = @_;
58 my %vars = map +($_ => {}), @$var_names;
59 my $inner_op = link_ops(@body);
61 my ($self, $state) = @_;
62 my $scope = $state->scope;
63 my $ret_op = FromCode->new(
64 code => sub { $_[1]->but(scope => $scope, next_op => $_[0]->next) },
67 $state->but(scope => { %$scope })
68 ->push_return_then($ret_op, $inner_op)
74 my ($predicate, @arg_spec) = @_;
75 die "didn't invent or yet" unless @$predicate == 1;
76 my ($option) = @$predicate;
78 my ($self, $state) = @_;
79 my $scope = $state->scope;
80 my $ret_op = FromCode->new(
81 code => sub { $_[1]->but(scope => $scope, next_op => $_[0]->next) },
85 my ($type, $val) = @$_;
87 $state->scope_var($val);
88 } elsif ($type eq 'value') {
89 $state->allocate_var('v', { bound_value => $val });
94 my $next_op = FromCode->new(
95 code => sub { $option->(@_, @args) },
98 $state->but(scope => {})
99 ->push_return_then($ret_op, $next_op);
104 my ($vars, $op) = @_;
112 )->assign_vars(map +($_ => {}), @$vars);
115 $names{path_status} = [
116 make_set_bind($path_status)
119 $names{path_exists} = [ make_test(
120 sub { $_[0]->{is_directory} || $_[0]->{is_file} }
123 $names{is_directory} = [
124 make_test(sub { $_[0]->bound_value->{is_directory} }),
127 # make_not(make_call($names{path_exists}, [ var => 'D' ])),
129 # sub { +{ action => 'mkdir', path => $_[0]->{path}, is_directory => 1, perms => unknown() } },
135 $names{dot_ssh} = [ make_exists(
137 make_call($names{path_status}, [ var => 'D' ], [ value => 't/scratch/.ssh' ]),
138 make_call($names{is_directory}, [ var => 'D' ])
141 my $state = make_state([], FromCode->new(code => $names{dot_ssh}[0]));
143 is($state->run, undef, 'Failure with no path status');
145 $path_status->{'t/scratch/.ssh'} = { is_directory => 0 };
147 is($state->run, undef, 'Failure with non-directory');
149 $path_status->{'t/scratch/.ssh'} = { is_directory => 1 };
151 isa_ok($state->run, 'DX::State', 'Success with directory');