#!/usr/bin/perl
# filename: matchlrc.pl
# copyleft(c) 2004 suninny@hotmail.com
# 经常需要往Mp3播放器(优盘)上拷歌,而一个个查找相应的Lrc文件于我这样一个懒人来说是件无法忍受的事,
# 所以用Perl弄了个这样的程序,能自动拷贝相应的Lrc文件到目标目录,并用logfile记录下所缺失的Lrc文件。
# 通过测试,工作良好...相信你也会喜欢^^
use File::Copy;
my $musicDir = 'K:';
my $lyricDir = 'C:\Program Files\MiniLyrics\Lyrics';
opendir DH, $musicDir or die "Cannot open $musicDir: $!";
foreach my $musicFile(readdir DH) {
next unless $musicFile =~ /\.wma$|\.mp3$/i;
($lrc = $musicFile) =~ s/\....$/.lrc/;
push(@lrcList, $lrc);
}
closedir DH;
chdir $musicDir;
open LOG, ">logfile.txt" or die "Cannot create logfile.txt: $!";
opendir DH, $lyricDir or die "Cannot open $lyricDir: $!";
my @lrcFiles = readdir DH;
START:foreach my $lrc(@lrcList) {
foreach my $file(@lrcFiles) {
next unless $file =~ /\.lrc$/i;
if (lc($file) eq lc($lrc)) {
copy("$lyricDir/$file", "$file") or die "Cannot copy $file:$!"
unless -e "$file";
next START;
}
}
print LOG "$lrc not found!\n";
}
close LOG;
closedir DH;