From: Mischa POSLAWSKY <perl@shiar.org>
Date: Thu, 19 Nov 2009 17:34:37 +0000 (+0100)
Subject: File::Rewrite::fileset to strip matching lines
X-Git-Tag: v1.00~9
X-Git-Url: http://git.shiar.net/perl/file-rewrite.git/commitdiff_plain/612e12475adbffa874c33d7e1db2955cf5fd41b5

File::Rewrite::fileset to strip matching lines
---

612e12475adbffa874c33d7e1db2955cf5fd41b5
diff --git a/lib/File/Rewrite.pm b/lib/File/Rewrite.pm
new file mode 100644
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
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');
+