publicscripts/mvwrap/mvwrap

#!/usr/bin/perl -w

# $Id$

#
# Copyright (c) 2001 - 2007 Ward Wouts <ward@wouts.nl>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#

#
# Script to use an editor on a directory listing
# Much easier than doing 6000 moves by hand
#

use IO::File;
use File::Copy;
use POSIX qw(tmpnam);
use Getopt::Long;
use strict;
use warnings;
use vars qw(
	@source
	@target
	@pattern
	@unsafe
	$opt_e
	$opt_l
	$opt_f
	$opt_n
	$opt_v
	$opt_h
	$paranoia
	$temp_file
);

########################################################
# sub routines from here on...
#

#Read current dir
sub read_cur_dir {
	my (@dir, $filename);
	opendir(DIRHANDLE, ".") or die("couldn't open .: $!\n");
	while ( defined ($filename = readdir(DIRHANDLE)) ) {
		unless ($filename eq "." | $filename eq ".." | $filename eq ".mvwrap" ) {
			chomp ($filename);
			push @dir, $filename;
		}
	}
	closedir(DIRHANDLE);
	return sort @dir;
}

# call EDITOR or vi with filename
# edit($filename);
sub edit($) {
	my $filename = shift;
	my @editor;
	@editor = (defined $ENV{EDITOR}  ? $ENV{EDITOR} : "vi", "$filename");
	if ($opt_e) { @editor = ($opt_e, "$filename") }
	system(@editor) == 0
		or die("System @editor failed: $!");
}

# make tempfiles and install handler to remove them
sub open_temp {
	my $target;
	my $target_name;
	do { $target_name = tmpnam() }
		until $target = IO::File->new($target_name, O_RDWR|O_CREAT|O_EXCL);
	END { if ($opt_e) { unlink($target_name) or die("Couldn't unlink $target_name: $!");} }
	foreach (@source) {
		print $target "$_\n";
	}
	close ($target);
	return $target_name;
}

sub read_temp($) {
	my $target_name = shift;
	open TARGET, $target_name or die("Couldn't open tempfile: $target_name: $!");
	@target = ();
	foreach (<TARGET>) {
		chomp;
		push @target, $_;
	}
	close TARGET;
}

# Moves files from the names in one array to the names in another array
# Must be called like:
# move_files(\@source, \@target)
sub move_files($$) {
	my ($from, $to) = @_;
	my ($i, $source, $target);
	for ( $i=0; $i < scalar(@$from); $i++ ) {
		$source=$from->[$i];
		$target=$to->[$i];
		unless ( $source eq $target ) {
			if ($opt_v||$opt_n) {
				print "mv \"$source\" \"$target\"\n";
			}
			unless ($opt_n) {
				move("$source", "$target")
					or die("move failed: $!");
			}
		}
	}
}

# read pattern file
sub read_pattern {
	open PAT, "< $opt_f" or die("Couldn't open pattern file: $!\n");
	@pattern = <PAT>;
	close PAT;
}

# use patterns to change filenames
sub pattern_edit {
	my (@new_target, $pat);
	foreach $pat (@pattern) {
		@new_target=();
		foreach(@target) {
			eval $pat;
			push @new_target, $_;
		}
		@target = @new_target;
	}
}

# reads list of new titles from a text file with -l
sub readlist($) {
	my $file = shift;
	open(TITLES, $file) or die "could not read list file: $!\n";
	my (@titles)=(<TITLES>);
	close(TITLES);
	map (chomp($_),@titles);
	return @titles;
}

sub run_checks {
	my $line;

	unless ( scalar(@source) == scalar(@target) ) {
		print "ERROR: Source and target list don't have the same number of lines.\n";
		return 1;
	}

	foreach $line (@target) {
		if ( $line =~ m/^$/ ) {
			print "ERROR: You can't move to empty names.\n";
			return 1;
		}
	}

	if ( check_unique(@target) ) {
		which_doubles(@source, @target);
		print "ERROR: You're trying to move multiple files to the same name.\n";
		return 1;
	}

	if ($paranoia) { # extra checks for a specified list of files
		if ( paranoia(\@source, \@target) ) { return 1; }
	}
	return 0;
}

# returns 0 if all entries in @target_list are unique. 1 if not.
sub check_unique(@) {
	my @target_list = @_;
	my @uniqu;
	my %seen = ();
	@uniqu = grep { ! $seen{$_} ++ } @target_list;
	return (scalar(@uniqu) != scalar(@target))
}

# show what the non-unique moves are
sub which_doubles {
	my %selector = ();
	my $i;
	foreach $i (0 .. $#target) {
		if ( exists $selector{$target[$i]} ) {
			push @{$selector{$target[$i]}}, $i;
		} else {
			$selector{$target[$i]} = [$i];
		}
	}
	foreach (keys %selector) {
		if ( scalar(@{$selector{$_}}) > 1 ) {
			print "Doubles detected:\n";
			if (@pattern) {		# non-interactief
				map {print "$source[$_] -> $target[$_]\n";} @{$selector{$_}};
			} else {		# interactief
				map {print "[line: $_] $source[$_] -> $target[$_]\n";} @{$selector{$_}};
			}
		}
	}
}

