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) },
69 return_stack => [ @{$state->return_stack}, $ret_op ],
71 )->assign_vars(%vars);
76 my ($predicate, @arg_spec) = @_;
77 die "didn't invent or yet" unless @$predicate == 1;
78 my ($option) = @$predicate;
80 my ($self, $state) = @_;
81 my $scope = $state->scope;
82 my $ret_op = FromCode->new(
83 code => sub { $_[1]->but(scope => $scope, next_op => $_[0]->next) },
87 my ($type, $val) = @$_;
89 $state->scope_var($val);
90 } elsif ($type eq 'value') {
91 $state->allocate_var('v', { bound_value => $val });
98 return_stack => [ @{$state->return_stack}, $ret_op ],
99 next_op => FromCode->new(
100 code => sub { $option->(@_, @args) },
108 my ($vars, $op) = @_;
116 )->assign_vars(map +($_ => {}), @$vars);
119 $names{path_status} = [
120 make_set_bind($path_status)
123 $names{path_exists} = [ make_test(
124 sub { $_[0]->{is_directory} || $_[0]->{is_file} }
127 $names{is_directory} = [
128 make_test(sub { $_[0]->bound_value->{is_directory} }),
131 # make_not(make_call($names{path_exists}, [ var => 'D' ])),
133 # sub { +{ action => 'mkdir', path => $_[0]->{path}, is_directory => 1, perms => unknown() } },
139 $names{dot_ssh} = [ make_exists(
141 make_call($names{path_status}, [ var => 'D' ], [ value => 't/scratch/.ssh' ]),
142 make_call($names{is_directory}, [ var => 'D' ])
145 my $state = make_state([], FromCode->new(code => $names{dot_ssh}[0]));
147 is($state->run, undef, 'Failure with no path status');
149 $path_status->{'t/scratch/.ssh'} = { is_directory => 0 };
151 is($state->run, undef, 'Failure with non-directory');
153 $path_status->{'t/scratch/.ssh'} = { is_directory => 1 };
155 isa_ok($state->run, 'DX::State', 'Success with directory');