File::Rewrite::fileset to strip matching lines

diff --git a/lib/File/Rewrite.pm b/lib/File/Rewrite.pm
new file mode 100644 (file)
index 0000000..bb41513
--- /dev/null
+++ b/lib/File/Rewrite.pm
@@ -0,0 +1,58 @@
+package File::Rewrite;
+
+use strict;
+use warnings;
+
+use autodie ':all';
+use Exporter 'import';
+
+our @EXPORT_OK = qw(fileset);
+
+sub fileset {
+       my ($filename, $replace, $search) = @_;
+       die if defined $replace;
+       my $tmpname = "$filename.$$.tmp";
+       my $changes = 0;
+
+       open my $src,  '<', $filename;
+       open my $dest, '>', $tmpname;
+       while (readline $src) {
+               if ($_ =~ (ref $search ? $search : qr/^\Q$search\E$/)) {
+                               $changes++;
+                               next;
+               }
+               print {$dest} $_, $/;
+       }
+       close $src;
+       close $dest;
+
+       if ($changes) {
+               rename $tmpname, $filename;
+       }
+       else {
+               unlink $tmpname;
+       }
+       return $changes;
+}
+
+1;
+
+=head1 NAME
+
+File::Rewrite
+
+=head1 SYNOPSIS
+
+       use File::Rewrite 'fileset';
+       fileset('/tmp/somefile', undef, qr/match/);
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+Copyright. All rights reserved.
+

diff --git a/t/10-fileset.t b/t/10-fileset.t
new file mode 100644 (file)
index 0000000..ceb9ad5
--- /dev/null
+++ b/t/10-fileset.t
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Test::NoWarnings;
+
+use autodie;
+use File::Temp qw(tempdir);
+use File::Path qw(remove_tree);
+
+BEGIN { use_ok('File::Rewrite', 'fileset'); }
+
+my $target = tempdir();
+
+sub testfileset {
+       my ($name, $input, $params, $result) = @_;
+
+       my $filename = "$target/$name";
+       open my $file, '>', $filename;
+       print {$file} $input;
+       close $file;
+
+       is(fileset($filename, @$params), $result, $name)
+               or diag(explain $input);
+}
+
+my $BASICBODY = "replace$/noremove$/remove$/.$/";
+
+testfileset('no match',      $BASICBODY,    [undef, 'nomatch'], 0);
+testfileset('remove string', $BASICBODY,    [undef, 'remove'],  1);
+testfileset('remove empty',  "$/.$/ $/$/",  [undef, ''],        2);
+testfileset('remove regex',  $BASICBODY,    [undef, qr/^re/],   2);
+testfileset('remove all',    $BASICBODY,    [undef, qr/./],     4);
+
+is(remove_tree($target), 6, 'no unexpected files');
+