<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">use warnings 'all';
use strict;
use feature "switch";
use POSIX 'strftime';
use Tk;
use Tk::LabFrame;
use Tk::Balloon;
use Tk::TextUndo;
use Tk::BrowseEntry;
use Encode qw(encode decode);
use Fcntl ':mode';
use List::Util 'shuffle';
use Tie::File;
use Digest::MD5;
use Win32::TieRegistry;
use Cwd 'abs_path';
use File::Glob ':glob';
use MP3::Tag;
use Ogg::Vorbis::Header::PurePerl;

# $n[i] is an array containing information about i-th file:
# 0 - original name (windows codepage)
# 1 - original name (internal unicode)
# 2 - new name if 'Make' button was pressed or old name otherwise (windows codepage)
# 3 - new name if 'Make' button was pressed or old name otherwise (internal unicode)
# 4 - file size (bytes)
# 5 - modification time (seconds)
# 6 - file type ('d' for directory, 'f' for ordinary file)
# 7 - new name if rename was successful or old name otherwise (windows codepage)
# 8 - new name if rename was successful or old name otherwise (internal unicode)

my ($Key, $Clob, $Sort, $Dir, $md, @n) = (0, 0, '', 0, 0);
my (@Op, @Mod, @RenFr, @Add, @SMod, @YMod, @ri, @ro, @mg, @me, @mi, @GMod, @IMod, @EMod, @gi, @go,
	@Wrap, @ZZ, @WW, @AA, @CntFr, @SS, @Rxu);
my $CP = 'cp'.$Registry-&gt;{"LMachine\\SYSTEM\\CurrentControlSet\\Control\\Nls\\CodePage\\ACP"};
tie our @MRU, 'Tie::File', "c:/windows/rename.db" or die "Cannot open database";

my $mw = MainWindow-&gt;new;
$mw-&gt;configure(-title =&gt; 'Perl-based Multi Rename Tool by Steuermann Liouville, v5.3');
my $Bl = $mw-&gt;Balloon();
addregexp($Key++);
$ri[0]-&gt;focus;

my $Buttons = $Op[0]-&gt;LabFrame(qw/-label Actions/)-&gt;pack(qw/-side left/);
$Bl-&gt;attach($Buttons-&gt;Checkbutton(-variable =&gt; \$md, qw/-text d/)-&gt;pack(qw/-side left/),
	-balloonmsg =&gt;	'Create new directories');
$Bl-&gt;attach($Buttons-&gt;Checkbutton(-variable =&gt; \$Clob, qw/-text !/)-&gt;pack(qw/-side left/),
	-balloonmsg =&gt;	'Clobber mode, WARNING: files with conflicting names will be erased');
my $Mk = $Buttons-&gt;Button(qw/-width 4 -text Make/, -command =&gt; \&amp;preview)-&gt;pack(qw/-side left/);
$Bl-&gt;attach($Mk, -balloonmsg =&gt; 'Prepare filenames');
my $St = $Buttons-&gt;Button(qw/-width 4 -text Go! -state disabled/)-&gt;pack(qw/-side left/);
my $Un = $Buttons-&gt;Button(qw/-width 4 -text Undo -state disabled/)-&gt;pack(qw/-side left/);
$St-&gt;configure(-command =&gt; sub { action(0, 2, \$Un, \$St); addtoreg() });
$Un-&gt;configure(-command =&gt; sub { ($Clob, $md) = (0, 0); action(7, 0, \$St, \$Un) });
$Buttons-&gt;Button(qw/-width 4 -text Quit/, -command =&gt; sub { untie @MRU; exit })-&gt;
	pack(qw/-side left/);

