The first version of this (from 20 years ago) I wrote in C because I found that I had a use for such a tool "everywhere" and I worked in a lot of environments that didn't have Perl handy. A while back I rewrote it in Perl because now I had found that it was easier to get it running in most environments via Perl than via a C compiler (and because I had some enhancements I wanted to make and they were certainly easier to make in Perl than they would have been to make in C). I like how times have changed in that regard.
One of the most recent enhancements was dealing with arbitrarily badly named files. It doesn't allow me to create arbitrarily bad file names, but it does let me fix arbitrarily bad file names. If I have what looks like a bizarrely named file, I can just "mvi *" and be sure to be able to fix it.
Another recent feature addition was being able to read filenames from stdin. This means I can pipe /bin/find to mvi to organize a whole directory tree. I also find it useful for sorting the files by date or size (assuming I have an 'ls' that knows how to sort, which I usually do) so I can delete the least useful of the oldest or largest files in some directory.
#!/usr/bin/perl -w
use strict;
use File::Copy qw< copy move >;
use File::Spec qw< >;
my $TmpDir= File::Spec->tmpdir();
my $IsDOS= $^O =~ /Win32/;
my $Editor= $ENV{VISUAL} || $ENV{EDITOR};
my $Quiet= 0; # Don't echo each operation
my $Ask= 0; # Ask before overwriting a file
my $Overwrite= 0; # Default to overwriting files
my $Pause= 0; # User must hit "Enter" before editor is launched
my $Self= ( $0 =~ m-(?:^|[/\\])([^/\\]+?)(?:\.[^/\\.]*)?$- )[0] || $0;
Main( @ARGV );
exit;
sub Def
{
my $ret;
do {
$ret= shift @_;
} while( ! defined $ret && @_ );
return $ret;
}
sub IllegalName
{
my( $file )= @_;
return $file =~ /^\s|\s\s|[^ -~]|\s$/;
}
sub DumpStr
{
my( $str )= @_;
require Data::Dumper;
for( Data::Dumper->new([$str],['x'])->Terse(1)->Useqq(1)->Dump()
+ ) {
s/^"//;
s/"\s*\z//;
return $_;
}
}
sub PreProcessFiles
{
for my $file ( @_ ) {
if( IllegalName( $file ) ) {
$Pause= 1;
my $desc= DumpStr( $file );
( my $clean= $file ) =~ s/[^ -~]+//g;
$clean =~ s/(^)? +(\z)?/Def($1,$2,' ')/eg;
if( $file !~ /\0/ && -e $file && $clean && ! -e $cl
+ean ) {
warn "Removing bad characters/spaces from filename ($d
+esc)!\n";
rename( $file, $clean )
or die "Can't clean filename ($desc) to $clean: $
+!\n";
$file= $clean;
} else {
die "Bad file name ($desc) but won't be renamed!\n";
}
}
if( ! -e $file ) {
$file= "# No such file: $file";
} else {
$file .= '/'
if( -d $file && $file !~ m-[/\\]$- );
$file= "=$file";
}
}
}
sub WriteWorkFile
{
my( $workfile, @files )= @_;
open TMP, '>', $workfile
or die "Can't create $workfile: $!\n";
print TMP <<"END", join "\n", @files, '';
# Edit to rename file, "D=file" deletes, "L=dest" links, "C=dest" copi
+es.
# Insert "MD=dir" line to make a new directory.
# Save no edits or empty file to abort.
END
close TMP;
}
sub MakeNewDirs
{
my( @newDirs )= @_;
for my $dir ( @newDirs ) {
if( -d $dir ) {
warn "mkdir $dir: Already exists.\n";
} elsif( mkdir( $dir ) ) {
warn "mkdir $dir\n";
} else {
warn "Can't mkdir $dir: $!\n";
}
}
}
sub ReadWorkFile
{
my( $avNew, $avFiles, $workfile )= @_;
open TMP, '<', $workfile
or die "Can't read $workfile: $!\n";
s/\s*\z//
for my @lines= <TMP>;
close TMP;
my @newDirs;
@lines= grep {
if( ! /\S/ || /^\s*#/ ) {
0;
} elsif( /^\s*MD\s*=\s*(\S.*)/i ) {
push @newDirs, $1;
0;
} else {
1;
}
} @lines;
@$avFiles= grep ! /^\s*#/, @$avFiles;
die "Aborting (further) changes.\n"
if( ! @lines );
die "Don't delete ", @$avFiles - @lines, " (non-comment) lines!\n"
if( @lines < @$avFiles );
die "Don't insert ", @lines - @$avFiles, " (non-comment) lines!\n"
if( @$avFiles < @lines );
MakeNewDirs( @newDirs );
@$avNew= @lines;
}
sub DeletedFile
{
my( $old, $new, $idx, $hvOld, $hvCnt, $op )= @_;
if( $new =~ /^\s*D\s*=\s*(\S.*)/i ) {
die "Mis-edit from (=$old) to ($new).\n"
if( $1 ne $old );
warn "rm $old\n"
if ! $Quiet;
if( ! unlink( $old ) ) {
warn "Can't delete $old: $!\n";
} else {
$hvCnt->{rm}++;
}
return 1;
}
my $dest= $new;
if( $dest !~ s/^\s*(?:([a-z]+)\s*)?=\s*//i ) {
warn "Ignoring mis-edit from (=$old) to ($new).\n";
return 1;
}
if( ! $1 ) {
return 1
if( $old eq $dest );
$hvOld->{ $old }= $idx || '00';
} else {
$op= uc( $1 );
if( $op !~ /^[CL]$/ ) {
warn "Ignoring unrecognized directive ($op) in ($new)\n";
return 1;
}
}
if( IllegalName( $dest ) ) {
$dest= DumpStr( $dest );
warn "Bad characters in destination ($dest); skipping.\n";
return 1;
}
$_[1]= $dest;
$_[-1]= $op;
return 0;
}
sub DeleteFiles
{
my( $avFiles, $avNew, $avOp, $hvOld, $hvCnt )= @_;
s/^=//
for @$avFiles;
my @idx= grep
! DeletedFile(
$avFiles->[$_], $avNew->[$_],
$_, $hvOld, $hvCnt, $avOp->[$_],
),
0 .. $#$avNew;
return @idx;
}
sub Summarize
{
my( $hvCnt )= @_;
my %desc= (
mv => 'Renamed',
ln => 'Linked',
cp => 'Copied',
rm => 'Deleted',
);
my $sum= '';
%$hvCnt= ( mv => 0 )
if ! %$hvCnt;
for my $key ( sort keys %$hvCnt ) {
my $desc= $desc{$key} || $key;
$sum .= "$desc $hvCnt->{$key}, ";
}
$sum =~ s/, $/ files.\n/;
warn $sum;
}
sub OverWriteFile
{
my( $new )= @_;
my $overwrite= $Overwrite;
if( $Ask ) {
my $default= $overwrite ? 'Yes/n/a/z/?' : 'y/No/a/z/?';
my $answer= '?';
while( '?' eq $answer ) {
print STDERR "Overwrite $new? ($default): ";
defined( $answer= <STDIN> )
or die "Error reading response.\n";
if( $answer =~ /^\s*y(es)?\s*$/i ) {
$overwrite= 1;
} elsif( $answer =~ /^\s*no?\s*$/i ) {
$overwrite= 0;
} elsif( $answer =~ /^\s*a(lways)?\s*$/i ) {
$overwrite= $Overwrite= 1;
$Ask= 0;
} elsif( $answer =~ /^\s*z(ero)?\s*$/i ) {
$overwrite= $Overwrite= 0;
$Ask= 0;
} elsif( $answer !~ /\S/ ) {
; # Just use default
} else {
$answer= '?'; # Ask again
warn "Please answer: 'Yes', 'No', 'All', 'Zero', or bl
+ank\n";
}
}
}
if( ! $overwrite ) {
warn "Won't overwrite $new.\n";
return;
}
my $temp= TempFile( $new );
if( ! rename( $new, $temp ) ) {
warn "Can't rename $new to $temp: $!\n";
warn "Won't overwrite $new.\n";
return;
}
return $temp;
}
sub ProcessFile
{
my( $op, $file, $new, $hvOld, $hvCnt )= @_;
my $temp;
if( -e $new ) {
$temp= OverWriteFile( $new );
return
if ! $temp;
}
my $did= '';
if( ! $op ) {
# Are there still cases /bin/mv handles that rename() doesn't?
warn "mv $file $new\n"
if ! $Quiet;
if( ! rename( $file, $new ) ) {
warn "Can't rename $file to $new: $!\n";
} else {
$did= 'mv';
delete $hvOld->{ $file };
}
} elsif( 'L' eq $op ) {
warn "ln $file $new\n"
if ! $Quiet;
if( ! link( $file, $new ) ) {
warn "Can't link $file to $new: $!\n";
} else {
$did= 'ln';
}
} elsif( 'C' eq $op ) {
# I'm tempted by system("/bin/cp","-p",...) if -x /bin/cp
warn "cp $file $new\n"
if ! $Quiet;
if( ! copy( $file, $new ) ) {
warn "Can't copy $file to $new: $!\n";
} else {
$did= 'cp';
}
} else {
die "Impossible operation ($op) for $file.\n";
}
if( $did ) {
$hvCnt->{$did}++;
unlink( $temp )
or warn "Can't delete $temp: $!\n"
if $temp;
} else {
rename( $temp, $new )
or warn "Can't restore $temp to $new: $!\n"
if $temp;
}
}
sub TempFile
{
my( $path )= @_;
my( $vol, $dir, $file )= File::Spec->splitpath( $path );
my $t= 0;
my $temp;
do {
$temp= File::Spec->catpath( $vol, $dir, "mvi$t-$file" );
$t++
} while( -e $temp );
return $temp;
}
sub ProcessEdits
{
my( $workfile, @files )= @_;
my @new;
ReadWorkFile( \@new, \@files, $workfile );
my @op;
my %old;
my %cnt;
my @idx= DeleteFiles( \@files, \@new, \@op, \%old, \%cnt );
while( @idx ) {
my $count= 0+@idx;
@idx= grep {
if( $old{ $new[$_] } ) {
# Delay this op until our destination gets moved
1;
} else {
ProcessFile( $op[$_], $files[$_], $new[$_], \%old, \%c
+nt );
0;
}
} @idx;
if( $count == 0+@idx ) {
# Didn't make any progress, so split a rename loop:
# a -> mvi0-a
# a -> b mvi0-a -> b
# b -> a
keys %old;
my $i= ( each %old )[1];
my $j= 0+@files;
$old{ $files[$i] }= $j;
$files[$j]= $files[$i];
$new[$j]= TempFile( $files[$i] );
$files[$i]= $new[$j];
unshift @idx, $j;
}
}
Summarize( \%cnt );
}
sub BeforeEditor
{
my( $workfile )= @_;
if( $Pause ) {
warn "(Exit forthcoming editor to continue.)\n";
print STDERR "Press Enter to launch $Editor $workfile: ";
my $wait= <STDIN>;
} elsif( ! $Quiet ) {
warn " ] $Editor $workfile\n";
warn "(Exit editor to continue.)\n";
}
}
sub FindCmd
{
my( @cmds )= @_;
my @exts= !$IsDOS ? () :
split ';', $ENV{PATHEXT} || '.COM;.EXE;.BAT;.CMD';
for my $bin ( File::Spec->path() ) {
for my $cmd ( @cmds ) {
my( $file )= split ' ', $cmd;
$file= File::Spec->catfile( $bin, $file );
if( -x $file ) {
return $cmd;
}
for my $ext ( @exts ) {
if( -f $file.$ext ) {
return $cmd;
}
}
}
}
return '';
}
sub Usage
{
my( @message )= @_;
warn @message, $/
if @message;
$Editor ||= "anEditor";
my $item= $IsDOS ? "wildcard" : "filename";
warn <<"END";
Usage: $Self [-aoq] [-] [--] [ $item [...] ]
Lets you use $Editor to rename (or copy, delete, or link) files.
END
exit 1
if( @message );
if( $Pause ) {
warn "Set the EDITOR (or VISUAL) environment variable",
" to your favorite editor.\n";
}
warn <<"END";
-: Reads filenames from STDIN, one per line
--: Treats remaining arguments as ${item}s
-q: Quiet; don't describe each successful operation
-o: Overwrite existing files (if no -a, then doesn't even ask)
-a: Ask before overwriting existing files
By default, refuses to overwrite existing files (and doesn't ask t
+o)
END
exit 1
}
sub CmdLine
{
my( @args )= @_;
while( @args && $args[0] =~ /^-/ ) {
my $arg= shift @args;
if( '--' eq $arg ) {
last;
}
if( '-' eq $arg ) {
chomp( my @input= <STDIN> );
return @input, @args;
}
$arg =~ s/^-//;
while( '' ne $arg ) {
if( $arg =~ s/^h// ) {
Usage( );
} elsif( $arg =~ s/^q// ) {
$Quiet= 1;
} elsif( $arg =~ s/^o// ) {
$Overwrite= 1;
} elsif( $arg =~ s/^a// ) {
$Ask= 1;
} else {
Usage( "Unrecognized option (-$arg)." );
}
}
}
return @args;
}
sub Main
{
my @files= CmdLine( @_ );
if( ! $Editor ) {
# User didn't already pick an editor
$Pause= 1; # So delay before starting (possibly wrong) editor
$Editor= FindCmd( "vim", "emacs -nw", "vi", "notepad" )
or die "Can't find an editor, ",
"please set EDITOR environment variable.\n";
}
if( ! @files ) {
Usage( qq<Type "$Self -h" for more help.> );
}
if( $IsDOS ) {
require File::Glob;
File::Glob->import(
qw< bsd_glob GLOB_NOCASE GLOB_NOCHECK GLOB_BRACE >,
);
my $flags= GLOB_NOCASE() | GLOB_NOCHECK() | GLOB_BRACE();
@files= map bsd_glob($_,$flags), @files;
}
PreProcessFiles( @files );
my $workfile= "$TmpDir/mvi$$.tmp";
if( $IsDOS ) {
$workfile =~ s-\\-/-g; # Prevent vim from chdir'ing to $TmpDi
+r
}
my $ok= eval {
WriteWorkFile( $workfile, @files );
BeforeEditor( $workfile );
$!= 0;
my $status= system( "$Editor $workfile" );
if( 0 != $status ) {
my $sig= $status & 127;
my $core= ( $status & 128 ) ? " (core dumped)" : '';
my $exit= $status >> 8;
my $error= "unknown reason";
if( -1 == $status ) {
$error= "$!" || "unknown error";
} elsif( $sig ) {
$error= "killed by sig $sig$core";
} elsif( $exit ) {
warn "Ignoring non-zero exit ($exit) from editor.\n";
$error= '';
}
die "Error running '$Editor $workfile': $error.\n"
if $error;
}
ProcessEdits( $workfile, @files );
1;
};
if( ! $ok ) {
warn $@ || "Unknown failure!\n";
sleep( 2 ); # So you can Ctrl-C to prevent unlink($workfile)
}
unlink( $workfile )
or warn "Can't remove $workfile: $!\n";
return ! $ok;
}
