lib/File/Rewrite.pm

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