my $Op0 = $mw-&gt;Frame()-&gt;pack();
$Bl-&gt;attach($Op0-&gt;Button(qw/-width 1 -text ^/, -command =&gt; \&amp;loadcur)-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Get old filenames from preview panel');
$Op0-&gt;Label(-text =&gt; 'Sort by ')-&gt;pack(qw/-side left/);
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2193), -value =&gt; 'f', -variable =&gt; \$Sort,
	-command =&gt; sub { Sort('sort { $b-&gt;[1] cmp $a-&gt;[1] }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Descending case-sensitive fullpath sort');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2191).' Full path', qw/-value F/,
	-variable =&gt; \$Sort, -command =&gt; sub { Sort('sort { $a-&gt;[1] cmp $b-&gt;[1] }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Ascending case-sensitive fullpath sort');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2193), -value =&gt; 'p', -variable =&gt; \$Sort,
	-command =&gt; sub { Sort('sort { uc($b-&gt;[1]) cmp uc($a-&gt;[1]) }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Descending case-insensitive fullpath sort');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2191).' FULL PATH', qw/-value P/,
	-variable =&gt; \$Sort, -command =&gt; sub { Sort('sort { uc($a-&gt;[1]) cmp uc($b-&gt;[1]) }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Ascending case-insensitive fullpath sort');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2193), -value =&gt; 'd', -variable =&gt; \$Sort,
	-command =&gt; sub { Sort('sort { ds($b-&gt;[1]) cmp ds($a-&gt;[1]) }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Descending dictionary fullpath sort');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2191).' full path', qw/-value D/,
	-variable =&gt; \$Sort, -command =&gt; sub { Sort('sort { ds($a-&gt;[1]) cmp ds($b-&gt;[1]) }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Ascending dictionary fullpath sort');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2193), -value =&gt; 's', -variable =&gt; \$Sort,
	-command =&gt; sub { Sort('sort { $b-&gt;[4] &lt;=&gt; $a-&gt;[4] }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Descending filesize, B: \1 in replace expression');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2191).' File size', qw/-value S/,
	-variable =&gt; \$Sort, -command =&gt; sub { Sort('sort { $a-&gt;[4] &lt;=&gt; $b-&gt;[4] }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Ascending filesize, B: \1 in replace expression');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2193), -value =&gt; 't', -variable =&gt; \$Sort,
	-command =&gt; sub { Sort('sort { $b-&gt;[5] &lt;=&gt; $a-&gt;[5] }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Descending mtime, s: \2 in replace expression');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; chr(0x2191).' Modification time', qw/-value T/,
	-variable =&gt; \$Sort, -command =&gt; sub { Sort('sort { $a-&gt;[5] &lt;=&gt; $b-&gt;[5] }') })-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Ascending mtime, s: \2 in replace expression');
$Bl-&gt;attach($Op0-&gt;Radiobutton(-text =&gt; 'Random', qw/-value r/, -variable =&gt; \$Sort,
	-command =&gt; sub { Sort('shuffle') })-&gt;pack(qw/-side left/), -balloonmsg =&gt; 'Random order');
