When you were young

今年の8月「初めてのPerl」を読み始めました。もちろんPerlというものを知らなかったわけでは全然なく、もうかれこれ10年ほど前から当時のCGIというものをちょろちょろと触ってはいたのです。ただそうはいっても基礎学習をしたことがないので自分で何か書こうと思ってもかけないし、ちょっと高度なことになるとちんぷんかんぷんという有様でした。職業プログラマではないのですが、常々その欠落を埋めたいと思っていて一念発起、硬派な印象のオライリーの本で一から勉強しなおすことにしたのです。硬派な印象とは裏腹に実に愉快な内容で、一部ではアメリカンジョークだとか言われてるみたいですが、私は脇道にそれる脚注が結構気に入ってしまいました。

初めてのPerl

Perlで何がしたかったかというとひとつは正規表現を使いこなしたいというのと、もうひとつは具体的にあって、不要画像ファイルを除去するスクリプトを書きたいというのがありました。どういうことかというと、ウェブサイトのコーディングをがちがちやってると画像を書き出してはjpgにしたり、pngにしたりとか、使おうと思ったものでも結局は使わなかったり結構ゴミの画像ファイルができてしまうのですね。
そこでソースのなかからイメージをひっぱってきて、実際にディレクトリにあるファイルと付け合わせれば、そのファイルが要るか要らないかがわかるはず！と思ったわけです。おそらくPerlで簡単にできるのだろうというイメージもあったので、やってみることにしたのです。

ようやく昨日全てを読み通すことができて全体的なところが頭にはいったかなと感じたので書いてみました。
ただ、これでいいのかなぁという感じもあって、とにかく動くのは動くんだけど、なんかすっきりしない感じ。正解はない！と言われればそれまでなんだけど、もっといい書き方があるんじゃないかとか、この書き方はおかしいんだろうな、というのは気になります。まわりにプログラマの人がいれば、聞くのですが、そのような環境でもないので、ここはひとつ恥ずかしながらもコードを公開してみて指摘をいただけるものなら指摘をもらおうと思ったのです。

本当はそういうサービスがあればと思うのです。プログラマ予備軍ていっぱいいると思うんですよね。そういう人たちはお金払ってでも上達したいという思いがあるわけです。本で独習というのが常道なんでしょうけど、もっと短時間に効率的に学習したいという思いは強いんじゃないかと。CSS Niteみたいなイベントに結構な若者が集うのもそういうのがあると思うんですよね。

さておき、下記をご覧いただき、指摘をいただければ幸いです。また、ブログじゃなくって、こういうところに投稿したらいいよとか参考情報をいただけたらとても嬉しいです。

#!/usr/local/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Cwd;
use File::Basename;

chdir "$ARGV[0]";

#プログラム 対象となるディレクトリを引数として渡しています

my @imagesfile;

while(<images/*>){
	push @imagesfile, (substr($_,7));
}

#グロブでimagesフォルダにある画像ファイルを取得しました。

while(<*.html>){
		open FILE, $_;
		while(<FILE>){
				if(/src=¥"images¥/(.*?)¥"/){
						push @imagesfile, $1;
				}
		}
}

#htmlの拡張子のをファイルハンドルで開いて
#src="images/という指定をしてるところを配列に入れていきました

while(<css/*>){
		open CSS, $_;
		while(<CSS>){
				if(/url¥(¥.¥.¥/images¥/(.*?)¥)/){
						push @imagesfile, $1;
				}
		}
}

#CSSファイルにも画像ファイルへのパスが記述してあるので、
#それも同様にマッチさせて取得し、配列に入れていきました

my %count;

foreach(@imagesfile){
		$count{$_}++;
}

#ハッシュでカウントを数えました

my @notuselist;

foreach(sort keys %count){
		if($count{$_} == 1){
			push @notuselist, $_;
		}
}

#2つ以上カウントがあればそれはソースにもあるし、フォルダにもある
#ということなのでカウント1のを不要リストにしました

my $nouse = "./images/nouse";

unless(-e $nouse){
	mkdir $nouse , 0755 or warn "cannoto make directory: $!";
}

#imagesフォルダにnouseというフォルダを作ることにしました

my $cwd = getcwd;

foreach(@notuselist){
		my $now = "$cwd/images/$_";
		my $dirname = dirname $now;
		my $rename = "$dirname/nouse/$_";
		rename $now, $rename;
}

#最後に不要ファイルをnouseというフォルダに移動（リネーム）させて完了

print "Done!¥n";