Perl MEMO

  1. xxxxの前後の文脈を取りだす
  2. MeCabなどのwindowsの環境パスを通した実行ファイルを複数のファイルに対して処理する
  3. perlのスクリプトを複数のファイルに行う1(system函数を利用)
  4. perlのスクリプトを複数のファイルに行う2(スクリプト内で処理する)
  5. 条件に合うファイルを移動する1(ファイル名の特定の箇所を参照)
  6. 条件に合うファイルを移動する2(ファイル名を照合)
  7. テキストファイルだけを移動する
  8. ファイル名を変更する
  9. ファイル中の日本語を削除する
  10. 文字コードを判別して一覧にする

<番外編>
パスの通し方


xxxxの前後の文脈を取りだす

・コード
while (<>) {
	$line = $_;
	if (/xxxx/) {   
		$after = $_;
		
		print "$pre\n$after\n";
	} else {
		$pre = $line;
	}
}
・メモ
該当ワードがないときはelseで処理し、$preに常に前文脈を入れておく。


MeCabなどのwindowsの環境パスを通した実行ファイルを複数のファイルに対して処理する

・コード
@files = glob ("*.txt"); 
mkdir("./mecab");
foreach $i (@files){
$filename=$i;
$filename=~ s/\.txt$//; #拡張子を取ったもの。保存ファイル名として使う
system "mecab $i > ./mecab/$filename.mecab"; 

}
・メモ
systemがとても便利な関数。これを使うと、perlのスクリプトを複数のファイルに簡単に適応することができる。下記参照。
対象ファイルを含むフォルダ内にこのスクリプトを保存して実行する必要がある。

<追記>日本語のファイル名のものはうまく処理できないようです(対策を検討中)。
パスの通し方はこちら。



perlのスクリプトを複数のファイルに行う1(system函数を利用)

・コード
@files = glob ("*.txt");
mkdir("./space");
foreach $i (@files){
$filename=$i;
$filename=~ s/\.txt$//;
system "perl space.pl $i > ./space/$filename.txt"; 
#結果の拡張子が同じ場合は無限に処理が行われるため、
#結果はサブフォルダに入れる必要がある
}
・メモ
このスクリプトと、実行対象となるスクリプト(上の例ではspace.pl)が必要。上記のスクリプトを実行すればspace.plがフォルダ内のファイルに対して実行される。



perlのスクリプトを複数のファイルに行う2(スクリプト内で処理する)

・コード
@files = glob ("*.txt"); 
mkdir("./result");
foreach $i (@files){
open (FILE, $i) or die("Can't open the file\n");
$filename= $i;
$filename=~ s/\.txt$/b\.txt/; #ファイル名をXXXbにする
#保存の名前に注意。自己を含むので、拡張子か場所を変更
open( NewFILE, ">", "./result/$filename"); 
#resultフォルダの中にXXXbファイルを作る
while(){
	if(/^\n/g){
	}else{
	$line=$_;
	$line =~ s/。/。\n/g;
	print NewFILE $line;
	}
}
close (FILE);
close (NewFILE);
}


条件に合うファイルを移動する1(ファイル名の特定の箇所を参照)

・コード

use File::Copy;

@files = glob ("*.txt");
foreach $i (@files){
$num=substr($i, 3,1); #ファイル名の前から4文字目を取りだす

if($num eq 1){
	mkdir("./field1");
	move("$i", "./field1");
}
elsif($num eq 2){
	mkdir("./field2");
	move("$i", "./field2");
}
elsif($num eq 3){
	mkdir("./field3");
	move("$i", "./field3");
}
}
・メモ
aaa1.txt, bbb2.txt, bbb3.txtなどの文字列の一部を検証してそれぞれをfield1-3のフォルダに移動する。ここでは、4文字目が1か2か3によって分類している。フォルダは初めから用意しておく。スクリプト内で作る場合は、mkdir("./field1");などを追加。use File::Copy;は必須。


条件に合うファイルを移動する2(ファイル名を照合)

・コード
use File::Copy;

@files = glob ("*.txt"); #txtの拡張子のものを読み込む
foreach $i (@files){
if($i =~m/2007/g){
	mkdir("./2007");
	move("$i", "./2007");
}
elsif($i =~m/2008/g){
	mkdir("./2008");
	move("$i", "./2008");
}
elsif($i =~m/2009/g){
	mkdir("./2009");
	move("$i", "./2009");
}
}
・メモ
ファイル名に含む文字列によって分類。2007ab2008c.txtなどのように二つ該当のものを含むものがあるとうまくできないので注意。なお、このコードではフォルダを作成している。


テキストファイルだけを移動する

use File::Copy;

@files = glob ("*.txt"); 
foreach $i (@files){
	mkdir("./text");
	move("$i", "./text");
}
・メモ
テキストファイルをtextフォルダに移動。html, plだけを移動するなど応用可。


ファイル名を変更する

・コード
@files = glob ("*.mecab"); 
foreach $i (@files){
$num=substr($i, 3,1);
rename "$i", "$num$i";
}
・メモ
aaa3.mecabを3aaa.mecabに変更


ファイル中の日本語を削除する

・コード
use Encode;
while(<>){
$_=~s/[^\x20-\x7E\s\n\t]//g;
$_=~s/^\n//;
print;
}
・メモ
「英語とスペース、改行、タブ以外の文字」を置き換えで削除。


文字コードを判別して一覧にする

・コード
use Encode::Guess qw/ euc-jp shiftjis 7bit-jis /;
open(SAVE, ">codelist.csv");#記録用のファイル
@files = glob ("*.txt"); 
foreach $i (@files){
open (FILE, $i); #対象のファイルを開く
@list=;
my $data = @list[0]; #1行目を参照
my $encd = guess_encoding( $data );


if( ref $encd ){
	print SAVE "$i,",$encd->name,"\n";
}else{
	print SAVE "$i,$encd\n";
}
close (FILE);
}
close (SAVE);
・メモ
ファイルの一行目を読み込み、そのコードをcsvファイルに書き出し。対象ファイルと同じフォルダにおいて実行する。





[スポンサーリンク]

このページをはてなブックマークに追加