$Bl-&gt;attach($Op0-&gt;Checkbutton(-text =&gt; 'Directories first', -variable =&gt; \$Dir)-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Separate directories, f/d: \3 in replace expression');
$Bl-&gt;attach($Op0-&gt;Button(qw/-width 1 -text &lt;/, -command =&gt; \&amp;movenew)-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Change old names to new names in left preview'.
	' panel. WARNING: Undo will be impossible');
$Bl-&gt;attach($Op0-&gt;Button(qw/-width 1 -text ^/, -command =&gt; \&amp;loadnew)-&gt;
	pack(qw/-side left/), -balloonmsg =&gt; 'Get new filenames from preview panel');

my $Result = $mw-&gt;Frame()-&gt;pack(qw/-expand yes -fill both -side bottom/);
my $t = $Result-&gt;Scrolled(qw/TextUndo -scrollbars osoe -wrap none -width 50/)-&gt;
	pack(qw/-expand yes -fill both -side left/);
$Bl-&gt;attach($t, -balloonmsg =&gt; 'Old names can be added and used by the tool (left ^ button)');
my $u = $Result-&gt;Scrolled(qw/TextUndo -scrollbars osoe -wrap none -width 50/)-&gt;
	pack(qw/-expand yes -fill both -side left/);
$Bl-&gt;attach($u, -balloonmsg =&gt; 'New names can be edited and used by the tool (right ^ button)');

@ARGV = map { d2u($_) } @ARGV;
my @TMPDIR = ();
MAIN: while (defined $ARGV[0]) {
	given (shift @ARGV) {
		when ('+D') {
			while (defined (my $_ = shift @ARGV)) {
				last MAIN if $_ eq '--';
				last if $_ eq '-D';
				addtoargs($_)
			}
		}
		when ('-d') { if (defined (my $_ = shift @ARGV)) { addtoargs($_) } }
		when (/[*?\[\]}{]/) { push @TMPDIR, bsd_glob($_) }
		when ('-D') { print "Warning: extra -D option in command line\n" }
		when ('--') { last MAIN }
		default { push @TMPDIR, $_ }
	}
}
push @ARGV, @TMPDIR;
undef @TMPDIR;

for (0..$#ARGV) {
	$n[$_][0] = $ARGV[$_];
	$n[$_][1] = decode $CP, $n[$_][0];
	getstat($_);
	@{$n[$_]}[7..8] = @{$n[$_]}[2..3]
}
&amp;view;
MainLoop;

sub addregexp {
	my $i = shift;
	($Mod[$i], $me[$i], $mg[$i], $mi[$i], $gi[$i], $go[$i]) = ('s', '', '', '', '', '');
	$Op[$i] = $mw-&gt;Frame()-&gt;pack();
	$RenFr[$i] = $Op[$i]-&gt;LabFrame(-label =&gt; 'Regular expression '.$i)-&gt;pack(qw/-side left/);
	$Rxu[$i] = 1;
	if ($i == 0) {
		$Add[$i] = $RenFr[$i]-&gt;Button(qw/-width 1 -text +/)-&gt;pack(qw/-side left/);
		$Bl-&gt;attach($Add[$i], -balloonmsg =&gt; 'Add another regular expression')
	} else {
		$Add[$i] = $RenFr[$i]-&gt;Checkbutton(-variable =&gt; \$Rxu[$i])-&gt;pack(qw/-side left/);
		$Bl-&gt;attach($Add[$i], -balloonmsg =&gt; 'Use this expression');
	}
	$SMod[$i] = $RenFr[$i]-&gt;Radiobutton(qw(-text s/ -value s), -variable =&gt; \$Mod[$i])-&gt;pack(qw/-side left/);
	$Bl-&gt;attach($SMod[$i], -balloonmsg =&gt; 'Substitution mode');
	$YMod[$i] = $RenFr[$i]-&gt;Radiobutton(qw(-text y/ -value y), -variable =&gt; \$Mod[$i])-&gt;pack(qw/-side left/);
	$Bl-&gt;attach($YMod[$i], -balloonmsg =&gt; 'Transliteration mode');
	eval '$ri['.$i.'] = $RenFr['.$i.']-&gt;BrowseEntry(-variable =&gt; \$gi['.$i.'], -buttontakefocus =&gt; 0,
		-browse2cmd =&gt; sub { $go['.$i.'] = decode("utf8", (split chr(0x0), $MRU[$_[1]])[1])
			if $go['.$i.'] eq ""; $Mod['.$i.'] = (split chr(0x0), $MRU[$_[1]])[5];
			($Mod['.$i.'] eq "s") ? setsmod('.$i.') : setymod('.$i.');
			($me['.$i.'], $mg['.$i.'], $mi['.$i.']) = (split chr(0x0), $MRU[$_[1]])[2..4] })-&gt;
			pack(qw/-side left/)';
	$ri[$i]-&gt;Subwidget('entry')-&gt;configure(qw/-background white -width 17/);
	$RenFr[$i]-&gt;Label(qw(-text /))-&gt;pack(qw/-side left/);
	eval '$ro['.$i.'] = $RenFr['.$i.']-&gt;BrowseEntry(-variable =&gt; \$go['.$i.'], -buttontakefocus =&gt; 0,
		-browse2cmd =&gt; sub { $gi['.$i.'] = decode("utf8", (split chr(0x0), $MRU[$_[1]])[0])
			if $gi['.$i.'] eq ""; $Mod['.$i.'] = (split chr(0x0), $MRU[$_[1]])[5];
			($Mod['.$i.'] eq "s") ? setsmod('.$i.') : setymod('.$i.');
			($me['.$i.'], $mg['.$i.'], $mi['.$i.']) = (split chr(0x0), $MRU[$_[1]])[2..4] })-&gt;
			pack(qw/-side left/)';
	$ro[$i]-&gt;Subwidget('entry')-&gt;configure(qw/-background white -width 17/);
	$RenFr[$i]-&gt;Label(qw(-text /))-&gt;pack(qw/-side left/);
	$GMod[$i] = $RenFr[$i]-&gt;Checkbutton(-variable =&gt; \$mg[$i], -offvalue =&gt; '')-&gt;pack(qw/-side left/);
	$IMod[$i] = $RenFr[$i]-&gt;Checkbutton(-variable =&gt; \$mi[$i], -offvalue =&gt; '')-&gt;pack(qw/-side left/);
	$EMod[$i] = $RenFr[$i]-&gt;Checkbutton(-variable =&gt; \$me[$i], -offvalue =&gt; '')-&gt;pack(qw/-side left/);
	eval '$SMod['.$i.']-&gt;configure(-command =&gt; sub { setsmod('.$i.') })';
	eval '$YMod['.$i.']-&gt;configure(-command =&gt; sub { setymod('.$i.') })';
	setsmod($i);
	$Add[$i]-&gt;configure(-command =&gt; sub { addregexp($Key++) }) if $i == 0;
	$CntFr[$i] = $Op[$i]-&gt;LabFrame(-label =&gt; 'Counter '.$i)-&gt;pack(qw/-side left/);
	$Bl-&gt;attach($CntFr[$i], -balloonmsg =&gt; 'Counter: \0 in replace expression, \4 for total number');
	$AA[$i] = $CntFr[$i]-&gt;Spinbox(qw/-from -9999 -to 9999 -width 4/);
	$AA[$i]-&gt;set(0);
	$Bl-&gt;attach($AA[$i], qw/-balloonmsg Start/);
	$SS[$i] = $CntFr[$i]-&gt;Spinbox(qw/-from -9999 -to 9999 -width 4/);
	$SS[$i]-&gt;set(1);
	$Bl-&gt;attach($SS[$i], qw/-balloonmsg Step/);
	$WW[$i] = $CntFr[$i]-&gt;Spinbox(qw/-from 1 -to 99 -width 2/);
	$Bl-&gt;attach($WW[$i], qw/-balloonmsg Digits/);
	$ZZ[$i] = $CntFr[$i]-&gt;Spinbox(qw/-from -9999 -to 9999 -width 4 -state disabled/);
	$ZZ[$i]-&gt;set(0);
	$Bl-&gt;attach($ZZ[$i], -balloonmsg =&gt; 'Stop number in wrap mode');
	$AA[$i]-&gt;pack($SS[$i], $WW[$i], $ZZ[$i], qw/-side left/);
	eval '$Bl-&gt;attach($CntFr['.$i.']-&gt;Checkbutton(qw/-text z/, -variable =&gt; \$Wrap['.$i.'], -command =&gt; 
		sub { $Wrap['.$i.'] ? $ZZ['.$i.']-&gt;configure(qw/-state normal/) : $ZZ['.$i.']-&gt;
		configure(qw/-state disabled/) })-&gt;pack(qw/-side left/), -balloonmsg =&gt; "Wrap mode, reset counter")';
	for (@MRU) {
		@_ = split chr(0x0), $_, 3;
		$ri[$i]-&gt;insert("end", decode("utf8", $_[0]));
		$ro[$i]-&gt;insert("end", decode("utf8", $_[1]))
	}
}

