#!/usr/bin/perl
# License: Public Domain or CC0
# See https://creativecommons.org/publicdomain/zero/1.0/
# The author, Jim Avera (jim.avera at gmail) has waived all copyright and 
# related or neighboring rights.  Attribution is requested but is not required.
use strict; use warnings; use v5.016; use feature qw(say state);
use utf8;
use open IO => ':encoding(UTF-8)', ':std';

=pod

=head1 NAME

perledit - safely edit files in-place using Perl

=head1 SYNOPSIS

  perledit -e 's/\brepugnancy\b/frobnicate/g' *.pm

  perledit --init '$/ = undef;' -e 's/The\nend/\nThe end/sg' files...

  perledit -e '' files...   # restore files to original state

  perledit <input >output 

  (perledit -h    for help)

=head1 DESCRIPTION

This tool helps you perform mass editing of many files
and easily recover after making a mess of things.

C<perledit> is similar in effect to C<perl -C -i.ORIG -p ...> with one major difference:
If a "file.ORIG" already exists, then it is read as the input instead of "file".  

Therefore repeated runs always start with the original unmodified content instead
of the result of a previous bungled attempt.  
It is up to you to remove the .ORIG files after you've validated the results. 

=head2 OPTIONS

=over

=item -e PERLSCRIPT

Your Perl code to edit the current "line" in $_.

=item --init PERL_SETUPCODE

Optional initialization code to execute before starting to read each file.  
For example, it may set $/ to undef to slurp the entire file as a single "line",
modify encodings for STDIN and STDOUT (they default to UTF-8), and set
global variables for use in the edit script.
The effects persist only while processing the current file.  

The two scripts are combined like this:

    package Usercode;
    sub process_file {

        ...your init code inserted here...

        while (<STDIN>) {
            ...your edit code inserted here...
        }
        print STDOUT $_;
    }

Before processing each filename, C<STDIN> and C<STDOUT> are reopened to the appropriate files.

Specifically: STDIN is opened to "file.ORIG" if it exists, otherwise "file";
STDOUT is opened to a temporary file.  

After successful completion, the temp file is compared with "file"; 
if identical, i.e. no changes were made, then the file is left untouched and 
so it's modification timestamp will not change.  
Otherwise files are renamed (never overwriting "file.ORIG"), 
and permissions copied from the original.  If the final result matches the backup
file then the backup file ("file.ORIG") is removed.

If your script calls C<die> then neither "file" or "file.ORIG" 
will be touched.

Messages from C<warn> and C<die> are augmented by prepending the current file name 
and line number.  So if your script finds something unexpected it can 

   die "Unhandled frobnicate\n"

and the message will look like "/path/to/file.pm line 42: Unhandled frobnicate".

=item -b SUFFIX

Use SUFFIX when creating backup files instead of ".ORIG"

=item -h --help

=item -s --silent

=item -d --debug

Probably what you expect.

=back

=head1 RESTORING ORIGINAL FILES

You can restore all files to their original state with a "null edit":

    perledit -e '' files...

This effect falls out from the fact that a backup file ("file.ORIG") is removed
after an edit when the final result is identical to the backup file.

=head1 Pipeline Mode

If no input filename is given and C<stdin> has been redirected, then input is read
from C<stdin> and written to C<stdout>.  Backup files are not involved in this mode.

=head1 AUTHOR / LICENSE

Jim Avera (jim.avera at gmail) / CC0 or Public Domain

=cut

our $VERSION = "1.0";
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use File::Basename qw(basename dirname);
use Scalar::Util qw(openhandle);
use File::Compare ();
use Text::ParseWords qw(shellwords quotewords);
sub oops { require Carp; unshift @_, "oops(bug):"; goto &Carp::confess }

sub mktmpfilepath($) { shift()."_TMP_".$$."_".basename($0) }

Getopt::Long::Configure ("default", "gnu_getopt", "auto_version");
my ($editscript, $initscript, $outpath, $silent, $debug);
my $baksuf = ".ORIG";
GetOptions(
  "b|backupsuffix=s"  => \$baksuf,
  "d|debug"           => \$debug,
  "e|editscript=s"    => \$editscript,
  "h|help"            => sub{ pod2usage(-verbose => 2) },
  "i|initscript=s"    => \$initscript,
  "o|outpath=s"       => \$outpath,
  "s|silent"          => \$silent,
) or pod2usage(-verbose => 0);
die "--outpath may only be used when editing a single file\n"
  if $outpath && @ARGV > 1;
die "At least one input filename must be specified unless stdin is redirected\n"
  if @ARGV==0 && -t STDIN;

my $codestr = <<EOF ;
package Usercode;
sub {
  ${\($initscript//"")} ;
  while (\<STDIN>) {
    ${\($editscript//"")} ;
    print STDOUT \$_;
  }
}
EOF
my $subref = eval $codestr; 
if ($@ or $debug) {
  my $lno = 1; foreach (split /\n/,$codestr) { warn "Line ",$lno++,": $_\n" }
}
if ($@) { $@ =~ s/\(eval \d+\) //; die $@; }

sub run_edits($$) {
  my ($in, $out) = @_;
  open local *STDIN,  (openhandle($in)  ? "<&" : "<"), $in  or die "$in : $!\n";
  open local *STDOUT, (openhandle($out) ? ">&" : ">"), $out or die "$out: $!\n";
  my sub _msg(@) { "$in line ".STDIN->input_line_number().": ".join("",@_) }
  local $SIG{__WARN__} = sub { warn _msg @_ };
  local $SIG{__DIE__}  = sub { unlink $out; die  _msg @_ };
  $subref->();
}

if (@ARGV == 0) {
  run_edits(*STDIN, $outpath // *STDOUT);
  exit 0;
}
foreach my $path (@ARGV) {
  my $bakpath = $path . $baksuf;
  my $tmp_out = mktmpfilepath($path);
  my $redoing;
  if (-e $bakpath) {
    warn "> Found pre-existing $bakpath\n" if $debug;
    # Read the saved original & replace current w/o creating a new backup
    $redoing = 1;
    run_edits($bakpath, $tmp_out);
  } else {
    run_edits($path, $tmp_out);
  }
  if (File::Compare::cmp($path, $tmp_out) == 0) {
    warn "> No changes needed for $path; left as-is.\n" unless $silent;
    unlink $tmp_out;
    next
  }
  my $mode = (stat($path))[2] or die $!;
  if ($redoing) {
    warn "> Modified $path\n" unless $silent;
    unlink $path or die $!;
    if (File::Compare::cmp($bakpath, $tmp_out) == 0) {
      warn "  (Removing $baksuf file because it matches the result)\n" unless $silent;
      unlink $bakpath or oops "Unlink $bakpath : $!";
    }
  } else {
    oops "$bakpath already exists!" if -e $bakpath;
    warn "> Renaming original as $bakpath\n" unless $silent;
    rename $path, $bakpath or die "Rename orig: $!";
    warn "  Leaving edited content in $path\n" unless $silent;
  }
  rename $tmp_out, $path or die "Rename to final dest: $!";
  chmod $mode, $path or die "chmod: $!";
}
exit 0;