From: Matt S Trout Date: Fri, 14 Feb 2014 21:49:10 +0000 (+0000) Subject: rewrite file correctly chaining from create file X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e02a5c0a6734a5f605c266c66bd696f7b6cfd65a;p=scpubgit%2FDKit.git rewrite file correctly chaining from create file --- diff --git a/lib/DX/Lib/FS/Action/CreateFile.pm b/lib/DX/Lib/FS/Action/CreateFile.pm index 426b241..c05b3ef 100644 --- a/lib/DX/Lib/FS/Action/CreateFile.pm +++ b/lib/DX/Lib/FS/Action/CreateFile.pm @@ -1,5 +1,6 @@ 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); @@ -11,6 +12,8 @@ has path => (is => 'ro', required => 1); has mode => (is => 'ro', predicate => 1); +has data => (is => 'ro', default => sub { '' }); + sub expected_effect { my ($self) = @_; return +(path_status => PathStatus->new( @@ -19,6 +22,9 @@ sub expected_effect { is_file => 1, mode => ($self->has_mode ? $self->mode : '') ) + ), file_content => FileContent->new( + path => $self->path, + data => $self->data, )); } @@ -35,6 +41,7 @@ sub _do_run { 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)); } diff --git a/lib/DX/Lib/FS/Action/RewriteFile.pm b/lib/DX/Lib/FS/Action/RewriteFile.pm index 0e7548f..64bd66b 100644 --- a/lib/DX/Lib/FS/Action/RewriteFile.pm +++ b/lib/DX/Lib/FS/Action/RewriteFile.pm @@ -1,11 +1,14 @@ 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 { [] }); @@ -32,11 +35,24 @@ sub but_remove { 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; diff --git a/lib/DX/Op/ModifyAction.pm b/lib/DX/Op/ModifyAction.pm index a4975b4..239d98e 100644 --- a/lib/DX/Op/ModifyAction.pm +++ b/lib/DX/Op/ModifyAction.pm @@ -23,9 +23,11 @@ sub run { 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, @@ -33,11 +35,14 @@ sub run { ); 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); diff --git a/lib/DX/Op/ProposeAction.pm b/lib/DX/Op/ProposeAction.pm index 9076fd3..e3d1ed2 100644 --- a/lib/DX/Op/ProposeAction.pm +++ b/lib/DX/Op/ProposeAction.pm @@ -23,10 +23,13 @@ sub run { 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); } diff --git a/lib/DX/State.pm b/lib/DX/State.pm index 95f49f6..b75a39d 100644 --- a/lib/DX/State.pm +++ b/lib/DX/State.pm @@ -3,6 +3,7 @@ package DX::State; 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; @@ -33,6 +34,8 @@ sub scope_var { 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); @@ -206,7 +209,7 @@ sub action_dependencies { 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 {