sub preview {
	my @cn;
	for (0..$Key-1) { $cn[$_] = $AA[$_]-&gt;get }
	for (0..$#n) {
		(my $nf = $n[$_][1]) =~ s#^.*/##;
		(my $pt = $n[$_][1]) =~ s#[^/]*$##;
		for (my $i = 0; $i &lt; $Key; $i++) {
			next unless $Rxu[$i];
			my $si = $gi[$i];
			$si = '^' if $si eq '' and $Mod[$i] eq 's';
			my $so = $go[$i];
			if ($Mod[$i] eq 's') {
				$so =~ s/\\0/sprintf("%0".$WW[$i]-&gt;get."d", $cn[$i])/ge;
				$cn[$i] += $SS[$i]-&gt;get;
				if ($Wrap[$i] &amp;&amp; abs($cn[$i]) &gt; abs($ZZ[$i]-&gt;get)) { $cn[$i] = $AA[$i]-&gt;get }
				$so =~ s/\\1/$n[$_][4]/g;
				$so =~ s/\\2/$n[$_][5]/g;
				$so =~ s/\\3/$n[$_][6]/g;
				$so =~ s/\\4/sprintf("%0".$WW[$i]-&gt;get."d", $#n+1)/ge;
				$so =~ s/\\5/md5dig($n[$_][0])/ge if $so =~ /\\5/;
				if ($so =~ /\\[89]/) {
					my $Fullp = $n[$_][0];
					eval { $Fullp = abs_path($n[$_][0]) };
					my @Dirs = split /[\\\/]/, decode($CP, $Fullp);
					$Dirs[0] =~ s/^([a-z]):$/$1/i;
					$so =~ s/\\8([0-9])/$Dirs[$#Dirs-$1]/g;
					$so =~ s/\\9([0-9])/$Dirs[$1]/g
				}
				if ($so =~ /\\7/) {
					my @tag = ();
					if ($n[$_][0] =~ /mp3$/i) {
						my $mp3 = MP3::Tag-&gt;new($n[$_][0]);
						@tag = split /\\:/, $mp3-&gt;interpolate('%a\:%t\:%l\:%n\:%g')
					}
					if ($n[$_][0] =~ /ogg$/i) {
						my $ogg = Ogg::Vorbis::Header::PurePerl-&gt;new($n[$_][0]);
						$tag[0] = join('/', $ogg-&gt;comment("artist"));
						$tag[1] = join('/', $ogg-&gt;comment("title"));
						$tag[2] = join('/', $ogg-&gt;comment("album"));
						$tag[3] = join('/', $ogg-&gt;comment("tracknumber"));
						$tag[4] = join('/', $ogg-&gt;comment("genre"))
					}
					$so =~ s/\\7a/$tag[0]/g;
					$so =~ s/\\7t/$tag[1]/g;
					$so =~ s/\\7l/$tag[2]/g;
					$so =~ s/\\7n/$tag[3]/g;
					$so =~ s/\\7g/$tag[4]/g
				}
				eval '$nf =~ s/$si/$so/'.$me[$i].$mg[$i].$mi[$i]
			} else {
				eval '$nf =~ tr/'.$si.'/'.$so.'/'.$me[$i].$mg[$i].$mi[$i]
			}
		}
		$n[$_][3] = $pt.$nf;
		$n[$_][2] = encode $CP, $pt.$nf
	}
	&amp;view;
	$St-&gt;configure(qw/-state normal/)
}

sub action {
	&amp;clear;
	for (0..$#n) {
		if ($md) {
			(my $pt = $n[$_][$_[0]]) =~ s#/?[^/]*$##;
			(my $dif = $n[$_][$_[1]]) =~ s#/?[^/]*$##;
			$dif =~ s#^\Q$pt\E/?##;
			$pt = "." if $pt eq "";
			foreach (split '/', $dif) {
				$pt .= "/".$_;
				mkdir $pt unless -d $pt
			}
		}
		my $Ok = 0;
		$Ok = rename $n[$_][$_[0]], $n[$_][$_[1]] if -e $n[$_][$_[0]] &amp;&amp;
			$Clob || ! -e $n[$_][$_[1]];
		if (! $Ok &amp;&amp; lc($n[$_][$_[0]]) eq lc($n[$_][$_[1]]) &amp;&amp; $n[$_][$_[0]] ne $n[$_][$_[1]]) {
			rename $n[$_][$_[0]], $n[$_][$_[1]]."_stlle";
			$Ok = rename $n[$_][$_[1]]."_stlle", $n[$_][$_[1]]
		}
		@{$n[$_]}[7..8] = @{$n[$_]}[2..3] if $Ok &amp;&amp; $_[0] == 0;
		$t-&gt;insert('end', ($Ok ? 'OK: ' : 'NG: ').$n[$_][$_[0]+1]."\n");
		$u-&gt;insert('end', $n[$_][$_[1]+1]."\n")
	}
	${$_[2]}-&gt;configure(qw/-state normal/);
	${$_[3]}-&gt;configure(qw/-state disabled/);
}

sub addtoreg {
	for (my $i = 0; $i &lt; $Key; $i++) {
		push @MRU,  $gi[$i].chr(0x0).$go[$i].chr(0x0).$me[$i].chr(0x0).$mg[$i].chr(0x0).
					$mi[$i].chr(0x0).$Mod[$i].chr(0x0).time
			if (grep { index($_, $gi[$i].chr(0x0).$go[$i].chr(0x0).$me[$i].chr(0x0)) != -1 } @MRU) + 0 == 0
	}
}

sub clear {
	$t-&gt;delete(qw/0.0 end/);
	$u-&gt;delete(qw/0.0 end/)
}

sub view {
	&amp;clear;
	map { $t-&gt;insert('end', $_-&gt;[1]."\n"); $u-&gt;insert('end', $_-&gt;[3]."\n") } @n
}

sub loadcur {
	for (0..$t-&gt;index('end')-2) { getname($_, 0, \$t); getstat($_) }
	&amp;view
}

sub loadnew {
	for (0..$#n) { getname($_, 2, \$u) }
	&amp;view;
	$St-&gt;configure(qw/-state normal/)
}

sub movenew {
	$Un-&gt;configure(qw/-state disabled/);
	for (0..$#n) { @{$n[$_]}[0,1,2,3] = @{$n[$_]}[7,8,7,8] }
	&amp;view
}

sub getname {
	shift;
	my @i = ${$_[1]}-&gt;dump('-text', ($_+1).'.0', ($_+1).'.end');
	next if $#i &lt; 1;
	$n[$_][$_[0]+1] = "";
	for (my $j = 1; $j &lt; $#i; $j += 3) { $n[$_][$_[0]+1] .= $i[$j] }
	$n[$_][$_[0]+1] =~ y#\\#/#;
	$n[$_][$_[0]] = encode $CP, $n[$_][$_[0]+1]
}

sub getstat {
	shift;
	@{$n[$_]}[2..3] = @{$n[$_]}[0..1];
	@{$n[$_]}[4..6] = (stat($n[$_][0]))[7,9,2];
	$n[$_][6] = "f" if S_ISREG($n[$_][6]);
	$n[$_][6] = "d" if S_ISDIR($n[$_][6])
}

sub ds {
	(my $i = $_[0]) =~ s/[\W_]//g;
	return uc($i)
}

sub d2u {
	(my $i = $_[0]) =~ y#\\#/#;
	$i =~ s#"$##;
	return $i
}

sub Sort {
	@n = $Dir ? (eval $_[0].' grep { $_-&gt;[6] eq "d" } @n',
		eval $_[0].' grep { $_-&gt;[6] eq "f" } @n') : eval $_[0].' @n';
	&amp;view
}

sub md5dig {
	$_[0] =~ y#/#\\#;
	if (open FILE, $_[0]) {
		binmode FILE;
		my $i = Digest::MD5-&gt;new-&gt;addfile(*FILE)-&gt;hexdigest;
		close FILE;
		return $i
	} else {
		return '0' x 32
	}
}

sub setsmod {
	$Bl-&gt;attach($ri[$_[0]], -balloonmsg =&gt; 'Search expression');
	$Bl-&gt;attach($ro[$_[0]], -balloonmsg =&gt; 'Replace expression');
	$GMod[$_[0]]-&gt;configure(qw/-text g -onvalue g/);
	$IMod[$_[0]]-&gt;configure(qw/-text i -onvalue i/);
	$EMod[$_[0]]-&gt;configure(qw/-text e -onvalue ee/);
	($mg[$_[0]], $mi[$_[0]], $me[$_[0]]) = ('', '', '');
	$Bl-&gt;attach($GMod[$_[0]], -balloonmsg =&gt; 'Global search');
	$Bl-&gt;attach($IMod[$_[0]], -balloonmsg =&gt; 'Case-insensitive search');
	$Bl-&gt;attach($EMod[$_[0]], -balloonmsg =&gt; 'Evaluation of replace expression')
}

sub setymod {
	$Bl-&gt;attach($ri[$_[0]], -balloonmsg =&gt; 'Search list');
	$Bl-&gt;attach($ro[$_[0]], -balloonmsg =&gt; 'Replace list');
	$GMod[$_[0]]-&gt;configure(qw/-text c -onvalue c/);
	$IMod[$_[0]]-&gt;configure(qw/-text d -onvalue d/);
	$EMod[$_[0]]-&gt;configure(qw/-text s -onvalue s/);
	($mg[$_[0]], $mi[$_[0]], $me[$_[0]]) = ('', '', '');
	$Bl-&gt;attach($GMod[$_[0]], -balloonmsg =&gt; 'Complement the search list');
	$Bl-&gt;attach($IMod[$_[0]], -balloonmsg =&gt; 'Delete found but unreplaced characters');
	$Bl-&gt;attach($EMod[$_[0]], -balloonmsg =&gt; 'Squash duplicate replaced characters')
}

sub addtoargs {
	if (-d $_[0]) {
		(my $i = $_[0] ) =~ s#([\[\]}{~])#\\$1#g;
		push @TMPDIR, bsd_glob($i."/*")
	} else {
		push @TMPDIR, $_[0]
	}
}
=head1 NAME

urename - simple graphical multi-rename tool for M$ Windows.

=head1 DESCRIPTION

This script can rename multiple files using perl regular expression or using prepared
list of new filenames. There two modes of work: substitution (s///) and transliteration
(y///). Current filenames can be passed to script as command-line arguments (metacharacters
* ? [] {} ~ are supported internally, to stop processing them use --) or by pasting to left
preview panel. Script also can create new directories and replace existing files. If files
are renamed by groups (more than one "Go!"), "Undo" will undo all changes at once. It is
possible to stack multiple substitutions or transliterations by pressing '+' button,
expressions are applied to each filename in turn, starting from 0. In substitution mode
there are special combinations which can be used in replace expression:

=over 4

=item *

\0 - counter, parameters for counter are set with spinboxes, for every regular expression
there is its own counter.

=item *

\1 - filesize in bytes.

=item *

\2 - modification time in seconds.

=item *

\3 - filetype: 'd' for directory, 'f' for ordinary file.

=item *

\4 - total number of files being renamed.

=item *

\5 - md5 sum.

=item *

\7I&lt;x&gt; - OGG or MP3 tag, I&lt;x&gt; is 'a' for artist, 't' for track title,
'l' for album title, 'n' for track number, 'g' for genre.

=item *

\8I&lt;n&gt; - I&lt;n&gt;th directory name starting from the innermost (e.g. for
c:\windows\system32\drivers\etc\hosts: \80 is "hosts", \81 is "etc",
\82 is "drivers", \83 is "system32", \84 is "windows", \85 is "c").

=item *

\9I&lt;n&gt; - I&lt;n&gt;th directory name starting from the outermost (e.g. for
c:\windows\system32\drivers\etc\hosts: \90 is "c", \91 is "windows",
\92 is "system32", \93 is "drivers", \94 is "etc", \95 is "hosts").

=back

There is '&lt;' button to put new filenames instead of old ones into preview panel after
renaming in order to start second stage of filename modification (Undo will be disabled).
Filename list can be sorted or randomized with radiobuttons. In order to use manually
added/modified filenames in preview panel it is necessary to press '^' button located
above each panel. Backreferences ($1, $2...) requires 'e' switch to be set which implies
using perl syntax in replace expression (due to 'ee' modifier). Inputted expressions are
stored in F&lt;c:/windows/rename.db&gt;.

There are some simple commandline options: -d, +D, -D. All files and subdirectories
(without recursion) belonging to directory which name is preceded by '-d' will be added
to list. Similarly, all files and subdirectories (without recursion) belonging to
directories which names are between '+D' and '-D' options will be added to list.

For example:

urename.pl file1 file2 dir1 dir2 -d dir3 dir4 +D dir5 dir6 file3 dir7 -D file4 -d dir8 file5

Entries being renamed will be: file1 file2 dir1 dir2 dir3/* dir4 dir5/* dir6/* file3
dir7/* file4 dir8/* file5

To stop processing command line options and wildcards use '--'.

=head1 README

Multi-rename script for Windows with graphical user interface, similar to Multi-Rename
Tool of Total Commander, but more powerful, a quick and convenient way to use perl regular
expressions for renaming files (it can make new directories if needed).

=head1 PREREQUISITES

This script requires the C&lt;Tk&gt; module. It also requires C&lt;List::Util&gt;, C&lt;Win32::TieRegistry&gt;,
C&lt;Cwd&gt;, C&lt;Ogg::Vorbis::Header::PurePerl&gt; and C&lt;MP3::Tag&gt;. 5.10 version of perl is required.

=head1 BUGS

The path to database file is hard-wired.

=pod OSNAMES

Win32

=pod SCRIPT CATEGORIES

Win32/Utilities

=cut

# vim:ts=4:sw=4:lines=34:co=110
</pre></body></html>