請(qǐng)教windows下Perl移動(dòng)文件并改名

xinganling

現(xiàn)要將上千個(gè)文件夾(下面有的包含子文件夾)下的圖片文件由jpg改為gif格式, 但找到的程序輸出文件要么送到同一個(gè)文件夾下,要么得一個(gè)一個(gè)定義, 太麻煩.
擬采取下面的方法解決, 用Perl將各文件夾下的文件都移到一個(gè)文件夾中, 移動(dòng)后的文件名包含所在文件夾的信息, 等格式修改完成后再按文件名移回到原目錄, 并去除文件夾信息(即還原為原文件名, 當(dāng)然擴(kuò)展名一定是新的gif的)
如:
將c:\目錄1\目錄11\20080808.jpg   移到  c:\目錄0\目錄1_目錄11_20080808.jpg    處理后移回  c:\目錄1\目錄11\20080808.gif  
將c:\目錄2\目錄21\20080809.jpg   移到  c:\目錄0\目錄2_目錄21_20080809.jpg    處理后移回  c:\目錄2\目錄21\20080809.gif
將c:\目錄3\20080810.jpg              移到  c:\目錄0\目錄3_20080810.jpg                處理后移回  c:\目錄3\20080810.gif
請(qǐng)各位大俠幫忙呵, 文件夾和文件太多了, 手動(dòng)做不起呵
謝謝! 謝謝!

fangdingj

何必這么麻煩，直接用程序重命名不就行了

cobrawgl

正好，我這里有個(gè)移動(dòng)文件的小腳本，你看看能不能幫上忙

#!/usr/bin/perl

use strict;
use warnings;

use File::Find;
use File::Copy;

my @dir = qw(c:/Xunlei/111);

File::Find::find(\&wanted, @dir);

sub wanted {
        if (/((pdf)|(chm))$/) {
                File::Copy::move($File::Find::name, 'c:/xunlei/111') unless -d;       
        }
}

forlorngenius

已經(jīng)很明顯了

xinganling

謝謝cobrawgl
有兩個(gè)問(wèn)題, 一是如果在目錄下存在圖片文件和子目錄, 則圖片文件不能被移走, 處理后的情況如下, 其中的gif文件沒(méi)被移走.

└─友好
    ├─031629000010.gif
    ├─031629000009.gif
    ├─031629000008.gif
    │  ├─08-06-007-Z-D001友好大樓照片
    │  └─08-06-007-Z-D001友好大樓房證土地證
    │      └─友好轉(zhuǎn)讓
    ├─031627000015.gif
    ├─031627000014.gif
    ├─031627000011.gif
    ├─031627000010.gif
    └─031627000009.gif

二是移走的文件沒(méi)有帶上路徑標(biāo)識(shí), 因?yàn)橐獙�jpg等格式的文件處理成800X600再轉(zhuǎn)為gif格式后再移回去, 沒(méi)有路徑標(biāo)識(shí)就無(wú)法移回去.
這兩點(diǎn)Perl可以實(shí)現(xiàn)嗎?  (剛接觸, 實(shí)在無(wú)從下手, 活又急, 還請(qǐng)多幫助)

cobrawgl

可以啊，只是。。。上午有事情。。。

xinganling

"已經(jīng)很明顯了"什么意思呵, 給個(gè)語(yǔ)句呵

cobrawgl

這個(gè)小腳本應(yīng)該能做到 移出，但是還沒(méi)滿足你在6樓說(shuō)的那個(gè)第一個(gè)要求
移入那個(gè)反過(guò)來(lái)作應(yīng)該可以吧

#!/usr/bin/perl

use strict;
use warnings;

use File::Find;
use File::Copy;
use File::Basename;
use File::Spec;

my @dir = qw(c:/目錄1 c:/目錄2 c:/目錄3);

File::Find::find(\&wanted, @dir);

sub wanted {
        my ($filename, $dir) = File::Basename::fileparse($File::Find::name);
       
        $dir =~ s{.*?/(.*?)/(.*?)/}{$1_$2_};
        $filename = File::Spec->catfile('d:/tt', $dir.$filename);
       
        File::Copy::move($File::Find::name, $filename);
}