http://www.perlmonks.org?node_id=852387

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; }

- tye        

Replies are listed 'Best First'.
Re: mvi -- mv+vi (+ln+rm+cp+mkdir)
by ambrus (Abbot) on Aug 02, 2010 at 06:22 UTC
Re: mvi -- mv+vi (+ln+rm+cp+mkdir)
by alexbio (Monk) on Aug 02, 2010 at 20:23 UTC

    What about using symlink on directories (I needed it)?

    Just a simple example that works quite well (I haven't tested it extesively).

    if( (-f $file) and ( ! link( $file, $new )) ) { warn "Can't link $file to $new: $!\n"; } elsif( (-d $file) and ( ! symlink( $file, $new )) ) { warn "Can't symbolic link $file to $new: $!\n"; } else { $did= 'ln'; }

    In the ProcessFile subroutine.

    And recursive directory structure creation (just like mkdir -p)?

    This is made using the subroutine make_path in File::Path instead of mkdir to create directories.

    use File::Path qw< make_path >; # this should be added at the t +op sub MakeNewDirs { my( @newDirs )= @_; for my $dir ( @newDirs ) { if( -d $dir ) { warn "mkdir $dir: Already exists.\n"; } elsif( make_path( $dir ) ) { warn "mkdir $dir\n"; } else { warn "Can't mkdir $dir: $!\n"; } } }

    Anyway thank you for sharing.

    Alex's Log - http://alexlog.co.cc

      I usually want to be told when I typo part of the path. And, since I'm in vim, it isn't hard to expand "MD=foo/bar/baz" to add "MD=foo" and "MD=foo/bar". But I can see wanting to avoid such machinations. Perhaps MP= makes sense.

      As I was posting this, I briefly wondered why I hadn't added support for creating symbolic links (other than "never needed it, yet"). Thinking about it more now that you've asked, I see some problems with supporting such. There are lots of ways to make a symbolic link that points to an existing file or directory and I don't yet see a clear way to distinguish between the cases via this interface.

      Consider "mvi foo/*" and then changing "=foo/bar" to "S=foo/baz". You probably want the equivalent of

      % ln -s bar foo/baz % readlink foo/baz bar %

      not "readlink foo/baz" returning "../foo/bar" nor "/whatever/path/we/are/in/foo/bar". But if you did want one of those, how would specify it?

      Maybe I should just assume that people either want relative symlinks or absolute symlinks and, when making relative symlinks, remove as many instances of ".." as possible? Then you could say "RS=foo/baz" or "AS=foo/baz". That'd be easier than actually trying to get the invocation of "ln -s" correct on the first try (which is extra hard for me since I personally always think that the arguments to "ln -s" should go in the other order for some reason).

      I'd probably never use "ln -s" directly again. Yeah, I think I really need to implement this.

      Thanks for the suggestions!

      - tye        

Re: mvi -- mv+vi (+ln+rm+cp+mkdir)
by wol (Hermit) on Aug 03, 2010 at 14:00 UTC
    It's an entire day since I read this node, and I've only just twigged that I could do with the same thing for the PATH variable, on Windoss at least.

    Not that I have the time to think it through properly though, let alone do the work. Grr.

    Now, if you'll excuse me, I have a grindstone to return to.

    --
    use JAPH;
    print JAPH::asString();

      On Win32 I have vienv - Edit local environment variables on Win32 for temporary changes to the environment and CleanPath for permanent changes to %PATH%. It would be very cool to have one directory (from %PATH%) per line in your editor and adjust things there. It'd also be cool if vienv could make permanent changes. Why not combine the two. You could throw up the editor on something like:

      =System ALLUSERSPROFILE=C:\Documents and Settings\All Users ... PATH; ;C:\WINDOWS\system32 ;C:\WINDOWS ;C:\WINDOWS\System32\Wbem ;C:\strawberry\c\bin ;C:\strawberry\perl\bin PATHEXT=.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.PSC1 ... WINDIR=C:\WINDOWS =User TEMP=C:\DOCUME~1\tye\LOCALS~1\Temp TMP=C:\DOCUME~1\tye\LOCALS~1\Temp VISUAL=vim

      - tye