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         die if defined $replace;
  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                 if ($_ =~ (ref $search ? $search : qr/^\Q$search\E$/)) {
  21                                 $changes++;
  22                                 next;
  23                 }
  24                 print {$dest} $_, $/;
  25         }
  26         close $src;
  27         close $dest;
  28
  29         if ($changes) {
  30                 rename $tmpname, $filename;
  31         }
  32         else {
  33                 unlink $tmpname;
  34         }
  35         return $changes;
  36 }
  37
  38 1;
  39
  40 =head1 NAME
  41
  42 File::Rewrite
  43
  44 =head1 SYNOPSIS
  45
  46         use File::Rewrite 'fileset';
  47         fileset('/tmp/somefile', undef, qr/match/);
  48
  49 =head1 DESCRIPTION
  50
  51 =head1 AUTHOR
  52
  53 Mischa POSLAWSKY <perl@shiar.org>
  54
  55 =head1 LICENSE
  56
  57 Copyright. All rights reserved.
  58