#!/usr/bin/perl

# emv - edited mv, perl version

# fork/rewrite from the shell version of emv v1.95 20060928
# [v1.95 2006-02-17 torsten.scheck@gmx.de, www.i0i0.de/toolchest/emv]

# last changes:
# 2007XXXX PJ       jakobi@acm.org changed to include line numbers in the editor,
#                   allowing arbitrary editor commands and reordering (perl scraps)
# 20090317 PJ       add trailing / for dirs
# 20090628 PJ       added -cmd and extended convenience commands
# 20090729 PJ       perl rewrite and dir-rename tracking
# 20090803 PJ? 2.00 modeline vim:filetype=netrw for syntax highlighting; I still
#                   try to avoid a syntax file (see /\$foot and /hi .*link), thus
#                   also switching to " as comment char (but still allowing #)
# 20090826 PJ       added pr to messages to protect the terminal, single pass mode
#                   when unsetting $mv2, --nopathtrack, --todir/--nodir, --perlpostedit
# 20090826 PJ       fixed emvx bug - when did appending $deltaorg @orgfile change to @newfile!?                  
# Copyright (c) 2006-2009 jakobi@acm.org placed under GPL v3 and newer
# archive:  http://jakobi.github.com/script-archive-doc/
my $version="2.00pj.3"; 


# emv consists of: emv  
# and the helpers: emvx (extend emv session by expanding directories)
#                  emvs (simple find output sorted with _SANE_ '/' handling)
#                  emvp (run lines thru perl expression, allowing for 
#                        user or predefined builtins; wrapper for abusing
#                        the non-interactive file renamer myrename as a
#                        perl filter for filenames. emvp0 provides a
#                        severely stripped down variant. Use perl -npe
#                        if you don't need path mangling or builtins.)

# major bugs:
# - none known.
# 
# bugs and issues:
# - does NOT report non-conforming lines as IGNORED [won't fix for now]
# - while basic dir tracking is implemented, it still lacks true canonical 
#   de-linked dev/inode# name+path smashing. [won't fix for now]
# - filename restrictions on really-pathologically-stupid names due to use 
#   of ls for generating the list of files. Consider e.g. the worst case
#   of \n within filenames misleading the script to treat the name as
#   2 or more bogus filenames: check the filenames using something like 
#   perl -e 'use File::Find; $f=sub{print "$_\n\n" if /\n/}; find($f, @ARGV);' .
#   (then maybe reuse above with unlink or rename instead of print).
#   better yet: explicitely verify the sanity of ALL filenames.
#   [will fix any known case except '\n']
#
# ? errfile doesn't include things like command or command number,
#   we could provide print the command string in case of non-zero rc; 
#   but that adds noise to the errfile and won't happen for non-error
#   output; the proper way would be a temporary per command errfile
#   being checked and appended to the real errfile 
#   [undecided, lacks usage scenario where this would really be helpful]
#   [won't modify for now]
# ? filenames containing [", ']: works. However I'm less certain
#   about say utf8 w/wo locale conflicts and invalid chars like e.g.
#   a latin1 umlaut in filenames - wil the shell accept the command, 
#   or return an error (either would be caught correctly)? 
#   Or worse: will the a questionable shell or mv implementation
#   irresponsibly silently strip the character in question 
#   (which would allow mv to collide without perl being able to 
#   detect this ahead of time).
#   [too insane, won't consider before bug report incl. in depth 
#    details on mv and shell being used]
# ? possibly some in the undo/redo log quoting of filenames, also
#   the log might contain UNDO unneeded commands in case we did detect
#   an error a bit later than we should: Thus
#   !DO DOUBLE CHECK the logs before using the logs for undoing changes!
#
# - Note than convenience commands like rm / touch / sh / ... [won't fix for now]
# -                               aren't fully logged 
# -                               aren't logged in sequence
# -                               neither check errors nor report on stdout/stderr
#                                 may fail in funny ways for FILENAMEs starting with blanks



use warnings;
use strict;
use vars;

my($shell, $shellteelog, $shellpreproc, $shellpostproc);
my($time, $edit, $mv, $mv2, $mvtty, $dir, $owner, $head, $foot, $commentchar);
my($changes,$errors,$errors_severe,$convenience,$dotwarned,$tmpsfx);
my(@pathtrack,@pathtracked);
my($tmp);
my($o_verbose, $o_long, $o_dirtree, $o_perlblock, $o_perlposteditblock, $o_renametodir,
   $o_delta, $o_stdin, $o_debug, $o_sort, $o_checkuserlines, $o_nopathtrack, $o_perlcmdblock);
# logs and log contents
my($orgfile, $linfile, $newfile, $errfile, 
   $undfile, $redofile, $edtfile, $deltalin, $deltaorg,$logmaxage);
my(@orgfile, @linfile, @newfile, @errfile, 
   @undfile, @redofile, @edtfile, @deltalin, @deltaorg);
$tmpsfx=".tmp$$~";

$|=1;
$o_debug=0;
$o_checkuserlines=1;
$o_nopathtrack=0;
$o_renametodir=1;
$dotwarned=0;
$logmaxage=86400; # delete older logs (1 day = 24*3600s)

init();
parsearg();
getfiles();
$o_perlblock ? perlblock() : editorsession(); 
exit 0 if $o_delta; # emvx support, called from another emv

print "\n";
renaming();
summarize();

warn "ASSERT: cannot be reached";
exit;


# Usage and args -----------------------------------------------------

