lib/File/Rewrite.pm

   1 package File::Rewrite;
   2
   3 use strict;
   4 use warnings;
   5
   6 use autodie ':all';
   7 use Exporter 'import';
   8
   9 our @EXPORT_OK = qw(fileset);
  10
  11 sub fileset {
  12         my ($filename, $replace, $search) = @_;
  13         $search = $replace if not defined $search;
  14         my $tmpname = "$filename.$$.tmp";
  15         my $changes = 0;
  16
  17         open my $src,  '<', $filename;
  18         open my $dest, '>', $tmpname;
  19         while (readline $src) {
  20                 chomp;
  21                 if ($_ =~ (ref $search ? $search : qr/^\Q$search\E$/)) {
  22                         if (defined $replace and $_ eq $replace) {
  23                                 undef $replace;
  24                         }
  25                         else {
  26                                 $changes++;
  27                                 next;
  28                         }
  29                 }
  30                 print {$dest} $_, $/;
  31         }
  32         close $src;
  33         if (defined $replace) {
  34                 $changes++;
  35                 print {$dest} $replace, $/;
  36         }
  37         close $dest;
  38
  39         if ($changes) {
  40                 rename $tmpname, $filename;
  41         }
  42         else {
  43                 unlink $tmpname;
  44         }
  45         return $changes;
  46 }
  47
  48 1;
  49
  50 =head1 NAME
  51
  52 File::Rewrite
  53
  54 =head1 SYNOPSIS
  55
  56         use File::Rewrite 'fileset';
  57         fileset('/tmp/somefile', undef, qr/match/);
  58
  59 =head1 DESCRIPTION
  60
  61 =head1 AUTHOR
  62
  63 Mischa POSLAWSKY <perl@shiar.org>
  64
  65 =head1 LICENSE
  66
  67 Copyright. All rights reserved.
  68