画像自動削除機能の追加

adiary

前回のエントリと一部重複します。パスを書いていない（ファイル名のみ）のは/（ルート）か、/lib/Satsukiあたり（特に.pm）にあります。詳しくはdiffの冒頭をば。

nabe氏のお返事にもありましたが、複数日記エントリから同一画像を参照している場合でも、削除のチェックを入れて編集/削除すると問答無用で画像を消してしまうので、そこはご注意を。

adiary.conf.cgi

<$v.image_upload_dir  = "<@public_dir>image/">

を追加。

uploader.conf.cgi

<$v.image_dir  = "<@Diary.image_upload_dir>">

に変更。

/diary.skel/parser/default.html

/diary.user.skel/parser/ にコピーした上で、

<$h.image_updir  = v.image_upload_dir>

を追加。

/info/textparser_tags.txt

diffです。patchで当ててください。

--- .\info\textparser_tags.txt	Thu Oct 18 02:04:16 2007
+++ .\info\textparser_tags.txt	Sun Mar  2 00:00:00 2008
@@ -232,12 +232,12 @@
 img#2#link = 画像, image, 2, $1$2
 
 # 標準アップローダ
-image       = 画像アルバム, image, 3,  ${public}image/$1/$2$3
-image#small = 画像アルバム, image, 3,  ${public}image/$1/$2thumbnail/$3.jpg
-image#link  = 画像アルバム, image, 3,  ${public}image/$1/$2$3
+image       = 画像アルバム, image, 3,  ${image_updir}$1/$2$3
+image#small = 画像アルバム, image, 3,  ${image_updir}$1/$2thumbnail/$3.jpg
+image#link  = 画像アルバム, image, 3,  ${image_updir}$1/$2$3
+file        = ファイル,     ASCII, 4,  ${image_updir}$2/$3$4
+file:mp3    = mp3ファイル,  ASCII, 4, <a class="mp3player" href="${image_updir}$1/$2$3">#4</a><br><module name="mp3player" file="${image_updir}$1/$2$3" sb="${bc}" lb="${bc}">
 
-file        = ファイル,     ASCII, 4,  ${public}image/$2/$3$4
-file:mp3    = mp3ファイル,  ASCII, 4, <a class="mp3player" href="${public}image/$1/$2$3">#4</a><br><module name="mp3player" file="${public}image/$1/$2$3" sb="${bc}" lb="${bc}">
 
 # example for せりかのアルバム
 album       = 画像アルバム, image, 2,  album/hash/$1/$2?thumbnail

diary_edit.html

--- .\diary.skel\diary_edit.html	Sat Oct 27 02:42:12 2007
+++ .\diary.user.skel\diary_edit.html	Sun Mar  2 00:00:00 2008
@@ -117,12 +117,14 @@
 	</tr>
 	<@ifexec(!d.update_tm, begin)>
 	<tr>
-		<td><@ifexec(s.ping_servers_txt && s.enable_force ne '0', begin)><input type="checkbox" name="update_ping" value="1"<@if(s.update_ping, ' checked')>><span onMouseOver="popup_text('更新通知を送ると他の人があなたの記事を見つけやすくなります。<br>【送信先】<br>' + '<@replace(x = s.ping_servers_br_txt, "\n", "<br>")>', arguments[0])" onMouseOut="popdown()">更新通知Pingを送信する</span><$end>&nbsp;</td>
-		<td><input type="checkbox" name="key_send_tb" value="1"<@if(s.key_send_tb, ' checked')>><span class="mono">key/id</span>記法で自動TB送信</td>
+		<@ifexec(s.ping_servers_txt && s.enable_force ne '0', begin, begin)><td><input type="checkbox" name="update_ping" value="1"<@if(s.update_ping, ' checked')>><span onMouseOver="popup_text('更新通知を送ると他の人があなたの記事を見つけやすくなります。<br>【送信先】<br>' + '<@replace(x = s.ping_servers_br_txt, "\n", "<br>")>', arguments[0])" onMouseOut="popdown()">更新通知Pingを送信する</span>&nbsp;</td>
+		<td><$else><td colspan="2"><$end>
+		<input type="checkbox" name="key_send_tb" value="1"<@if(s.key_send_tb, ' checked')>><span class="mono">key/id</span>記法で自動TB送信</td>
 	</tr>
 	<$end>
 	<tr>
-		<td colspan="2"><input type="checkbox" name="wiki" value="1" id="wiki-checkbox"<@if(wiki, " checked")> onclick="checkbox_change('wiki-checkbox', 'wiki-block');">wikiコンテンツにする</td>
+		<@if(edit_pkey, '<td>', '<td colspan="2">')><input type="checkbox" name="wiki" value="1" id="wiki-checkbox"<@if(wiki, " checked")> onclick="checkbox_change('wiki-checkbox', 'wiki-block');">wikiコンテンツにする</td>
+		<@ifexec(edit_pkey, begin)><td><input type="checkbox" name="isimgdel" id="isimgdel" value="1" checked><label for="isimgdel">編集前後で不要になった画像を削除する</label></td><$end>
 	</tr>
 	</table>

