lib/DX/Lib/FS/Action/RewriteFile.pm

   1 package DX::Lib::FS::Action::RewriteFile;
   2
   3 use DX::Lib::FS::Fact::FileContent;
   4 use File::stat;
   5 use File::Copy;
   6 use Fcntl qw(O_CREAT O_WRONLY);
   7 use Moo;
   8
   9 with 'DX::Role::Action';
  10
  11 has from => (is => 'ro', required => 1, handles => [ 'path' ]);
  12
  13 has add_lines => (is => 'ro', default => sub { [] });
  14
  15 has remove_lines => (is => 'ro', default => sub { {} });
  16
  17 has final_content => (is => 'lazy', init_arg => undef, builder => sub {
  18   my ($self) = @_;
  19   my %remove = %{$self->remove_lines};
  20   join("\n",
  21     (grep !$remove{$_}, $self->from->lines->all),
  22     @{$self->add_lines},
  23     ''
  24   );
  25 });
  26
  27 sub but_add {
  28   $_[0]->but(add_lines => [ @{$_[0]->add_lines}, $_[1] ]);
  29 }
  30
  31 sub but_remove {
  32   $_[0]->but(remove_lines => [ %{$_[0]->remove_lines}, $_[1] => 1 ]);
  33 }
  34
  35 sub expected_effect {
  36   my ($self) = @_;
  37   +(file_content => DX::Lib::FS::Fact::FileContent->new(
  38     path => $self->path,
  39     data => $self->final_content
  40   ));
  41 }
  42
  43 sub _do_run {
  44   my ($self) = @_;
  45   my $stat = stat($self->path) or die "Couldn't stat ${\$self->path}: $!";
  46   my $perms = $stat->mode & 07777;
  47   my $new = $self->path.'.new';
  48   unlink($new);
  49   sysopen my $fh, $new, O_CREAT | O_WRONLY, $perms
  50     or die "Couldn't open ${new}: $!";
  51   print $fh $self->final_content
  52     or die "Couldn't write data to ${new}: $!";
  53   close $fh;
  54   move($new, $self->path) or die "Couldn't install ${new}: $!";
  55   return +(file_content => $self->from);
  56 }
  57
  58 1;