#!/usr/bin/perl # This script is useful to change a lot of filnames using a name conversion # table. my $usage = "\nUsage: $0 [-hv] convTblFile\n " . " -v: verbose output\n" . " -r: reverse, column1 is the new name\n" . " -t: test mode, it will not do the name conversion\n" . "convTblFile is a tab delimited file. The 1st column contains the current\n". "filenames, and the 2nd column contains the new filenames. If there are\n" . "more than 2 columns, the rest are ignored. If a line starts with\n". "# or a line has less than 2 columns, these lines are ignored.\n"; use Getopt::Std; use File::Copy; getopts('htvr') || die $usage; die $usage if (defined($opt_h)); if (defined($opt_t)) { $opt_v = 1; warn "##### This is the test mode, no actual conversion is done. #####\n"; } #die $usage unless ($opt_s && $opt_s =~ /^s\/.*\/.*\//); unshift(@ARGV, '-') unless @ARGV; my %nmConv = ReadInFileNameConversionFile($ARGV[0]); # for my $key (keys(%nmConv)) { # print "$key => $nmConv{$key}\n"; #} my %converted = (); my $oldCnt = 0; foreach my $file (sort(keys(%nmConv))) { next if (! (-e $file)); my $newName = $nmConv{$file}; if (-e $newName) { if (! defined ($opt_t)) { move($newName, $newName . ".old") || die "ERROR: Can't rename $newName to $newName.old\n"; } $oldCnt++; warn "WARN: Avoid overwriting by moving $newName -> $newName.old\n" if (defined($opt_v)); }; if (! defined ($opt_t)) { move($file, $newName) || warn "WARN: Can't rename $file to $newName\n"; } $converted{$file} = 1; } warn "WARN: There were $oldCnt existing files which would be overwritten by the name conversion. These files were renamed with suffix .old.\n" if ($oldCnt > 0); my @convertedFiles = keys(%converted); if(defined($opt_v)) { warn "INFO: Following file name conversion was conducted:\n"; foreach my $name (sort(@convertedFiles)) { warn "$name -> $nmConv{$name}\n"; } } warn "INFO: Converted " . scalar(@convertedFiles) . " files.\n"; warn "INFO: Files not found: " . (scalar(keys(%nmConv)) - scalar(@convertedFiles)) . "\n"; exit(0); sub ReadInFileNameConversionFile { my $fileName = shift; open(CONV, "<$fileName"); my %convTbl=(); my %newNameTbl=(); while() { s/#.*$//; # remove comments s/^\s+//; s/\s+$//; next if (/^$/); my @line = split /\t/; if (@line < 2) { warn "INFO: Ignoring line $. of $fileName: $_\n"; next; } $line[0] =~ s/^\s+//; $line[0] =~ s/\s+$//; $line[1] =~ s/^\s+//; $line[1] =~ s/\s+$//; my $old = $line[0]; my $new = $line[1]; if(defined($opt_r)) { $old=$line[1]; $new=$line[0]; } if ($new =~ /^$/) { # check for empty string for new name warn "INFO: Ignoring line $. of $fileName: $_\n"; next; } if (exists($convTbl{$old})) { my $col = (defined($opt_r)) ? "2nd" : "1st"; die "ERROR: Duplicates ($old) in the $col column of $fileName." . "\nERROR: All entries in the $col column should be unique.\n"; } if (exists($newNameTbl{$new})) { my $col = (defined($opt_r)) ? "1st" : "2nd"; die "ERROR: Duplicates ($new) in the $col column of $fileName" . "\nERROR: All entries in the $col column should be unique"; } $convTbl{$old} = $new; $newNameTbl{$new} = 1; } close (CONV); return %convTbl; }