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