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 (ref $replace eq 'ARRAY') {
  23                                 if (@$replace and $_ eq $replace->[0]) {
  24                                         shift @$replace;
  25                                 }
  26                                 else {
  27                                         $changes++;
  28                                         next;
  29                                 }
  30                         }
  31                         elsif (defined $replace and $_ eq $replace) {
  32                                 undef $replace;
  33                         }
  34                         else {
  35                                 $changes++;
  36                                 next;
  37                         }
  38                 }
  39                 print {$dest} $_, $/;
  40         }
  41         close $src;
  42         if (defined $replace) {
  43                 for (ref $replace eq 'ARRAY' ? @$replace : $replace) {
  44                         $changes++;
  45                         print {$dest} $_, $/;
  46                 }
  47         }
  48         close $dest;
  49
  50         if ($changes) {
  51                 rename $tmpname, $filename;
  52         }
  53         else {
  54                 unlink $tmpname;
  55         }
  56         return $changes;
  57 }
  58
  59 1;
  60
  61 =head1 NAME
  62
  63 File::Rewrite
  64
  65 =head1 SYNOPSIS
  66
  67         use File::Rewrite 'fileset';
  68         fileset('/tmp/somefile', undef, qr/match/);
  69
  70 =head1 DESCRIPTION
  71
  72 =head1 AUTHOR
  73
  74 Mischa POSLAWSKY <perl@shiar.org>
  75
  76 =head1 LICENSE
  77
  78 Copyright. All rights reserved.
  79