# Compares one array of file names to another, making sure files
# can be moved safely without overwriting each other
# Must be called like:
# check_safety(\@source, \@target)
# Returns an array of unsafe line numbers
sub check_safety($$) {
	my ($from, $to) = @_;
	my ($i, $j, @changed, @danger, @unique, %seen);
	my ($a, $b);
	my ($n, %to);
	# $n=0; %to = map { ($_, $n++) } @to;
	for ($i=0; $i < scalar(@$from); $i++){
		$a = $from->[$i];
		$b = $to->[$i];
		push @changed, $i if ($a ne $b);
	}
	foreach $i (@changed) {
		$a = $from->[$i];
		for ($j=0; $j < scalar(@$to); $j++){
			$b = $to->[$j];
			if (($a eq $b) && ($i != $j)) {
				push @danger, $i;
				push @danger, $j;
			}
		}
	}

	%seen = ();
	@unique = grep { ! $seen{$_} ++ } @danger;
	return @unique;
}

# generate random filename, which does not exist
sub rand_file {
	my $filename;
	my @chars=( "A" .. "Z", "a" .. "z", 0 .. 9);
	while ( -e ($filename = join("", @chars[ map { rand @chars } ( 1 .. 8 ) ]))) {}
	return $filename;
}

# Moves files to a random filename and updates the source array
# Must be called like:
# safety_belt(\@unsafe, \@source)
sub safety_belt($$) {
	my ($unsafe, $source) = @_;
	my($filenr, $filename, $rand);
	foreach $filenr (@$unsafe) {
		$filename = $source->[$filenr];
		$rand = rand_file;
		if ($opt_v||$opt_n) {
			print "mv \"$filename\" \"$rand\"\n";
		}
		unless ($opt_n) {
			move("$filename", "$rand")
				or die("move failed: $!\n");
		}
		$source->[$filenr] = "$rand";
	}
}

# Extra safety checks when one's useing a specified list of files
# Must be called like:
# paranoia(\@unsafe, \@source)
sub paranoia($$) {
	my ($source, $target) = @_;
	my ($ctarget, $csource);
	my $safe;
	foreach $ctarget (@$target) {
		$safe = 0;
		foreach $csource (@$source) {
			if ($ctarget eq $csource) {
				$safe = 1;
				last;
			}
		}
		if (! $safe && -e $ctarget) {
			print "ERROR: That would overwrite file: $ctarget\n";
			return 1;
		}
	}
	return 0;
}

# place lockfile in dir, or exit if one exists.
sub mvwlock {
	if ( -e ".mvwrap") {
		die "Another mvwrap process is active in this direcory\n"
	}
	else {
		open LOCK, ">.mvwrap" or die "Couldn't open .mvwrap for writing: $!\n";
		print LOCK $$;
		close LOCK;
	}
}

# clean up lockfile
sub mvwunlock {
	if ( -e ".mvwrap" ) {
		unlink(".mvwrap") or die "Couldn't remove lock file: $!\n";
	}
}

# clean up
sub cleanup {
	mvwunlock;
	if ( defined($temp_file) ) {
		unlink $temp_file or die "Couldn't remove temp file: $!\n";
	}
}

sub askyn($) {
	my $question = shift;
	my $line;
	while (1) {
		print "$question [y/n]? ";
		$line = <>;
		if ( $line =~ /^y$/ ) {
			return 1;
		} elsif ( $line =~ /^n$/ ) {
			return 0;
		}
	}
}

# parse commandline
sub cmdline {
	GetOptions("e=s", "h", "p=s", \@pattern, "f=s", "v", "n", "l=s");

	help() if $opt_h;
	if ($opt_f) { read_pattern(); }
	if (scalar(@ARGV)>0) {
		foreach (@ARGV) {
			push @source, "$_";
		}
		$paranoia = 1;
	}
}

# show help message
sub help {
	$opt_h = 1; # just get rid of that stupid message from -w
	print << "EOT";

This is a little script to make renaming large quantities of files easy.
It basically lets you edit the names in a directory with an editor
of your choice. By default this will be "vi", but it honors the EDITOR
environment variable. Which in turn can be overridden with the -e option.

$0 [options] [--] [files]

At the moment it takes the following options:
-h			this help message
-e <editor>		invoke with this editor; ignored if -f or -p is given
-l <file>		reads list of new titles from a text file; ignored
			if -f or -p is given
-p <pattern>		use a pattern to edit; ignored if -f is given
-f <file>		use a pattern file to edit
-v			verbose; shows file moves
-n			test; doesn't move, implies -v

EOT
	mvwunlock;
	exit;
}

########################################################
# main loop
#

mvwlock();

$SIG{__DIE__} = 'cleanup';

cmdline;
unless (defined @source) { @source = read_cur_dir; }

if (@pattern) {
	@target = @source;
	pattern_edit;
	if ( run_checks ) {
		die("Aborting\n");
	}
} elsif ($opt_l) {
	@target=(readlist($opt_l));
	if (run_checks) { die "Aborting\n"; }
} else {
	$temp_file = open_temp;
	edit($temp_file);
	read_temp($temp_file);
	while ( run_checks() ) {
		if ( askyn("Do you want to continue editing")  ) {
			edit($temp_file);
			read_temp($temp_file);
		} else {
			die("Aborting\n");
		}
	}
}

# if it's unsafe to move files directly, move the unsafe ones to a
# temporary file first
if (@unsafe = check_safety(\@source, \@target)) {
	safety_belt(\@unsafe, \@source);
}

move_files(\@source, \@target);
cleanup;