sub usage {
   print <<EOF;

Usage: $0 [OPTIONS] ...

       $0
       $0 -d
       find ... | $0 [OPTIONS] -

Editor mv: Rename files with your favourite text editor ($edit).

version: $version

In  addition to renaming files, emv also logs its actions as  reusable
shell scripts. Logs are kept for a day before being deleted during the
next invocation.

Basic directory rename pathtracking is implemented to allow renames of
directories  and their children within a single session, though  there
is no generic cycle detection implemented.

Renames  are done by first renaming all files to an intermediate name,
then  in a second pass to the new filename (all directories in the new
name  must exist). 

Deleting  lines or changing the order during editing is possible (vim:
e.g.  sorting  filenames with :sort /\\t/, then deleting the first  few
files or emv -l to check files by size :sort!n/\\d\+ \\d/r). All of which
does  NOT affect the sequence of renames, which is always the order of
the  input (unless -s/-r). Pipe a region to emvx to replace it with an
extended  view of e.g. directories (vim: :.,\$!emvx); the new files are
added  to  the end of the sequence. You can mix long (option  -l)  and
short listings within a single session.

Invoke  with -stdin to use a file list from stdin. To reuse a previous
sessions  editor  buffer content (availble in the logdir as edt-*)  as
filelist  for  -stdin, just retain the filenames after  stripping  the
linenumbers by e.g. perl -lne 's/^\\s*\\d+\\t// and print'.

The  editor is specified by the VISUAL or EDITOR environment variable,
vi otherwise. The editor used should be able to support block / sort /
grep and repeat/replace operations to take advantage of emv (like e.g.
vim,  emacs).


Valid lines during editing are (<WS> being whitespace):

   - <WS>+ <NUMBER> <TAB> <FILENAME>                         
   - <WS>+ <NUMBER> <TAB> #[<META-INFORMATION>]# <TAB><FILENAME> 
     alternate line format for -l option, which includes file meta info
   - ^# comment lines like the short usage header
   - blank/empty lines
 
   - lines with convenience commands must start in first column and will
     be executed _before_ any renames. Executed commands and their 
     side-effects are not included in pathtracking. There is no error 
     checking or collision detection for convenience commands.
     =                     <VARIABLE><WS><VALUE>            # set shell var
     x                     # expand vars and recheck line as rename/command
     (l|l0|...|l9)         ...          # append name to corresponding list
     (rm|rmdir|d)          <WS>+ (<NUMBER><WS>)?                 <FILENAME>
     (mkdir|create?|touch) <WS>+                                 <FILENAME>
     (ln|ln-s)             <WS>+                  <NUMBER> <TAB> <FILENAME>
     relink                <WS>+                  <NUMBER> <TAB> <FILENAME>
     relink                <WS>+ <NUMBER><WS>+           ->  <WS><FILENAME>
                           # relink is guaranteed to only clobber symlinks
     (cp|mv)               <WS>+                  <NUMBER> <TAB> <FILENAME>
     sh                    <WS>+                             <SHELLCOMMAND> 
                           (  <WS>+ #  <WS>?  <NUMBER> <TAB> <FILENAME>  )?
                           #            cp, mv are just aliases based on sh


Options:
   -             last option argument, sets -stdin
   --            last option argument
   -v            verbose, also --v
   --examples    additional help, examples and notes
   --help        help, also -h
   [--init BLOCK hook evaluated during option handling]

   # input and sorting
   -d            dirtree-mode        (roughly find . -type d | emv -r -)
   -s / -r       sort input / reverse sort input        (see also: emvs;
                 in contrast to sort, this keeps dir and dir/* together)
   --stdin       read stdin for filenames

   # editing names
   -c ARG        print ARG  as a comment above the filelist
   -C FILE       print FILE as a comment above the filelist
   -l            long listing: include size etc as comment column
   --perl BLOCK  use perl BLOCK instead of invoking \$EDITOR, also -p:
                 files will be renamed if \$_ is changed and non-empty
                 example: emv -p 's/^/a/; \$_="" if /7/' *
   [--perlpostedit BLOCK -- eval hook to modify the data from \$EDITOR]

   # renaming
   -n            no-execution (note: -n prints control chars as '?',
                 furthermore it might not detect all some collisions)
   --cmd    CMD  invoke CMD in pass1 (rename to intermediate; $mv)
   --cmd2   CMD  invoke CMD in pass2 (intermediate to new name; $mv2)
   --cmdtty TTY  input handle for CMD ($mvtty)
   --nopathtrack (may be required when using overriding --cmd/--cmd2)
   --todir / --nodir - allow/disallow mv FILE DESTDIR (allow: $o_renametodir)
   [--perlcmd BLOCK -- eval hook run early in pass1 and pass2]


EOF
}

sub examples {
   print <<EOF;

on logs and the use of generated scripts:
  - Execution  protocol, executed commands (redo) and undo files are
    kept for a day in the log directory. The old filename is single 
    quoted, the new  tripple  single-quoted,  which should help in  
    anchoring  regular expressions.  To  sort on field delimeter 
    characters in the  generated logs/scripts:
          vim's :sort /'''/ anchors the sort to the new filename field
          otherwise consider piping the buffer through external commands:
          perl -lpe 's/'"'"'{3}/\\0/' to add and tr -d '\\0' to remove
          sort -d '\\0' -k 2 to sort on the new filename field
   - Use  -n  to  just  create a shell script  (redo*)  containing the
     mv commands.  Replace  mv with a suitable function to execute
     arbitrary commands instead.

on renaming files in the editor:
   - non-conforming lines (mistyped convenience commands will be 
     discarded earlier), whitespace lines and comments are silently ignored
   - the original filename must not start with a '#', '"' or just contain
     whitespace. To satisfy this, it is suffient to provide an absolute
     path or prefile the relative names with './'.
   - the new filename must contain at least one non-whitespace character
   - filenames must not contain '\\n'
   - emvx -l in a non -l emv session: mixing long and short listings i
     requires that no file names match '^#\[.*\]#\t'. This is also true
     if you delete the meta information manually
   - all ancestor directory components of the new name must exist.
   - with --nodir, no renames will execute when the entered new name is
     the name of an existing directory. With --todir, for each affected
     file, the new name is generated by appending the original basename;
     if the resulting name does exists (even as a directory), the rename 
     will be rejected.

rename ordering:
   - renames are done in two passes: first all are renamed to intermediate
     names, only then all intermediates are renamed to the final name.
   - you can use find|emvs to ensure proper sorting (parent and entries
     are guaranteed to be sorted together and remain a single region, 
     as / is temporarily replaced by \\0).
   - emvx replaces a region in the editor. In fact he keeps the original
     section in the lists and appends the difference at the end of the
     lists. As the original lines no longer can be edited, they will not
     trigger renames, while 'new' lines can trigger renames.

usage considerations for convenience commands:
   - KIS,S! 
   - do not use complex sh commands, use shell scripts with short names
     or - if possible - use --cmd / --cmd2 instead
   - use multiple simple emv invocations instead of depending on
     multiple other renames or complex results from convenience commands
   - suspend emv to run non-trivial command sequences

on adding convenience commands to a session: 
   - commands remove their lines from further processing or renaming
   - commands are run sequentially BEFORE any reordering/logging/renaming
     and thus their effects may be made to clash with later renames
   - commands are not path-tracked nor remembered by pathtracking
   - logging for convenience commands for undo/redo is imcomplete
   - filenames must start with a non-whitespace character or e.g. './'
   - commands are perl builtins except for sh, for which perl invokes
     a shell. Note that cp/mv are aliases for longer sh commands.
   - mistyped commands are silently discarded
   - NOT implemented:
     - recursive rm (use sh rm -r)
     - reloading emv after requesting execution of commands
       (will no longer implement this: suspend the editor or type in 
        a short shell script to paste to another terminal)

on using the sh convenience command and adding aliases:
   - use sh SHORT-SCRIPT-NAME to run an arbitrary command. (search the 
     source for 'expand sh aliases inplace' (around line 700) for the 
     expansion of the cp and mv aliases, if you really want to add a
     new alias for some sh command). 
   - another way to add aliases: use the --perlpostedit hook and
     modify \@\$newref (it _is_ ok to modify it inplace) and make a
     suitable shell wrapper to invoke emv --perlpostedit '...'.
   - the following shell variables are set: old and new name as \$O, \$N;
     as well as the error, undo and redo logs \$errfile, \$undfile, 
     \$redofile.
   
on using vim: 
   - use :setl ft=netrw to use the netrw syntax highlighting for emv
     (currently, a suitable modeline at EOF is already added)
   - depending on the available colors and mappings, Directory and
     comment may be mapped to the same highlighting. In this case you
     can add a line to .vimrc (check settings with :highlight), e.g.
          hi clear Directory | hi link Directory PreProc "emv
   - also see the help text, :help and e.g. the relink example below.

example on using emv to split a filelist into multiple lists:
   - to  quickly sort a region of files into one or more filelists, 
     use the = convenience command and set the corresponding variable
     l .. l9 to the filename of the list. The l commands then appenda
     filenames/strings to lists. 
     - assuming a filelist of file1, file2, add the next line to
       the editor buffer, and prefix the lines for file1, file2
       with l. Save and quit. 
       = l newfiles
       l file1
       l 10<TAB>file2
     - then you can use the filelist from the shell, or
       even with later convenience commands:
       sh cat \$l | cpio -o -Hcrc | gzip > archive.cpio.gz

example repairing a large number of broken links:
   - generating a list of broken links:
     - GNU find . -type l -xtype l
     - find-broken links perl scriptlet
   - to edit symlink targets, use emv -l and just modify the -> target
     in the commented second line of the file's entry. For broken
     symlinks, !> is displayed. To just repair the broken links in
     a huge filelist in vim:
     - :1,/^\$/d         delete the help header
     - :%g!/^#/d        remove all lines excepting the link targets
     - :%g!/->!/d       keep only broken links (and targets containing ->!)
     - :%s/^#/relink/   prefix the lines with relink
     - delete some links not of interest
     - visual-select the renamed dir component of some broken links,
       and type c to change all lines of the block to use the new 
       directory name.
     - :wq and trigger the mass-relink of a few dozen or many hundreds
       of links.
   - In case of problems: there is no proper undo history available for
     convenience commands - the undo log merely lists the relink lines. 
     However full filename and targets information can still be found in 
     the other logs.
   - see also: myrename '\$l=~s/oldtarget/newtarget/'

notes on the shell and using --cmd / --cmd2:
   - the shell _MUST_ support Bourne-style redirection and the
     set -o pipefail option like e.g. ksh or bash. \$EMVSHELL can be
     used to specify a specific shell instead of having emv guessing
     a suitable shell.
   - command invocation is COMMAND src dst, where COMMAND is a string
     containing the command name/arguments. Available shell variables
     are \$srcline, \$dstline as the argument commands for the pass.
   - additional shell variables are  \$orgline, \$tmpline, \$newline,
     which are the original, intermediate and new name (pathtracked) 
     as well as \$orgline0, \$newline0, which are not tracked.
     The log names are available as \$errfile, \$undfile, \$redofile. 
   - use --nopathtrack to turn pathtracking off if your COMMAND does
     not rename directories when invoked with directory arguments, but
     still returns success: otherwise emv will pathtrack the change
     and modify any directory descendant in future renames.
   - use --cmd COMMAND to use COMMAND instead of /bin/mv for the rename.
     COMMAND could e.g. check the contents and reject some files by
     exiting with a nonzero code, maybe to exclude binary files when 
     moving files into a new dir for later checking in into a version 
     control system. Skips pass2 and directly uses the final name as 
     2nd argument if cmd2 is unset. Use a wrapper script or have COMMAND
     be both shell function and function invocation if your command is 
     only interested in one name or requires additional parameters.
     On a non-zero exit code, emv assumes that there has been no change
     to the filesystem.
   - --cmd2 COMMAND could e.g. be used with a script that appends
     files and optionally remove the old file, when safely appended.
     A non-zero exit code from cmd2 triggers a real mv command with
     the intermediate and the original name as its arguments.
   - if you set --cmd1 and do have a --cmd2 (yours or the default), 
     pass2 will use /bin/mv as necessary to undo the renaming to 
     intermediary names in case of errors (targets exists or error
     code from --cmd2)
   - logging constraints: if you provide your own 'rename' instead
     of the builtin mv, some points to observe: 
     1) the logs may or may not still print mv lines (work around: 
        replace the text, or define a shell function overriding mv;
        example and actually used commands are provided in each log
        as comment)
     2) if you want to use a log as base of a shell script, instead of
        the normal sanity checking, please _double_ check the logs now:
        your commands might have slightly different semantics than mv
        when confronted with differing types of files. Does it try to
        ascertain that the filesystem is unchanged if it exits with a
        non-zero exit code?

on using and abusing the perl eval hooks
   - using --init, you can change arbitrary perl variables during
     initialization. 
   - use --perledit to add more sh convenience command aliases like 
     cp and mv.
   - use --perlpostedit to validate the user's filenames
   - use --cmd and --perlpostedit to change a prefix of the filenames,
     'join/merge trees' (think hurd fs-translators, mount --bind
     and FUSE, make VPATH, unix view vs samba, file vs RCS/file,v, 
     ...) to find/display names from one path, but use the second path
     for the COMMAND with slightly differing semantics by editing both 
     the original and the new lines...
   - use perlcmd in similar fassion. It is evaluated for each file, 
     being able to modify \$orgline, \$tmpline, \$newline. The pass
     number is availble in \$pass.
   - like convenience commands, hooks are nice for a quick hack,
     but do be wary of regular and extensive use, as it is easy to 
     break implicit assumptions, invalidate the usual filesystem 
     semantics, or psychoanalyze the filenames with an Eliza clone,
     at least the last of which probably is better done on top of
     a simple find | perl -lpe ...

alternatives:
   - gprename (perl gkt, probably somewhat hackable)
   - krename  (KDE/Qt; like emv, this one also features a shell
     script as undo log; plus it can be made part of konqueror)
   - myrename (the tty-based interaction however deals with each
     file separately; in general, this is more suited to
     batch-style noninteractive use, especially when you start to
     predefine repetitive actions (which would required sourcing or
     issueing an editor macro with emv); with maybe just interactive
     conflict resolution)
   - if you manage to get safely get lines into arguments, the
     shell itself actually becomes a suitable and SAFE mass renamer:
     - find | f2a; for i in "\${f2a[@]}"; do mv "\$i" "\${i##.TXT}".txt; done
     - reading from a command is a portability mess however:
       ksh-only:  find | while read; do mv "\$i" "\${i##.TXT}".txt; done
       bash-only: while read; do mv "\$i" "\${i##.TXT}".txt; done < <(find)
       at least reading from a plain file is portable:
       find > FILE; while read; do mv "\$i" "\${i##.TXT}".txt; done <FILE
     - if you prefer pain and excess forks, xargs is your friend:
       find -print0 | xargs -0 bash -c \\
          'for i; do mv "\$i" "\${i##.TXT}".txt; done' SeCrEt {} \\;
   - convmv: mass-fix the charset of file *NAMES* (dirtree to utf8;
     for contents, use recode latin1..utf8 <File >File or perl -pe 
     'BEGIN{use encoding 'utf8';}' (but don't feed with utf8!!);
     --> man perlunicode; to flag, use Encode::encode_utf8 (utf28bit))
EOF
}                               


sub parsearg {
   while($_=shift @ARGV,defined $_) {
      /^-?-debug$/       and do{$o_debug=1;next};
      /^(-h|-?-help)$/   and do{&usage; &cleanexit(20)};
      /^-?-examples?$/   and do{&examples; &cleanexit(20)};
      /^-c$/             and do{$_=shift @ARGV; $head.="# $_\n";next};
      /^-C$/             and do{$_=shift @ARGV; $head.="#contents of file $_\n";
                                open(FH, "<", $_) or die "no such file: $_\n"; 
                                local($/); $tmp=<FH>; s/^(?!#)/# /mg;
                                $head.=$tmp; $head.="\n" if $tmp!~/\n\z/;
                                close FH;next};
      /^-?-cmd$/         and do{$mv=shift @ARGV;next};
      /^-?-cmd2$/        and do{$mv2=shift @ARGV;next};
      /^-?-cmdtty$/      and do{$mvtty=shift @ARGV;next};
      /^-d$/             and do{$o_dirtree=1;next};
      /^-l$/             and do{$o_long=1;next};
      /^-n$/             and do{$mv="noexec" if $mv; $mv2="noexec" if $mv2; next};
      /^-p$|-?-perl$/    and do{$o_perlblock=shift @ARGV;next};
      /^-?-init$/        and do{eval shift @ARGV; die "$@" if $@; next};
      /^-?-perlpostedit$/ and do{$o_perlposteditblock=shift @ARGV;next};
      /^-?-perlcmd$/     and do{$o_perlcmdblock=shift @ARGV;next};
      /^-?-nopathtrack$/ and do{$o_nopathtrack=1; next};
      /^-?-nodir$/       and do{$o_renametodir=0; next};
      /^-?-todir$/       and do{$o_renametodir=1; next};
      /^-r$/             and do{$o_sort=2;next};
      /^-s$/             and do{$o_sort=1;next};
      /^-v$|^-?-verbose$/i and do{$o_verbose++;next};
      # numbering offset; internal use only for emvx
      /^-?-delta$/       and do{$o_delta=1; $deltaorg=shift @ARGV; $deltalin=shift @ARGV;next};
      /^-?-stdin$/       and do{$o_stdin=1;next};
      /^-$/              and do{$o_stdin=1;last};
      /^--$/             and do{last}; # -- end of option vs - as -stdin
      /()/               and do{unshift @ARGV,$_; last};
   }
   $mvtty="<$mvtty" if defined $mvtty and $mvtty;

   # don't prevalidate $o_perlcmdblock - due to higher likelihood of fs accesses

   if ($o_perlposteditblock) { 
      # check syntax before invoking the editor!
      my($linref,$newref,@sh,$t,$tt,$l);
      $linref=[]; $newref=[]; 
      $_=$t=$tt=$l="";
      eval "$o_perlposteditblock;"; die $@ if $@;
   } else {
      $o_perlposteditblock="";
   } 
}


# small helper -----------------------------------------------------------


sub cleanexit { 
   print "\n# Note: working files and undo log are kept in\n".
           "#       $dir for a day (session $$)\n" if $_[0];
   exit $_[0]; 
}

sub noexec {
   my(@f)=@_;
   foreach(@f){$_=pr($_)};
   # warning - we CHANGE CHARS < 0x1f in the filenames, so when used as script
   #           this may fail for a few renames
   print "     ".join(" ",@f)."\n" if $o_verbose;
}

sub arrayrefwrite {
   my($file,$arrayref)=(@_);
   open(FHA, ">", $file) or die "cannot write $file\n";
   foreach(@$arrayref) { print FHA $_, (/\n\z/ ? "" : "\n"); }
   close(FHA)            or die "cannot close $file\n";
   1;
}

sub arrayrefread {
   my($file,$arrayref)=(@_);
   @$arrayref=();
   open(FHA, "<", $file) or die "cannot read $file\n";
   while($_=<FHA>,defined $_) {
      s/\n\z//;
      push @$arrayref, $_;
   };
   close(FHA)            or die "cannot close $file\n";
   1;
}

sub appendfile {
   my($log)=shift;
   open( FHL,">>",$log) or die "cannot open log $log\n";
   print FHL @_ , ( $_[$#_]=~/\n\z/o ? "" : "\n" );
   close FHL;
   1;
}

sub arrayrefappend {
   my($file,$arrayref)=(@_);
   open(FHA, ">>", $file) or die "cannot append $file\n";
   foreach(@$arrayref) { print FHA $_, (/\n\z/ ? "" : "\n"); }
   close(FHA)            or die "cannot close $file\n";
   1;
}

sub sq{ # escape hack for single-quoting
   my($tmp)=@_;
   $tmp=~s/'/'"'"'/g;
   return($tmp);
}

sub pr { # return printable chars -- protect the tty against control codes below \x80
         # Q: 9b vs. utf8 - leave alone for now
   local($_)=@_;
   # s/[\0-\x1f\x7f]/"%".unpack("H2",$&)/ge;
   s/[\0-\x08\x0a-\x1f\x7f]/?/go; # emv: still allow tabs (convenience cmd!)
   return $_;
}

# setup to cleanup -------------------------------------------------


sub init {

   $time=time;
   $changes=$errors=$errors_severe=0;

   $edit=$ENV{VISUAL};
   $edit=$ENV{EDITOR} if not $edit;
   $edit="vi"         if not $edit;

   $mv="mv -i --";   # pass1 org to intermediate 
   $mv2="mv -i --";  # pass2 intermediate to new
   $mvtty="/dev/null"; # use /dev/null to avoid interactive command & queries

   $dir="/var/tmp"; $dir="/tmp" if not -d "$dir/.";
   $owner=$ENV{LOGNAME} or chomp($owner=qx(id -nu));
   $dir="$dir/emv-$owner";
   &setupworkdir($dir) or die "cannot setup workdir $dir\n";
   # the parens in the sort lines give the corresponding
   # values for sorting emv -l instead of normal emv lines
   $commentchar='"';
   $head=<<EOF;
${commentchar}emv:  edited mv       --      to rename, just change the filename below
${commentchar}      for programmatic filtering, consider piping regions to
${commentchar}              perl -00ne ':'   perl -alne 'print \@F[1..\$#F]'   awk  sed
${commentchar}              emvx [-r]                            (expand directories)
${commentchar}              emvp [-p|-i] perlop             (without myrename: emvp0)
${commentchar}              emvs [-r]   (sort keeping dirs and dir-children together)
${commentchar}              sed   cut -f 2-  sort -k 2.1   grep . (-l: -f 3-, -k 8.1)
${commentchar}      editors like vim complement this: :help range, :help visual-block
${commentchar}              :set number  :set list    :23,25s/^/#/   [V] + IDir/<ESC> 
${commentchar}              :sort /\\t/   [V]+:s=\\t=&Dir/=    :%g=X=d  :%g!/./d     gf
${commentchar}        (-l)  :sort /#\\t/  :.,\$s=#\\t=&Dir/=  :sort n/\\d\\+ \\d/r   [V]+gf
${commentchar}      emv line format is         <WS>* NUMBER                <TAB> NAME
${commentchar}                          (-l)   <WS>* NUMBER <TAB> #[META]# <TAB> NAME
${commentchar}cp/mv creat|touch ln/ln-s mkdir relink rm|rmdir|d sh (col1, runs first)
${commentchar}log:  $dir/*-$$ (incl. undo)
${commentchar}pwd:  $ENV{PWD}
EOF
# add a correct highlighting, e.g. the one from netrw (but not the keys)
# another option would be to add a line to vimrc
# hi clear Directory | hi link Directory PreProc "emv using ft=netrw
   $foot=<<EOF;

$commentchar to better see directories, try e.g. :hi link netrwDir Statement
$commentchar vim:filetype=netrw
EOF

   my @time=(localtime(time)); $time[4]++; $time[5]+=1900; 
   my $timestr=sprintf("%04d%02d%02d%02d%02d%02d",reverse(@time[0..5]));
                                                     # also in %ENV for e.g. emvx
   $ENV{orgfile}= $orgfile= "$dir/org-$timestr-$$";  # initial filelist
   $ENV{linfile}= $linfile= "$dir/lin-$timestr-$$";  # ditto, but numbered
   $ENV{newfile}= $newfile= "$dir/new-$timestr-$$";  # plus further mangling/commenting, also
                                                     # the file modified by the editor session
   $ENV{errfile}= $errfile= "$dir/err-$timestr-$$";  # error log
   $ENV{undfile}= $undfile= "$dir/und-$timestr-$$";  # undo log (can be used as a base to 
                                                     # create an undo shell script)
   $ENV{redofile}=$redofile="$dir/redo-$timestr-$$"; # redo log (similar to the above one)
   $ENV{edtfile}= $edtfile= "$dir/edt-$timestr-$$";  # archived result of the editor session
   unlink $orgfile, $newfile, $errfile, $undfile, $edtfile, $redofile;
   appendfile($undfile,"# reverse the lines before executing/copying the mv commands in this file (-> tac)");

   $shell=$ENV{EMVSHELL};
   $shellpreproc =$ENV{EMVSHELLPREPROC};  $shellpreproc ="set -o pipefail"          if not $shellpreproc;
   $shellpostproc=$ENV{EMVSHELLPOSTPROC}; $shellpostproc=""                         if not $shellpostproc;
   $shellteelog  =$ENV{EMVSHELLTEELOG};   $shellteelog  ='2>&1 | tee -a "$errfile"' if not $shellteelog;
   $shellpreproc.=";"                if $shellpreproc  and $shellpreproc !~/;\s*\z/;
   $shellpostproc=";".$shellpostproc if $shellpostproc and $shellpostproc!~/\A\s*;/;
   # no ';' for shellteelog; errfile has been also placed into %ENV

   if (not $shell){
      warn "# emv: consider setting \$EMVSHELL to a suitable shell\n";
      $shell=$ENV{SHELL} if not defined $shell or not -x $shell;
      $shell="/bin/sh"   if not defined $shell or not -x $shell;
      system($shell, "-c", "set -o pipefail");
      if ($shell=~/zsh|csh|dash/ or $?) { # unsuitable one incl. zsh, dash, csh, tcsh
         # NOTES
         # 1. zsh is also 'unsuitable by default' inspite of providing a pipestatus array:
         # Work around for zsh is to set EMVSHELL, set EMVPREPROC to say ' ' 
         # and have EMVSHELLPOSTPROC contain something like
         # '; _rc=0; for i in "$pipestatus[@]"; do echo $i; [ "$i" = "0" ] || _rc=$i; done; exit $_rc'
         # (untested; may need a bit of tweeking)
         # 2. to use unsuitable shells in general, consider removing pipefail and 
         #    logging altogether, which looses a bit of the safety features:
         #    export EMVSHELLTEELOG=' ';export EMVSHELLPREPROC=' ';export EMVSHELL=BADSHELL
         warn "# !! BAD SHELL  -  attempting other shells,  consider setting \$EMVSHELL\n";
         warn "# !! to the  path of  ksh  or  bash.  It must be a  Bourne-derived shell\n";
         warn "# !! that supports set -o pipefail.\n";
         warn "# !!\n";
         warn "# !!    (if you really _do_ insist on using a  different shell,  you may\n";
         warn "# !!     wish to try tweaking EMVSHELL/EMVPREPROC/EMVPOSTPROC/EMVTEELOG;\n";
         warn "# !!     search the source for pipefail for more information)\n";
         $shell="";
         for my $i (qw!/bin /usr/bin /opt/pkg/bin!) {
            for my $j (qw!bash ksh93 ksh!) { # even a mere pd-ksh should be suitable
               $shell="$i/$j" if not $shell or not -x $shell;
            }
         }
         system($shell, "-c", "set -o pipefail") if $shell;
         die "cannot find any sensible shell to continue\n" if $? or not $shell;
      }
   }
}

sub setupworkdir {
   my ($dir)=@_;
   mkdir $dir if not -d $dir;
   chmod 0700, $dir;
   return 0 if (stat $dir)[4] != $<;       # danger: ownership mismatch!?
   foreach (<$dir/???-*>, <$dir/????-*>) { # clean old logs
      unlink $_ if $time-(stat $_)[9]>$logmaxage;
   }
   return 1;
}

sub getfiles {
   # list file names from command line or stdin into temp files
   # remove trailing '/' of directories passed to allow intermediate renaming step
   push @orgfile,<*> if not $o_stdin and not $o_dirtree and not @ARGV;
   foreach (@ARGV) { push @orgfile, $_ if -e $_; }; @ARGV=();
   if ($o_stdin) {
      while(<STDIN>) {
         next if /^\s*[#"]/;
         next if not /\S/;
         push @orgfile, $_
      }
   }
   push @orgfile,qx(find . -type d|emvs -r) if $o_dirtree;
   &cleanexit(1) if not @orgfile;

   @orgfile=grep({s!/?\n?\z!!;1} @orgfile); # chomp and strip any trailing /

   if ($o_sort) {
      foreach(@orgfile) {
         while(s@/\./@/@g){;} s@/+@/@g; # cleanup spurious /
         s@/@\0@g;
      }
      if ($o_sort==2) {
         @orgfile=sort {$b cmp $a} @orgfile;
      } else {
         @orgfile=sort {$a cmp $b} @orgfile;
      }
      foreach(@orgfile) {s@\0@/@g};
   }

   arrayrefwrite($orgfile,\@orgfile); # log original files to both
   @newfile=@orgfile;
   arrayrefwrite($newfile,\@newfile); # orgfile and newfile
}

sub summarize {
   if ($convenience) {
      print "\n# Note: $convenience commands were executed before renaming.\n";
   }
   if ($changes) {
      not $convenience and (-s $undfile or -s $redofile) and print "\n";
      -s $undfile  and print "# Note: undolog    see $undfile (-> tac)\n";
      -s $redofile and print "# Note: redoscript see $redofile\n";
      ($errors or $errors_severe) and 
         print "# !!!!! errors occured: $errors, severe errors $errors_severe, suffix $tmpsfx\n";
      -s $errfile and print "# !!!!! errorlog   see $errfile\n\n" and
         system(qq!sed -e 's/^/   # /g' < '$errfile'!);
      not -s $errfile and not $errors and not $errors_severe and
         print "\n# All files have been successfully renamed/moved" . ( $mv eq 'noexec' ? " (noexec)": "" ) . "\n";
   } else { 
      # harmless, though we'd forget a cleanexit somewhere!?
      warn "# ASSERT \$changes=$changes!=0 FAILED!?";
      print "No files to rename.\n" 
   }
   open(FH,">>","/dev/tty"); print FH "\n"; close FH;
   cleanexit(0);
}

sub perlblock {
   # instead of calling on $EDITOR and the user, just use the 
   # perl expression from the -p option to modify names.
   # From global @orgfile to @newfile, with a copy in @edtfile
   # and the usual logfiles on disk.
   my($orgline);
   @newfile=();
   @edtfile=@orgfile;
   foreach(@edtfile) {
      $orgline=$_;
      eval $o_perlblock; die $@ if $@;
      chomp;
      $changes++ if $_ ne $orgline;
      push @newfile,$_;
   }
   arrayrefwrite($newfile,\@newfile);
   arrayrefwrite($edtfile,\@edtfile);
   if (not $changes) {
      print "# -p: no filenames changed - exiting.\n";
      cleanexit(0);
   }
}

sub addmetainfo {
   # go to the filesystem and append an extended copy of
   # the first array to the second
   my($linref,$newref)=@_;
   my(@s,@mt,$l,$n,$f,$mode,$meta,$mtime);
   foreach(@$linref) {
      next if not /^(\s*\d+)\t(.*)$/;
      ($n,$f)=($1,$2);
      @s     = lstat $f;
      if ($o_long) {
         # add "#[meta information]#"
         $l     = readlink $f;
         @mt    = localtime $s[9];
         $mtime = sprintf("%4d%02d%02d-%02d%02d%02d",1900+$mt[5],$mt[4]+1,$mt[3],@mt[2,1,0]);
         $mode  = sprintf(".%06o", $s[2]);
         # replace . by filetype code [dcbpl]
         $mode  =~s/^\.04/d04/; $mode =~s/^\.12/l12/; $mode =~s/^\.02/c02/; $mode =~s/^\.06/b06/; $mode =~s/^\.01/p01/;
         $meta  = sprintf("%7s %2d %8s %8s %11d %s",$mode,$s[3],getpwuid($s[4])."",getgrgid($s[5])."",$s[7],$mtime);
         $f.="/" if -d _;
         $tmp   = "$n\t#[$meta]#\t$f\n";
         $n     =~s/^ //; 
         # add a 2nd line containing the link target)
         $tmp  .= "$commentchar$n\t"." " x (length($meta)+4)."\t-> $l"  if $l and     -e $l;
         $tmp  .= "$commentchar$n\t"." " x (length($meta)+4)."\t!-> $l" if $l and not -e $l;
      } else {
         # just mark dirs by /
         $f.="/" if -d _;
         $tmp="$n\t$f";
      }
      push @$newref,$tmp;
   }
}


# editor session ------------------------------------------------


sub conveniencecommands {

   # allow the user to add commands in his renaming of files during
   # editing. Executed here, BEFORE &renaming. Command lines are
   # _INVALID_ and ignored afterwards.

   my($linref,$newref)=@_;
   my(@sh,$t,$tt,$l);

   # mostly NOT logged, so do NOT do complex things; 
   #                       do NOT rely on execution order
   # all single argument commands allow for a <NUMBER><TAB> prefix
   # in their input                                   (touch,mkdir,rm,l,=). 
   # two argument commands # _REQUIRE_ <NUMBER><TAB>  (ln)
   # zero argument commands do not care               (x)
   # sh can be called a magic single argument command (sh)
   #
   # x allows basic variable interpolation
   # shell variables $l<N> allow adding filenames to the filename in $l<N>

   # expand sh aliases inplace
   grep {s/^cp(\s+-\S+)?\s+/sh test ! -z "\$O" -a ! -z "\$N" && cp -i $1 -- "\$O" "\$N" #/;
         s/^mv(\s+-\S+)?\s+/sh test ! -z "\$O" -a ! -z "\$N" && mv -i $1 -- "\$O" "\$N" #/} @$newref;

   eval($o_perlposteditblock); die "# error in --perlposteditblock: ".$@ if $@; # don't continue
  
   # clear all list file name variables
   foreach(0..9){$ENV{"l$_"}=undef};$ENV{l}=undef; 

   if ($o_checkuserlines or $o_debug or $o_verbose) {
      my $i=1;
      foreach( @$newref) {
          next if    /^(rm(dir)?|d|=|x|sh|ln|mkdir|mdkir|touch|l\d?|re?li?nk#?|create?)[ \t]/;
          next if    /^\s*#/;
          next if    /^\s*$/;
          next if    /^\s*\d+\t/;
          warn "# ignoring line ". $i++ ." ". pr($_) . (/\n\z/ ? "" : "\n" ); # with pr()
      }
   }

   foreach(grep {    /^(rm(dir)?|d|=|x|sh|ln|mkdir|mdkir|touch|l\d?|re?li?nk#?|create?)[ \t]/} @$newref) {
      chomp; $ENV{O}=$ENV{N}=""; 
      # x: first a single round of variable expansion of $a, ${a} incl.
      # escaping the dollar sign (but ignoring quoting) to turn the line 
      # into either a standard rename or another non-^x command
      /^x +/                  and do{s{(?<!\\)(\\\\)*(\$[a-zA-Z_][a-zA-Z_0-9]*|\$\{[a-zA-Z_][a-zA-Z_0-9]*\})}
                                      {do{$t=$1;$tt=$2; $tt=~s!^\$\{?!!; $tt=~s!\}$!!; "$t$ENV{$tt}"}}ge; 
                                     s/^x +//; };                                                # for vim: "
      # NONE: set shell $O $N to the probable old and new filenames for this entry
      /^.*? +(\d+)[\t](\S.*)/ and $$linref[$1] and $2 
                              and do {$ENV{O}=$$linref[$1]; $ENV{N}=$2; chomp $ENV{O}; $ENV{O}=~s/^\s*\d+\t//};
      # = NAME VALUE: set shell variable NAME to value
      /^= +([a-zA-Z][a-zA-Z0-9_]*)\s+(.*)/ and do{$ENV{$1}=$ENV{N}?$ENV{N}:$2; push @sh, $_};
      # sh CMD: run shell command CMD (but w/o clobbering stdout)
      /^sh[ \t](.*)/          and do{$l=$1;
                                     if ($l=~/(.*)\s+#\s*(\d+)\t(.+?)$/){ 
                                        $l=$1; $ENV{N}=$3;
                                        chomp($ENV{O}=$$linref[$2]); $ENV{O}=~s/^\s*\d+\t//}
                                     print main::STDERR "# sh: ".pr($l); 
                                     print main::STDERR " (O: ".pr($ENV{O})." N: ".pr($ENV{N}).")" if $l=~/\$N|\$O/;
                                     print main::STDERR "\n";
                                     system(qq@{ $l\n } 1>&2 @);  
                                     if ($?) {
                                        print main::STDERR "# ERROR ", $?>>8, ": ".pr($_)."\n";
                                        s/^/WITH ERROR /; # also add a reminder to the problem to @sh
                                     }
                                     push @sh, $_}; 
      # l / l\d: appends name to corresponding list file $l / $l\d
      /^l(\d)\s+(.*)/         and do{$l=$ENV{N}?$ENV{N}:$2; 
                                     $ENV{"l$1"} eq "" and $ENV{"l$1"}="/dev/stderr"; 
                                     appendfile($ENV{"l$1"},"$2\n");
                                     push @sh, $_};
      # various one address commands
      /^(?:rm(?:dir)?|d)[ \t](.*)/   
                              and do{$l=$ENV{N}?$ENV{N}:$1; unlink $l or rmdir $l; push @sh, $_};
      /^(?:mkdir|mdkir)[ \t](.*)/    
                              and do{$l=$ENV{N}?$ENV{N}:$1; mkdir $l;              push @sh, $_};
      /^(?:touch|create?)[ \t](.*)/  
                              and do{$l=$ENV{N}?$ENV{N}:$1; utime(time, time, $l) or 
                                     open(FH,">> $l") and close(FH); push @sh, $_};
      # two address commands
      /^(?:ln)(-s)?[ \t](.*)/ and do{$l=$ENV{N}?$ENV{N}:$2; next if $ENV{O} eq ""; 
                                     if($1){symlink $ENV{O},$l}else{link $ENV{O},$l}; push @sh, $_};
      # relink can be used as a normal two address command, but also with
      # the second commented line created by the -l format, in which case
      # the name is taken from the linfile. It clobbers _only_ symlinks.
      /^(?:re?li?nk(?: *["#])?)[ \t]+(\d+)[\t ]+(?:!?-> )?(.*)/ # relink
                              and do{$ENV{N}=$2; $ENV{O}=$$linref[$1]; chomp $ENV{O}; $ENV{O}=~s/^\s*\d+\t//;
                                     $ENV{O} ne "" and $ENV{N} ne "" and 
                                        (-l $ENV{O} or not -e $ENV{O}) and
                                        do{system(q@ln -sf "$N" "$O"@); push @sh, $_}};
   } # foreach grep
   
   # summarize convenience commands
   if (@sh) {
      $convenience=$#sh+1;
      $l="# NOTE - $convenience convenience commands were executed before renames\n";
      open(FH, ">>", $undfile);  print FH $l, grep {s/^/#/;s/$/\n/} @sh; close FH;
      open(FH, ">>", $redofile); print FH $l, @sh; close FH;

      print main::STDERR "\n$l# see e.g. $redofile\n\n";
   }
   
}

sub parseeditorresults {
   my($linref,$newref)=@_;
   my (@lin,@new,%new);
   # $lin[$1] is the old name for /^(\d+)[\t]new name/
   @lin=map {s/^\s+//; $_} @$linref; 
   unshift @lin,""; # 1-base it
   @new=grep /\S/, map {s/^\s+//; s/^["#].*//;                     # skip comments
                        # did strip meta info here
                        s@/$@@;                                    # strip  dir-/
                        $_}      @$newref;

   conveniencecommands(\@lin,\@new);

   # undo the effects of the user randomly moving or deleting lines
   # for the eventual move of $lin[n] to $new{n} (ignores remnants of
   # convience commands or comments)
   foreach (@new) { 
      next if not /^\s*(\d+)\t(.*?[^\s].*)/; 
      $new{$1}=$2 if $2
   }  
   for(my $i=1;$i<@lin;$i++) {
      next if $new{$i}; 
      $new{$i}=$2 if $lin[$i]=~/^\s*(\d+)\t(.*)/
   } 
   
   # return the new and now resynchronized-to-@lin filelist
   @$newref=();
   foreach(sort {$a<=>$b} keys %new) {
      push @$newref, $new{$_} if $new{$_} ne ""
   }
}

sub editorsession {
   # may need to loop for multiple editor invocations
   # in case the editor buffer has become way inconsistent
   # with o_delta, return just before invoking the editor

   # NOTE that the file number is EXPRESSLY NOT
   #      identical to the array indices 
   #      (+-1, $o_delta, comments, whitespace and headers)

   while(1) {
      # PJ add line numbers around the editor call, thus allowing reordering and 
      #    deletion of lines with files to ignore plus some convenience command hacks
      #    nl format "some spaces . NUMBER . TAB . filename incl. spaces . \n"
      my $startnum=1;

      # emvx / $o_delta: start linenumbering at eof "within" a previous session
      if($o_delta) { 
         arrayrefread($deltaorg,\@deltaorg);
         $startnum=2+$#deltaorg;
      }

      my $i=$startnum; @linfile=map {sprintf("%5d",$i++)."\t".$_} @newfile;
      arrayrefwrite($linfile,\@linfile);
  
      # prepare the content for the editor buffer in @newfile
      @newfile=(); 
      push @newfile,$head . "\n" if ($head and not $o_delta);
      addmetainfo(\@linfile,\@newfile);
      push @newfile,$foot        if ($foot and not $o_delta);
     
      if ($o_delta) {
         arrayrefappend($deltaorg,\@orgfile); # not @newfile
         arrayrefappend($deltalin,\@linfile);
         foreach(@newfile) { print $_, (/\n\z/ ? "" : "\n"); } # DO NOT USE pr() here!
         sleep 2 if $o_debug;
         return # emvx / $o_delta
      }
  

      arrayrefwrite($newfile,\@newfile);
      sleep 2 if $o_debug;
      if (-t main::STDIN) { # we're interactive with a valid tty
        system qq@$edit "$newfile"@;
      } else {
         # workaround 1: for find/xargs: <&1 prevents that $editor
         #  gets confused by /dev/null being attached to stdin; not 
         #  all editors are able to find an appropriate terminal, though.
         #  (workaround update PJ: to allow emv to be used as filter 
         #  on lines containing filenames from within an emv / editor session,
         #  we need to explicitely provide the ttys to non-X editors.)
         # workaround 2: use ^z and/or ^l to restore tty
         #  sanity when invoking emv from within an editor
         system qq@$edit "$newfile" </dev/tty >/dev/tty #<&1@;
      }
      sleep 2 if $o_debug;
      print "\n\n";

      arrayrefread($orgfile,\@orgfile);
      arrayrefread($linfile,\@linfile);
      arrayrefread($newfile,\@newfile);
      # log to disk and resync edited filelist to orgfile/linfile
      arrayrefwrite($edtfile,\@newfile); # backup editor output to $edtfile
                        
      # protect from accidental mix of -l / normal mode - we don't
      # really want to rename all files using the meta information...
      if (not $o_long and grep {/^((?:[a-z]\S*)?\s*\d+\t)#\[[^\]]{10,80}?\]#\t/} @newfile) {
         print "\n? emv detected possible meta info - do you wish to activate -l long mode ?\n" .
                 "[ skip if you never used emvx -l, otherwise one of [yYjJ] to activate ]\n";
         open(FH, "<", "/dev/tty") and $_=<FH>; close FH;
         if (/^[YyjJ]$/) {
            $o_long=1;
            print "# possible meta info detected: activating -l mode: stripping meta info\n";
         } else {
            print "# possible meta info detected: requested to not activate -l mode\n";
         }
      }
      grep {s/^((?:[a-z]\S*)?\s*\d+\t)#\[[^\]]{10,80}?\]#\t/$1/} @newfile if $o_long; # strip meta

      parseeditorresults(\@linfile,\@newfile);
      arrayrefwrite($newfile,\@newfile); # write resynchronized @newfile

      # loop in case of file loss during editing
      if($#newfile != $#orgfile) {
         print "# ERROR: line count doesn't match by ". ( $#newfile - $#orgfile ) ." lines.\n";
         print "# tempfiles are in $dir ($$)\n";
         print "# [QUIT to exit, otherwise relaunching $edit]\n"; 
# use orgfile or edtfile on relaunch instead?
# for now orgfile, user has edtfile in the filesystem for reference
         open(FH,"<","/dev/tty") and $_=<FH>; close FH;
         &cleanexit(20) if /^quit/i;
      } else {
         last;
      }
   }

   
   $changes=0; foreach(0..$#orgfile) {
      $changes++ if $orgfile[$_] ne $newfile[$_];
   }
   cleanexit(0) if not $changes;
}


# renaming logic --------------------------------------------------------

# as with the shell version, this version
# - logs immediately to disk after each command of interest
# - it uses shell commands for the actual move
#   (they've a more shell-conformant semantic when 
#    compared with the builtin rename()), even when
#   the user doesn't actually request a shell command
#   of his own. In order to both see the error in errfile
#   AND on the tty AND the error code, we use set -o pipefail
#   which more or less requires a bash or ksh, NOT some 
#   strictly posixish shell like dash.
# - as we're building shell command lines anyway, we
#   also use the as the log format, which thus becomes
#   scripts for redoing/undoing the moves.

sub appendfile2 {
   my($log, $msg, $class, $cnt, $file1, $file2)=@_;
   $class="#INTERMEDIATE-$cnt"        if $class eq "1";
   $class="#FINAL-$cnt"               if $class eq "2";
   $class="#REVOKE-INTERMEDIATE-$cnt" if $class eq "3";
   $file1="'".$file1."'";
   $file2="'''".$file2."'''";
   appendfile($log, sprintf "%-10s %-30s %-34s %s", $msg, $file1, $file2, $class);
}


sub renaming {
   my($org1ref, $org2ref, $new1ref, $new2ref)=([],[],[],[]);

   renaming2(\@orgfile, \@newfile);

   if ($changes) {
      appendfile($undfile, "\n# actually used command in intermediary pass was: $mv\n"  .
                             "# actually used command in final        pass was: $mv2\n" .
                             '# override with e.g. function mv { /bin/mv -i -- "$1" "$2";}'."\n" .
                             "# temporary suffix was: $tmpsfx") if -s $undfile;
      appendfile($redofile,"\n# actually used command in intermediary pass was: $mv\n".
                             "# actually used command in final        pass was: $mv2\n" .
                             '# override with e.g. function mv { /bin/mv -i -- "$1" "$2";}'."\n" .
                             "# temporary suffix was: $tmpsfx") if -s $redofile;
   }
   if (@pathtrack) {
      appendfile($undfile,"\n################################################\n# \@pathtrack:\n");
      arrayrefappend($undfile,[map {"# '". $_->[0] ."' -> '". $_->[1] ."'"} @pathtrack]);
   }
   if (@pathtracked) {
      appendfile($undfile,"#\n# the following renames were pathtracked (orig tmp new):\n");
      arrayrefappend($undfile,\@pathtracked);
   }
}

sub tracked {
   # for now, do NOT care about canonical names, not even a leading ./
   my($_)=@_;
   my($o, $n, $in, $out, $i, $l, $c);
   $in=$out=$_;
   warn "# WRN pathtracking - please try to avoid pathes with /../ or /./ in input\n" if $in=~m@/\.?\./|^\.?\./|/\.?\.$@ and not $dotwarned++;
   foreach $i (@pathtrack){    # check+apply dir renames in chronological order
      ($o,$n)=@$i;
      $l=length($o);
      if ($o eq substr($out,0,$l)) {
         #if ($l==length($out) or "/" eq substr($out,$l,1)) {
         if (                     "/" eq substr($out,$l,1)) { # DO NOT rename an exact matching (orgline) of a successful rename...
            $c++;
            # warn "# TRK . ".pr($o)." -> $n\n";
            substr($out,0,$l)=$n;
         }
      } 
   }
#warn "# TRK = ".pr($in)." -> ".pr($out)." ($c changes)\n" if $c;
   return $out;
}

sub renaming2 {
   # for now use appendfile and dump logs to disk immediately 
   # using @undfile/@redofile. That way we've partial logs
   # in case of user abort... . And if we want to create
   # shell script statements, we can just use the very
   # statements ourselves. As a side effect, gnu mv also
   # extends renames across FS boundaries (at the cost of
   # speedy reporting renames and errors). We also can
   # use the same code to have the user substitute a command
   # of his own. (with $2 being the intermediate name)
   
   my($orgref, $newref)=@_;

   my($orgline,$orgline0,$newline0,$tmpline,$newline,$escorgline,$escnewline,$esctmpline,$tmpline1,@pass2,$undo,$cnt);
   my($dsttag,$dstline,$escdstline);
   my($pass);

   # pass one - rename to intermediary
   $pass=1;
   foreach $cnt (1..$#$orgref+1) {
      ($newline,$orgline)=($$newref[$cnt-1], $$orgref[$cnt-1]); 
      $orgline=~s!/\.?$!!g;
      $newline=~s!/\.?$!!g; 
      next if $newline eq "" or $orgline eq "" or $newline eq $orgline; # possible user error - just skip
      if ($newline=~s/\n/\?/g or $orgline=~s/\n/\?/g) { 
          appendfile($errfile,  "#ERROR '$orgline'/'$newline' has embedded newlines - skipping.");
          appendfile($redofile, "#ERROR '$orgline'/'$newline' has embedded newlines - skipping.");
          appendfile($undfile,  "#ERROR '$orgline'/'$newline' has embedded newlines - skipping.");
          printf "!! name with \\n: %s/%s\n", pr("'$orgline'"), pr("'$newline'");
          $errors++;
          $errors_severe++;
          next;
      }

      ($newline0,$orgline0)=($newline,$orgline);
      $newline   =tracked($newline); $orgline   =tracked($orgline); $tmpline   =tracked($orgline.$tmpsfx); $tmpline1=$tmpline;
      if ($o_renametodir and not $mv2 and -d $newline) {
         # in case of single pass mode: modify newline to newline/$(basename origline)
         my $base=$orgline; 
         $base =~ s!.*/!!;
         $newline.="/$base";
         $newline =tracked($newline);
      }
      if ($o_perlcmdblock) {
         eval $o_perlcmdblock; die "#ERROR: perlcmd $@" if $@;
      } 
      $escnewline=     sq($newline); $escorgline=     sq($orgline); $esctmpline=     sq($tmpline);

      $tmp="   ";
      $tmp=~s/^ /O/      if $orgline ne $orgline0;
      $tmp=~s/ $/N/      if $newline ne $newline0;
      $tmp=~s/ (?=.$)/T/ if $tmpline ne $tmpline1;
      push @pathtracked, "# $tmp '$orgline0' > '$orgline' '$tmpline1' > '$tmpline' '$newline0' > '$newline'\n" if $tmp=~/\S/ and not $o_nopathtrack;

# that dest dir case skipping the intermediate shouldn't be required (I)
#
#     if (-d $newline) {$tmpline=$orgline; $esctmpline=sq($tmpline)}
#     if (not -d $newline) {
         # do an intermediate renaming step to allow
         # simple name exchanges. This is NOT a generic solution to copy 
         # with naming cycles.
         $dstline   = $mv2 ? $tmpline       : $newline;
         $escdstline= $mv2 ? $esctmpline    : $escnewline;
         $dsttag    = $mv2 ? "INTERMEDIATE" : "FINAL";
         $ENV{orgline}=$orgline;
         $ENV{tmpline}=$tmpline;
         $ENV{newline}=$newline;
         $ENV{srcline}=$orgline;
         $ENV{dstline}=$dstline;
         if ($mv) {
            my $tmpcmd="$mv '$escorgline' '$escdstline'";
            if (-e $dstline) {
               appendfile( $errfile, "# File '$dstline' already exists - '$orgline' remains unchanged.");
               appendfile( $undfile, "# File '$dstline' already exists - '$orgline' remains unchanged. #$dsttag-$cnt");
               printf "!!%-25s -> %-25s %s", pr("'$orgline0'"), pr("'$dstline'") , ( $tmp!~/\S/ ? "\n" : pr(" (Trk $tmp:$orgline)")."\n");
               $errors++; next;
            }
            if ($mv ne "noexec") {
# DISK1 pass1: user-specified mv, possibly interactive with mv -i
               system($shell, "-c", qq!$shellpreproc $tmpcmd $mvtty $shellteelog $shellpostproc!);
            } else {
               noexec($tmpcmd); $?=0;
            }
            print  "!!" if $?;
            print  "  " if not $? and not $mv2;
            printf "%-25s -> %-25s %s", pr("'$orgline0'"), pr("'$dstline'") , ( $tmp!~/\S/ ? "\n" : pr(" (Trk $tmp:$orgline)")."\n") if $? or not $mv2;
            if ($?) {
               appendfile2($undfile, "#ERROR $mv", 1, $cnt, $escdstline, $escorgline);
               appendfile2($redofile,"#ERROR $mv", 1, $cnt, $escorgline, $escdstline);
               $errors++; next;
            } else {
               appendfile2($undfile, $mv ,         1, $cnt, $escdstline, $escorgline);
               appendfile2($redofile,$mv ,         1, $cnt, $escorgline, $escdstline);
               push @pass2,[$cnt, $orgline, $tmpline, $newline,$orgline0,$tmpline1,$newline0] if $mv2;
               push @pathtrack,[$orgline, $tmpline] if not $o_nopathtrack and -d "$dstline/."; # do track for noexec as well.
            }
         } else {
            die "# aborting -  no pass1 command (--cmd)\n";
         }
# that dest dir case skipping the intermediate shouldn't be required (II)
#     } else {
#        # pass2 deals with dir targets
#        push @pass2,[$cnt, $orgline, $tmpline, $newline];
#     }
   }
   

   # pass two - rename intermediaries to final name
   $pass=2;
   foreach(@pass2) {
      $undo=0;
      ($cnt, $orgline, $tmpline, $newline, $orgline0,$tmpline1,$newline0) = @$_;
      $newline   =tracked($newline); $orgline   =tracked($orgline); $tmpline   =tracked($tmpline);
      if ($o_renametodir and $mv2 and -d $newline) {
         # only if not already done above:
         # modify newline to newline/$(basename orgline)
         my $base=$orgline; 
         $base=~s!.*/!!;
         $newline.="/$base";
         $newline =tracked($newline);
      }
      if ($o_perlcmdblock) {
         eval $o_perlcmdblock; die "#ERROR: perlcmd $@" if $@;
      } 
      $escnewline=     sq($newline); $escorgline=     sq($orgline); $esctmpline=     sq($tmpline);

      $tmp="   ";
      $tmp=~s/^ /O/      if $orgline ne $orgline0;
      $tmp=~s/ $/N/      if $newline ne $newline0;
      $tmp=~s/ (?=.$)/T/ if $tmpline ne $tmpline1;
      push @pathtracked, "# $tmp '$orgline0' > '$orgline' '$tmpline1' > '$tmpline' '$newline0' > '$newline'\n" if $tmp=~/\S/ and not $o_nopathtrack;
      $ENV{orgline}=$orgline;
      $ENV{newline}=$newline;
      $ENV{tmpline}=$tmpline;
      $ENV{srcline}=$tmpline;
      $ENV{dstline}=$newline;

      if (-e $newline) {
         appendfile( $errfile, "# File '$newline' already exists - '$orgline' remains unchanged.");
         printf "!!%-25s -> %-25s %s", pr("'$orgline0'"), pr("'$newline'") , ( $tmp!~/\S/ ? "\n" : pr(" (Trk $tmp:$orgline)")."\n");
         $undo=1;
      } else {
         my $tmpcmd="$mv2 '$esctmpline' '$escnewline'";
         if ($mv ne "noexec") {
# DISK2 pass2:
            system($shell, "-c", qq!$shellpreproc $tmpcmd $mvtty $shellteelog $shellpostproc!); 
         } else {
            noexec($tmpcmd); $?=0;
         }
         print $? ? "!!" : "  ";
         printf "%-25s -> %-25s %s", pr("'$orgline0'"), pr("'$newline'") , ( $tmp!~/\S/ ? "\n" : pr(" (Trk $tmp:$orgline)")."\n");
         if ($?) {
            appendfile2($undfile, "#ERROR $mv2", 2, $cnt, $escnewline, $esctmpline);
            appendfile2($redofile,"#ERROR $mv2", 2, $cnt, $esctmpline, $escnewline);
            $undo=1;
         } else {
            appendfile2($undfile, $mv2,          2, $cnt, $escnewline, $esctmpline);
            appendfile2($redofile,$mv2,          2, $cnt, $esctmpline, $escnewline);
            push @pathtrack,[$tmpline, $newline] if not $o_nopathtrack and -d "$newline/.";
         }
      }
      if ($undo and $tmpline eq $orgline) {
         # nothing to undo, error already reported (error in mv to $newline/.)
         # this should currently not be reachable 
         $errors++;
      } elsif ($undo) {
         $errors++; $tmp="";
         if ($mv2 ne "noexec") {
            if (-e $orgline) {
               ($errors_severe, $tmp)=($errors_severe+1, "#ERROR EXISTS ");
            } else {
# DISK3 "pass3": definitely non-interactive invocation of the real mv [-i as safety net, but no tty]
               system($shell, "-c", qq!$shellpreproc mv -i -- '$esctmpline' '$escorgline' </dev/null $shellteelog $shellpostproc!);
               if ($?) {
                  ($errors_severe, $tmp)=($errors_severe+1, "#ERROR MV ") if $?;
               }else{
                  # tracing and finding the corresponding original might be a tad
                  # difficult, so just add a pathtracked rename to undo the harm
                  push @pathtrack,[$tmpline, $orgline] if not $o_nopathtrack and -d "$orgline/.";
               }
            }
         }
         appendfile2($undfile, "${tmp}mv -i --",  3, $cnt, $escorgline, $esctmpline);
         appendfile2($redofile,"${tmp}mv -i --",  3, $cnt, $esctmpline, $escorgline);
      }
   }
}

# -----------------------------------------------------------------
__END__