更新通知のところをいじっているのは単純に見栄えの問題だけです。
この画面は日記編集時の画面で、ここで画像削除のチェックボックスを設置します。デフォルトでチェックが入るように checked を入れています。

Diary_auto.pm

--- .\lib\Satsuki\Diary_auto.pm	Sat Oct 27 23:37:20 2007
+++ .\lib\Satsuki\Diary_auto.pm	Sun Mar  2 00:00:00 2008
@@ -494,6 +494,57 @@
 		}
 		my $r = $DB->update_match($table_name, \%diary, 'pkey', $pkey);
 		if (!$r) { $ROBJ->message('Diary edit failed'); return 11; }
+
+
+####################################################################################
+### 自動削除機能追加。ここから。
+####################################################################################
+
+		if ($form->{isimgdel}){
+			# adiary.conf.cgi より画像のアップロードフォルダ（adiary.cgi 存在フォルダをルートとした相対パス）を取得。
+			my $uploadDir = $self->{image_upload_dir};
+
+			# 画像リンク抽出用正規表現
+			my $href = "href=\"/.+?$uploadDir(.+?)\"";
+			my $src = "src=\"/.+?$uploadDir(.+?)\"";
+
+			# 編集前の整形済みテキストから、画像リンク/サムネイルリンクを抽出。
+			my @OLDLinks;
+			while ($old->{text} =~ /$href/sig){ push(@OLDLinks, $1); }
+			while ($old->{text} =~ /$src/sig){ push(@OLDLinks, $1); }
+
+			# 編集後の整形済みテキストから、画像リンク/サムネイルリンクを抽出。
+			my @NEWLinks;
+			while ($text =~ /$href/sig){ push(@NEWLinks, $1); }
+			while ($text =~ /$src/sig){ push(@NEWLinks, $1); }
+
+			# 編集前に存在して編集後に存在しないファイルのリストを抽出
+			my @diff;
+			foreach my $eachLink (@OLDLinks){
+				unless(grep(/^$eachLink$/, @NEWLinks)){
+				# unlink を使うには adiary.cgi から見た相対パスが必要なので、ここで連結。
+			  	push(@diff, $uploadDir.$eachLink)
+				}
+			}
+
+			# 重複排除
+			my @df = do { my %t; grep !$t{$_}++ , @diff };
+
+			# 編集前後で無くなった画像があれば削除
+			my $cntdf = @df;
+			if ($cntdf > 0){
+				foreach my $delImage (@df){
+					# 書き込み可能なら削除実行。
+					if (-w $delImage) { unlink $delImage; }
+				}
+			}
+		}
+
+####################################################################################
+### 自動削除機能追加。ここまで。
+####################################################################################
+
+
 	} else {		# 新規書き込み処理の場合
 		if ($diary{enable}) {			# 公開のときのみ update_tm を設定
 			$diary{update_tm} = $ROBJ->{TM};

$formにpostされたデータが入っているので、そこに画像削除確認用のデータを紛れ込ませてます。
編集時だと判定されたif文分岐中で、DBを更新した直後に画像削除をしています。配列比較（というか二配列からの差分抽出）はLunaTear: 配列の比較の時にを、重複排除はhttp://nyarla.net/blog/how-to-carry-out-array2hash-simply-by-perlの手法を参考にしました。

今回用いた正規表現では、対象となる画像ファイルが自サイト内にあるかどうかは簡易的にしか確認していません*1。が、最後 unlink する前に対象ファイルが書き込み可能かどうかをチェックしている*2ので、たまたま同じようなディレクトリ構成をした外部画像を読み込んでいて、それが対象ファイルだと誤認されたとしても問題はないかと思います。
ただ、その場合でもリンクを張った先の外部画像と同名のファイルがUploadディレクトリにあったりすると問題だとは思いますが、さすがにその可能性は無視できる程度じゃないかなと…*3。

comment_edit.html

--- .\diary.skel\comment_edit.html	Sun Mar 11 01:48:28 2007
+++ .\diary.user.skel\comment_edit.html	Sun Mar  2 00:00:00 2008
@@ -30,6 +30,7 @@
 	<input type=hidden name=edit_pkey_int value="<@t.pkey>">
 
 	<p>下に表示されている日記を削除しますか？（コメント等もすべて削除されます）</p>
+	<p><input type="checkbox" name="isimgdel" value="1" checked>挿入されている画像も同時に削除する</p>
 	<input type=submit name="delete" value="以下の日記を削除する">　
 	<input type=checkbox name="delete_check" value="1">確認のためチェックを入れてください<br>
 	</form>

エントリ削除確認時、画像削除確認のためのチェックボックス挿入です。デフォルトでチェックが入るように checked を入れています。

diary_delete.html

--- .\diary.skel\action\diary_delete.html	Fri Jan  5 14:01:00 2007
+++ .\diary.user.skel\action\diary_delete.html	Sun Mar  2 00:00:00 2008
@@ -8,7 +8,7 @@
 	<$break()>
 <$end>
 
-<$action_return = v.diary_delete(Form.edit_pkey_int)>
+<$action_return = v.diary_delete(Form.edit_pkey_int, Form.isimgdel)>
 
 POST成功時の処理
 <$ifexec(action_return eq '0', begin)>

スケルトンから diary_auto2.pm にある sub diary_delete に引数を渡す際、標準では削除するエントリの番号（というかID）しか渡されないので、無理矢理削除確認チェックボックスの値も渡してやります。

Diary_auto2.pm

--- .\lib\Satsuki\Diary_auto2.pm	Wed Aug 15 23:17:12 2007
+++ .\lib\Satsuki\Diary_auto2.pm	Sun Mar  2 00:00:00 2008
@@ -758,7 +758,8 @@
 # ●日記を削除する
 #------------------------------------------------------------------------------
 sub diary_delete {
-	my ($self, $pkey) = @_;
+	# skeltonからの引数に削除する/しないのチェックボックスを追加($isDelete)
+	my ($self, $pkey, $isDelete) = @_;
 	my $ROBJ = $self->{ROBJ};
 	my $DB   = $ROBJ->{DB};
 	my $auth = $ROBJ->{Auth};
@@ -780,7 +781,10 @@
 	# 親ノードがないか確認
 	my %h;
 	$h{match_int}   = {'pkey' => $pkey};
-	$h{select_cols} = ['upnode'];
+
+	# 削除機能を使うには text カラムの情報（パーサーを通過した後の生HTML）も必要なので追加。
+	$h{select_cols} = ['upnode', 'text'];
+
 	my $ary = $DB->select("${diary_id}_diary", \%h);
 	my $upnode = $ary->[0]->{upnode};
 
@@ -798,6 +802,44 @@
 	$self->generate_rss          ($diary_id);
 
 	if ($r!=1) { $ROBJ->message("Diary delete failed"); return 10; }	# 失敗
+
+
+####################################################################################
+### 自動削除機能追加。ここから。
+####################################################################################
+
+	if ($isDelete){
+		# adiary.conf.cgi より画像のアップロードフォルダ（adiary.cgi 存在フォルダをルートとした相対パス）を取得。
+		my $uploadDir = $self->{image_upload_dir};
+
+		# 画像リンク抽出用正規表現
+		my $href = "href=\"/.+?$uploadDir(.+?)\"";
+		my $src = "src=\"/.+?$uploadDir(.+?)\"";
+
+		# パーサー通過後の整形済みテキスト（生HTML）から画像リンク/サムネイルリンクを抽出。
+		my @OLDLinks;
+		while ($ary->[0]->{text} =~ /$href/sig){ push(@OLDLinks, $1); }
+		while ($ary->[0]->{text} =~ /$src/sig){ push(@OLDLinks, $1); }
+
+		# 重複排除
+		my @df = do { my %t; grep !$t{$_}++, @OLDLinks };
+
+		# エントリ削除に伴い画像も削除
+		my $cntdf = @df;
+		if ($cntdf > 0){
+			foreach my $delImage (@df){
+				# 書き込み可能なら削除実行。
+				# unlink を使うには adiary.cgi からの相対パスが必要なので、正規表現から持ってきたのとここで連結。
+				if (-w $uploadDir.$delImage) { unlink $uploadDir.$delImage; }
+			}
+		}
+	}
+
+####################################################################################
+### 自動削除機能追加。ここまで。
+####################################################################################
+
+
 	return 0;			# 成功
 }

先に diary_delete に渡す引数を追加したので、サブルーチン側でも対応する受け皿（変数）を作ってやります。
この関数（というかサブルーチン）の目的であるエントリ削除を先に行い、削除に成功した場合に画像の削除を実行しています。

けつろん

多分これで動くはずです。今の環境では一応エラー無く動いているのですが、wiki環境とかではテストしてないのでもしかしたらエラー出るかもです*4。で、お約束ですが自己責任でお願いします。
普段はお手軽PHPerな趣味グラマなのでPerlでそこそこまじめに書いたのは久しぶりでした。ですので、ツッコミとか結構あるかと思いますが、お手柔らかに願います^^

*1:一応ルートディレクトリ(/)以下にあることは確認できてるはずなので、大丈夫かなと思ってます。

*2:もしかして存在確認にはなってない？のなら -e とか？

*3:例えば同じドメインの下で別々のユーザーが同じアカウント名・同じディレクトリ構成でadiaryを使ってた、とか。

*4:一応ソースを見る限りは大丈夫そうではありますが…。