#!/usr/bin/env perl
# vim:foldlevel=1
#      __
#     /\ \ From the mind of
#    /  \ \____
#   / /\ \_____\ Lee Eakin ( Leakin at cpan dot org )
#  /  \ \/___  /        or ( Lee at Eakin dot Org )
# / /\ \___\/ /  Perl EDitor (sed-like)
# \ \ \/___  / A robust replacement for 'perl -i' (more error checking for
#  \ \___\/ / in-place edit, won't break links, etc.).  Also works as a filter.
#   \/_____/ Files may be flock-ed, result is summed to detect change.
#
package Ped;
require 5.004;
my ($pgm) = $0 =~ m|([^/]*)$|;
my $DEBUG = 0;

use Pod::Usage;
use Getopt::Long;
use FileHandle;
use Cwd 'abs_path';
use File::Temp;
use Fcntl qw(:flock);

use vars qw($VERSION %data $bkup $edit $silent $script $force $help $lock $man
      $noprint $wholefile $warn);

$VERSION = 1.2;

Getopt::Long::Configure('auto_abbrev','no_ignore_case','bundling');
&GetOptions('b|backup=s'  => \$bkup,
            'e|edit=s'    => \$edit,
            'f|file=s'    => \$script,
            'F|Force'     => \$force,
            'h|help'      => \$help,
            'l|lock'      => \$lock,
            'm|manual'    => \$man,
            'n|noprint'   => \$noprint,
            's|silent'    => \$silent,
            'u|usage'     => \$help,
            'W|Wholefile' => \$wholefile,
            'w|warn'      => \$warn,
           ) or pod2usage(-exitval => 2, -verbose => 1);
pod2usage(-exitval => 1, -verbose => 1) if $help;
pod2usage(-exitval => 1, -verbose => 2) if $man;
pod2usage(-exitval => 2, -verbose => 1) if $edit and $script;
pod2usage(-exitval => 2, -verbose => 1) if ! $edit && ! $script && ! @ARGV;

if ($script) {
   my $fh = FileHandle->new($script)
      or die "$pgm: could not read $script: $!\n";
   { local $/; $edit = <$fh>; }
} elsif (not $edit) { # read code from stdin
   $| = 1;print "$pgm> " if -t;
   while (<STDIN>) {
      last if /^\.$/ && -t; # be nice like mailx (nuke it if you don't like it)
      $edit .= $_;
      print "$pgm> " if -t;
   }
}

my $editloop;
if (@ARGV) {
   $editloop = <<'EOT';
      package main;
      END { &Ped::filecheck }
      $SIG{'HUP'} = $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = \&Ped::abort;
      foreach $Ped::file (@ARGV) {
         if (my $fh = &Ped::filemunge($Ped::file)) {
EOT
   $editloop .= $wholefile ? '            { local $/; $_ = <$fh>; }'
                           : '            while (<$fh>) {';
# user code included here ($edit)
   $editloop .= "               $edit;print unless \$Ped::noprint;\n";
   $editloop .= "            }\n" unless $wholefile;
   $editloop .= <<'EOB';
            exists &append && &append();
            &Ped::filecheck;
         } else { $Ped::status++ }
      }
      exit $Ped::status;
EOB
} else { # simple loop for pipe (sed-like)
   $editloop = $wholefile
      ? "package main; { local \$/; \$_ = <STDIN>; }
         $edit; print unless \$Ped::noprint"
      : "package main; while (<STDIN>) {$edit; print unless \$Ped::noprint};
         exists &append && &append()";
}

eval $editloop;
select STDOUT;
warn($@), exit 3 if $@;

sub getpath {
   my $path = shift;

   # older abs_path did not handle files
   while (-l $path) {
      my ($dir) = $path =~ m|(.*/)|;
      my $lt = readlink $path;
      $path = substr($lt,0,1) eq '/' ? $lt : "$dir$lt";
   }
   my ($dir,$base) = $path =~ m|(.*/)?([^/]*)$|;
   $dir = abs_path($dir || '.');
   $dir .= '/' if $dir and not $dir =~ m|/$|;
   return "$dir$base";
}

