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         my $tmpname = "$filename.$$.tmp";
  14         my $changes = 0;
  15
  16         $search = $replace if not defined $search;
  17
  18         # generate a single regex to emulate smart match
  19         $search = [$search] unless ref $search eq 'ARRAY';
  20         $search = join('|', map { ref $_ ? $_ : "^\Q$_\E\$" } @$search);
  21
  22         open my $src,  '<', $filename;
  23         open my $dest, '>', $tmpname;
  24         while (readline $src) {
  25                 chomp;
  26                 if ($_ =~ /$search/s) {
  27                         if (ref $replace eq 'ARRAY') {
  28                                 if (@$replace and $_ eq $replace->[0]) {
  29                                         shift @$replace;
  30                                 }
  31                                 else {
  32                                         $changes++;
  33                                         next;
  34                                 }
  35                         }
  36                         elsif (defined $replace and $_ eq $replace) {
  37                                 undef $replace;
  38                         }
  39                         else {
  40                                 $changes++;
  41                                 next;
  42                         }
  43                 }
  44                 print {$dest} $_, $/;
  45         }
  46         close $src;
  47         if (defined $replace) {
  48                 for (ref $replace eq 'ARRAY' ? @$replace : $replace) {
  49                         $changes++;
  50                         print {$dest} $_, $/;
  51                 }
  52         }
  53         close $dest;
  54
  55         if ($changes) {
  56                 rename $tmpname, $filename;
  57         }
  58         else {
  59                 unlink $tmpname;
  60         }
  61         return $changes;
  62 }
  63
  64 1;
  65
  66 =head1 NAME
  67
  68 File::Rewrite
  69
  70 =head1 SYNOPSIS
  71
  72         use File::Rewrite 'fileset';
  73         fileset('/tmp/somefile', undef, qr/match/);
  74
  75 =head1 DESCRIPTION
  76
  77 =head1 AUTHOR
  78
  79 Mischa POSLAWSKY <perl@shiar.org>
  80
  81 =head1 LICENSE
  82
  83 Copyright. All rights reserved.
  84