package DX::Lib::FS::Action::CreateFile;
+use aliased 'DX::Lib::FS::Fact::FileContent';
use aliased 'DX::Lib::FS::Fact::PathStatus';
use aliased 'DX::Lib::FS::Fact::PathStatusInfo';
use Fcntl qw(O_CREAT O_WRONLY);
has mode => (is => 'ro', predicate => 1);
+has data => (is => 'ro', default => sub { '' });
+
sub expected_effect {
my ($self) = @_;
return +(path_status => PathStatus->new(
is_file => 1,
mode => ($self->has_mode ? $self->mode : '')
)
+ ), file_content => FileContent->new(
+ path => $self->path,
+ data => $self->data,
));
}
sysopen($fh, $self->path, O_CREAT | O_WRONLY)
or die "Couldn't create ${\$self->path}: $!";
}
+ print $fh $self->data if length($self->data);
+(path_status => PathStatus->new(path => $self->path));
}
package DX::Lib::FS::Action::RewriteFile;
use DX::Lib::FS::Fact::FileContent;
+use File::stat;
+use File::Copy;
+use Fcntl qw(O_CREAT O_WRONLY);
use Moo;
with 'DX::Role::Action';
-has from => (is => 'ro', required => 1);
+has from => (is => 'ro', required => 1, handles => [ 'path' ]);
has add_lines => (is => 'ro', default => sub { [] });
sub expected_effect {
my ($self) = @_;
+(file_content => DX::Lib::FS::Fact::FileContent->new(
- path => $self->from->path,
+ path => $self->path,
data => $self->final_content
));
}
-sub _do_run { die }
+sub _do_run {
+ my ($self) = @_;
+ my $stat = stat($self->path) or die "Couldn't stat ${\$self->path}: $!";
+ my $perms = $stat->mode & 07777;
+ my $new = $self->path.'.new';
+ unlink($new);
+ sysopen my $fh, $new, O_CREAT | O_WRONLY, $perms
+ or die "Couldn't open ${new}: $!";
+ print $fh $self->final_content
+ or die "Couldn't write data to ${new}: $!";
+ close $fh;
+ move($new, $self->path) or die "Couldn't install ${new}: $!";
+ return +(file_content => $self->from);
+}
1;
die "Subject not a fact" unless $subject_fact->$_does('DX::Role::Fact');
die "Subject has no action" unless $subject_fact->has_required_action;
my $orig_action = $state->actions->{$subject_fact->required_action};
- my @deps = $state->action_dependencies(
+ my @deps = (
@{$orig_action->dependencies},
- map $_->id, @vars
+ $state->action_dependencies(
+ map $_->id, @vars
+ ),
);
my @builder_args = (
$orig_action,
);
my $action = $self->builder->(@builder_args)
->but(dependencies => \@deps);
- my ($fact_type, $value) = $action->expected_effect;
- my $final_value = $value->but(required_action => $action->id);
- my $fact_set = $state->facts->{$fact_type}->with_value($final_value);
+ my @effect = $action->expected_effect;
+ my %facts = %{$state->facts};
+ while (my ($fact_type, $value) = splice(@effect, 0, 2)) {
+ my $final_value = $value->but(required_action => $action->id);
+ $facts{$fact_type} = $facts{$fact_type}->with_value($final_value);
+ }
$state->but(
- facts => { %{$state->facts}, $fact_type => $fact_set },
+ facts => \%facts,
actions => { %{$state->actions}, $action->id => $action },
)
->then($self->next);
my $action = $self->builder->(map $state->resolve_value($_), @vars)
->but(dependencies => \@deps);
my ($rec_state, $action_id) = $state->record_action($action);
- my ($fact_type, $value) = $action->expected_effect;
- my $final_value = $value->but(required_action => $action_id);
- my $fact_set = $state->facts->{$fact_type}->with_value($final_value);
- $rec_state->but(facts => { %{$state->facts}, $fact_type => $fact_set })
+ my @effect = $action->expected_effect;
+ my %facts = %{$state->facts};
+ while (my ($fact_type, $value) = splice(@effect, 0, 2)) {
+ my $final_value = $value->but(required_action => $action_id);
+ $facts{$fact_type} = $facts{$fact_type}->with_value($final_value);
+ }
+ $rec_state->but(facts => \%facts)
->then($self->next);
}
use Return::MultiLevel qw(with_return);
use DX::Op::Backtrack;
use Scalar::Util qw(blessed);
+use List::MoreUtils qw(uniq);
use Safe::Isa;
use Moo;
sub resolve_value {
my ($self, $var) = @_;
+die("FUCK") unless $var;
+ die "Can't resolve unbound ${\$var->id}" unless $var->is_bound;
my $val = $var->bound_value;
if ($val->$_does('DX::Role::Ref')) {
return $val->resolve($self);
and $value->has_required_action;
push @queue, grep !$seen{$_}, keys %{$deps->{$id}};
}
- return map $_->required_action, @found;
+ return uniq map $_->required_action, @found;
}
sub copy_vars {