sub filemunge { # DANGER: GLOBAL VARIABLES IN USE HERE
   $data{name} = shift;

   $data{fullpath} = &getpath($data{name});
   # use abs_path() so backup/tmpfile is in proper dir
   my ($mode,$links,$own,$grp,$mtime) = (stat($data{name}))[2,3,4,5,9];
   $data{linked} = $links > 1;
   $data{mtime} = $mtime;
   $data{filehandle} = FileHandle->new("+<$data{name}")
      or warn("$pgm: could not open $data{name} read/write: $!\n"),return;
   ($data{temphandle},$data{tempfile}) = mkstemp "$data{fullpath}.pedXXXXXX"
      or warn("$pgm: could not create temp file $data{fullpath}.pedXXXX: $!\n"),
         return;
   flock $data{filehandle},LOCK_EX if $lock;
   chown $own,$grp,$data{tempfile};
   chmod $mode,$data{tempfile};
   if ($links == 1) {
      # common case, no hard links
      select $data{temphandle}; # point 'print' output to temp file
      return $data{filehandle}; # so the loop can read from it
   } else {
      # we don't want to break the link, so write whole file to temp file first
      { local $/; print $data{temphandle} (<$data{filehandle}>) } # dump to tmp
      { local $|=1; print $data{temphandle} ('') } # force flush
      for my $h ($data{temphandle},$data{filehandle}) { seek $h,0,0 }
      utime time,$mtime,$data{tempfile};
      # now we have to truncate the original file so we can write it back
      # and preserve the hard links (ugh!)
      truncate $data{filehandle},0;
      select $data{filehandle}; # point 'print' output to original file
      return $data{temphandle}; # so the loop can read from it
   }
}

sub filecheck { # DANGER: GLOBAL VARIABLES IN USE HERE (%data,$bkup)
   return unless exists $data{filehandle};
   unless ($force) {
      for my $h (@data{'filehandle','temphandle'}) {
         local $|=1; print $h ''; # force flush
      }
      # files are re-opened here because rewinding did not work
      my ($tsum,$fsum);
      {
         local $/;
         my $tf = FileHandle->new($data{tempfile});
         my $rf = FileHandle->new($data{fullpath});
         $tsum = (unpack "%16C*",<$tf>) % 65536;
         $fsum = (unpack "%16C*",<$rf>) % 65536;
      }
      if ($fsum == $tsum) {
         $Ped::status++ unless $silent;
         warn "$pgm: $data{name} unchanged\n" if $warn;
         if ($data{linked}) {
            utime(time,$data{mtime},$data{fullpath})
               or warn "$pgm: could not restore modify time of $data{name}\n";
         }
         for my $h (@data{'filehandle','temphandle'}) { close $h }
         unlink $data{tempfile};
         %data = ();
         return;
      }
   }
   if ($data{linked}) {
      if ($bkup) {
         rename $data{tempfile},"$data{fullpath}$bkup"
            or warn "$pgm: could not make backup for $data{name}: $!\n",
               unlink $data{tempfile};
      } else {
         unlink $data{tempfile};
      }
   } else {
      if ($bkup) {
         if (rename $data{fullpath},"$data{fullpath}$bkup") {
            rename $data{tempfile},$data{fullpath}
               or warn("$pgm: could not rename new $data{name}: $!\n"),
                  rename("$data{fullpath}$bkup",$data{fullpath}),
                  unlink($data{tempfile}),
                  $Ped::status++;
         } else {
            warn "$pgm: could not rename $data{name} as backup: $!\n";
            unlink $data{tempfile};
            $Ped::status++;
         }
      } else {
         rename $data{tempfile},$data{fullpath}
            or warn("$pgm: could not rename new $data{name}: $!\n"),
               unlink($data{tempfile}),
               $Ped::status++;
      }
   }
   for my $h (@data{'filehandle','temphandle'}) { close $h }
   %data = ();
}

sub abort { # DANGER: GLOBAL VARIABLES IN USE HERE (%data)
   # if we get here, something went wrong and we caught a signal
   if (exists $data{filehandle}) {
      if ($data{linked}) {
         # put original data back
         for my $h (@data{'filehandle','temphandle'}) {
            seek $h,0,0; # back to start
         }
         truncate $data{filehandle},0;
         { local $/; print $data{filehandle} (<$data{temphandle}>); }
         close $data{filehandle};
         utime(time,$data{mtime},$data{fullpath})
            or warn "$pgm: could not restore modify time of $data{name}\n";
      }
      for my $h (@data{'filehandle','temphandle'}) { close $h }
      unlink $data{tempfile};
   }
   warn "$pgm: aborted\n";
   exit 3;
}

