目前分類:Perl (8)

瀏覽方式: 標題列表 簡短摘要
# 產生目前目錄下的檔案清單,並轉換成批次檔,可一次移動到select目錄。

use strict;
use Time::HiRes qw(gettimeofday);
use 5.010;

my $selfName = $1 if ( __FILE__ =~ /\\(\w+\.pl$)/);
my $cmdFN = 'select.cmd';
my $tarDir = "_select";

my @files = glob("*.*");

open FILE, ">$cmdFN" or die "Can not write file, $!";
say FILE "mkdir $tarDir" ;
for(@files) {
    say FILE "move $_ $tarDir" if !(/$selfName|$cmdFN/);
}
close FILE;

system("pause");

bagatelles 發表在 痞客邦 留言(0) 人氣()


有時候要將Perl程式給別人使用,但對方又沒裝Perl Interpreter,就要把PL檔案轉換成EXE檔比較通用。在Perl中現在可以使用Free的套件"App::Packer::PAR",就能轉換出EXE執行檔,但一個小程式也會有4MBytes以上的大小,且啟動速度會比較慢一點。

bagatelles 發表在 痞客邦 留言(0) 人氣()

# 將JPEG, RAW, TIFF三個目錄同步
# 2013/12/28加上checkDirectoryExist,修正問題

use strict;
use File::Copy;
use File::Basename;
use Time::HiRes qw(gettimeofday);
use 5.010;

my $t0 = gettimeofday;
my $DestRAW    = "NEF/";
my $DestJPEG   = "JPEG/";
my $DestTIFF   = "TIFF/";
my $DelFolder  = "_del/";

#檢查目錄是否存在
&checkDirectoryExist($DestRAW, $DestJPEG, $DestTIFF);

chdir $DestJPEG;
my @fileJPG = glob "*.JPG";
chdir "..";
chdir $DestRAW;
my @fileRAW = glob "*.NEF";
chdir "..";
chdir $DestTIFF;
my @fileTIF = glob "*.TIF";
chdir "..";

###############################################################################

mkdir $DelFolder;

#處理JPEG與RAW配對
&moveFile($DestJPEG, $DestRAW, $DelFolder, @fileJPG);
&moveFile($DestRAW, $DestJPEG, $DelFolder, @fileRAW);

#處理JPEG與TIFF配對
&moveFile($DestJPEG, $DestTIFF, $DelFolder, @fileJPG);
&moveFile($DestTIFF, $DestJPEG, $DelFolder, @fileTIF);

#處理JPEG與RAW配對
&moveFile($DestJPEG, $DestRAW, $DelFolder, @fileJPG);
&moveFile($DestRAW, $DestJPEG, $DelFolder, @fileRAW);

my $t1 = gettimeofday;
printf("Time: %3.3f sec\r\n", $t1 - $t0);

system("pause");

sub moveFile() {
    for (3..$#_) {
        my $src = $_[1].uc( $_[$_] );

        if ( $_[0] eq $DestJPEG && $_[1] eq $DestRAW) {
            $src =~ s/\.JPG/\.NEF/gi;
        } elsif ( $_[0] eq $DestRAW && $_[1] eq $DestJPEG) {
            $src =~ s/\.NEF/\.JPG/gi;
        } elsif ( $_[0] eq $DestJPEG && $_[1] eq $DestTIFF) {
            $src =~ s/\.JPG/\.TIF/gi;
        } elsif ( $_[0] eq $DestTIFF && $_[1] eq $DestJPEG) {
            $src =~ s/\.TIF/\.JPG/gi;
        }

        #say $src;

        if ( !-e $src ) {
            my $dest = $_[2].$_[$_];
            say "Moving file: ".$_[0].$_[$_].' to '.$dest;
            move($_[0].$_[$_], $dest) if (-e $_[0].$_[$_]);
        }
    }
}

sub checkDirectoryExist {
    for(@_) {
        if(!-e $_) {
            say "Not found \"$_\"";
            die;
        }
    }
}


bagatelles 發表在 痞客邦 留言(0) 人氣()

# 將選好的JPEG檔複製到NEF目錄,好的JPEG檔複製到NEF目錄,執行後將JPEG
# 檔移到JPEG目錄,沒有配對的NEF移到_del目錄,配對的NEF留在原目錄。
# 2013/12/28加上checkDirectoryExist

use strict;
use File::Copy;
use File::Basename;
use Time::HiRes qw(gettimeofday);
use 5.010;

my $t0 = gettimeofday;
my $DestRAW    = "NEF/";
my $DestJPEG   = "JPEG/";
my $DelFolder  = "_del/";

#檢查目錄是否存在
&checkDirectoryExist($DestRAW, $DestJPEG);

chdir $DestJPEG;
my @fileJPG = glob "*.JPG";
chdir "..";
chdir $DestRAW;
my @fileRAW = glob "*.NEF";
chdir "..";

###############################################################################

mkdir $DelFolder;

&moveFile($DestJPEG, $DestRAW, $DelFolder, @fileJPG);
&moveFile($DestRAW, $DestJPEG, $DelFolder, @fileRAW);

my $t1 = gettimeofday;
printf("Time: %3.3f sec\r\n", $t1 - $t0);

system("pause");

sub moveFile() {
    for (3..$#_) {
        my $src = $_[1].uc( $_[$_] );

        if ( $_[0] eq $DestJPEG ) {
            $src =~ s/\.JPG/\.NEF/gi;
        } elsif ( $_[0] eq $DestRAW ) {
            $src =~ s/\.NEF/\.JPG/gi;
        }

        unless (-e $src) {
            my $dest = $_[2].$_[$_];
            say $_[0].$_[$_].' to '.$dest;
            move($_[0].$_[$_], $dest) if (-e $_[0].$_[$_]);
        }
    }
}

sub checkDirectoryExist {
    for(@_) {
        if(!-e $_) {
            say "Not found \"$_\"";
            die;
        }
    }
}


bagatelles 發表在 痞客邦 留言(0) 人氣()

# 將選好的JPEG檔複製到NEF目錄,好的JPEG檔複製到NEF目錄,執行後將JPEG
# 檔移到JPEG目錄,沒有配對的NEF移到_del目錄,配對的NEF留在原目錄。

bagatelles 發表在 痞客邦 留言(0) 人氣()

#有中文檔名會不能移動,這應該是perl的問題,可能要改成unicode輸出才行。原本移動所有檔案的作法會慢很多,改成新作法後,處理一天幾百個檔案x2,應該在1秒內。最後動作時再次判斷檔案是否存在其實有點多餘,因為一開始收集檔名時就已經知道了,其實可以用刪除法將陣列縮減,這樣就不用再判斷一次了。

# 將選好的JPEG檔複製到NEF目錄,好的JPEG檔複製到NEF目錄,執行後將JPEG

bagatelles 發表在 痞客邦 留言(0) 人氣()

使用Perl內建的md5sum,可以用來檢查檔案或產生一段md5 checksum。對檔案使用時,記得要先轉為binmode,這樣出來的結果才正確,不然應該釋文字模式的結果。範例如下:

use Digest::MD5 qw(md5 md5_hex md5_base64);

bagatelles 發表在 痞客邦 留言(0) 人氣()

# 將選好的JPEG檔複製到NEF目錄,好的JPEG檔複製到NEF目錄,執行後將JPEG
# 檔移到JPEG目錄,沒有配對的NEF移到_del目錄,配對的NEF留在原目錄。

bagatelles 發表在 痞客邦 留言(0) 人氣()