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