__END__

=head1 NAME

ped - perl editor, sed-like command line edit-in-place

=head1 SCRIPT CATEGORIES

UNIX/System_administration

=head1 SYNOPSIS

=head2 ped -e perl-code [ options ] [ file(s) ... ]

   or

=head2 ped -f file [ options ] [ file(s) ... ]

   or

=head2 ped [ options ] file [ file(s) ... ]

=head1 README

B<Ped> is a sed-like filter using perl regex (when no filenames are given),
and an edit-in-place (like perl -i) that preserves soft and hard links and
offers flock support when filenames are specified.

=head1 DESCRIPTION

If no filenames are specified on the command line it functions very
similar to sed, reading from stdin and printing to stdout.  It supports
the B<-n> option of sed, allowing you to decide which lines pass through.
At a minimum it provides replacement for sed that understands perl regular
expressions, the maximum is limited only by the capabilities of perl and
the programmer.

Given one or more filenames to edit, it behaves like 'perl -i' with the
added feature of preserving both symbolic and hard links (the data is not
sent to stdout).  A checksum is generated for the original and edited file,
and the original file is left in place if no changes were made.

The perl code for modifying data can be passed on the command line as a single
argument to B<-e>, in a seperate file with B<-f>, or passed to stdin when
editing a file in disk (the perl code cannot be passed to stdin when the data
is also being read from stdin).

Without additional options, the code provided is called inside a while loop
with the current line in the $_, and the proper filehandle selected for output.
A print call follows the provided code, so lines can be removed by calling
'next', or using the B<-n> option and calling print yourself as needed.

More complicated code may be used including multi-line matches with the B<-W>
option.  The entire input data is read into $_, and the code provided is called
only once, followed by the print call (assuming B<-n> was not also specified).

The B<-F> option bypasses the checksum calculation that determines whether
any modifications were actually made, and the output is always written to the
file.  Without this option the file will not be modified and the program will
exit with a non-zero status if no changes were made.  This has no effect when
data is passed from stdin to stdout.

The B<-s> option is similar to B<-F> in that is causes the program to only
exit with a non-zero status on error, not for failure to change the file
contents.  The checksum is still performed, and the original file is restored
if no changes were made.

The B<-w> option causes a message to stderr for eash unchanged file in
addition to the non-zero exit status.

Each file can be locked using I<flock(2)> by including the B<-l> option.

The original contents of files can be preserved in a backup file using the
B<-b> option and the desired extension (similar to the perl -i option).

If a function named 'B<append>' is defined (usually inside a B<BEGIN> block),
it will be called when eof is reached on input.  Any text output through
'print' is appended to the output file.  Alternatively, you could use B<-n>
and 'eof' in combination to append data.  If the B<-W> option is used, you can
append to the file by appending to $_ before the print call.

The current filename may be accessed as $Ped::file.

=head1 OPTIONS

  -e expr
  --edit expr     insert given perl expression into while loop.
                  If this option is not specified, stdin is
                  read until eof, or dot on a line by itself
                  (like mailx).

  -f name
  --file name     perl code is read from the given file
                  instead of the command line or stdin.

  -b .ext      
  --backup .ext   extension appended to each file edited.
                  If this option is not specified, no backup
                  copy is left.  i.e. to save a copy in
                  <filename>.bak use '-b .bak'.  The dot
                  seperator for extension is not assumed.

  -W
  --Wholefile     Normally the data being read is processed
                  one line at a time, but this option causes
                  all the data to be sucked into memory ($_)
                  and the perl code supplied operates on the
                  whole file at once.  This allows for the
                  use of multi-line matches and substitutions.

  -F
  --Force         do not checksum files, always write
                  the updated file.

  -h
  --help
  -u
  --usage         print help/usage text.

  -l
  --lock          I<flock(2)> the file during edit.

  -m
  --manual        display the full manpage.

  -n
  --noprint       like 'sed -n', do not auto-print output

  -w
  --warn          warn if no modifications made (ignored
                  if -F is set).

  -s
  --silent        does NOT exit non-zero unless there is
                  an error, default is to exit non-zero if
                  no changes were made.

=head1 AUTHOR

Copyright (C) 2003 Lee Eakin E<lt>leakin@cpan.orgE<gt>. All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut