#!/usr/bin/perl
use strict;

#########################################################
#しらぎくさいと実験室                                   #
#画像変換バイナリ検索スクリプト                第0.920版#
#########################################################
#平成19年 5月13日　しらぎくさいと                       #
#Copyright (c)2007      MINOBE Hiroyuki, Saitama, JAPAN.#
#Copyright (c)2007      Marguerite Site, Saitama, JAPAN.#
#   www.marguerite.jp                                   #
#########################################################
use vars qw(
	@paths $answer $path $magick $pbm
	);

my ($i, $j, $answer2);
#検索対象となるパス。
if (($i=$ENV{'PATH'})=~/\A[a-zA-Z]:\\/) { @paths=split(/;/,$ENV{'PATH'}); }
else { @paths=split(/:/,$ENV{'PATH'}); }

#イメージマジックは使えるか？
$magick=0;
$answer="<h2>イメージマジック。</h2>\n";
eval { require Image::Magick; };
if (!$@) { $answer.="<p>お使いの環境はイメージマジックに対応しております。</p>\n"; ++$magick; }
else { $answer.="<p>お使いの環境はイメージマジックには<strong>対応しておりません</strong>。</p>\n"; }

#NetPBMの主要なコマンドは使えるか？
#ウィンドウズ以外のOSである事が条件。
$answer.="<h2>NetPBM。</h2>\n";
eval {
	$i=`perl -v`;
	$j=&search('perl');
	$i=`$j/perl -v` if !$i;
	};

if (!($i=~/MSWin32-/)) {
	$pbm=1;
	#GIF関連。
	$path='';
	$answer2="<dl>\n\t<dt>GIF画像</dt>\n";
	$i=&search('giftopnm');
	if ($i ne '') { $answer2.="\t<dd>読込: 可/"; $path=$i; }
	else { $answer2.="\t<dd>読込: <strong>不可</strong>/"; $pbm=0; }

	if ($path eq '') { $i=&search('ppmtogif') || &search('pamtogif'); }
	else { $i=((-e "$path/ppmtogif") || (-e "$path/pamtogif")) && $path; }
	if ($i) { $answer2.="書出: 可</dd>\n\n"; $path=$i; }
	else { $answer2.="書出: <strong>不可</strong></dd>\n\n"; $pbm=0; }

	#JPEG関連。
	$answer2.="\t<dt>JPEG画像</dt>\n";
	if ($path eq '') { $i=&search('djpeg') || &search('jpegtopnm'); }
	else { $i=((-e "$path/djpeg") || (-e "$path/jpegtopnm")) && $path; }
	if ($i) { $answer2.="\t<dd>読込: 可/"; $path=$i; }
	else { $answer2.="\t<dd>読込: <strong>不可</strong>/"; $pbm=0; }

	if ($path eq '') { $i=&search('cjpeg') || &search('pnmtojpeg'); }
	else { $i=((-e "$path/cjpeg") || (-e "$path/pnmtojpeg")) && $path; }
	if ($i) { $answer2.="書出: 可</dd>\n\n"; $path=$i; }
	else { $answer2.="書出: <strong>不可</strong></dd>\n\n"; $pbm=0; }

	#ビットマップ関連。
	$answer2.="\t<dt>ビットマップ</dt>\n";
	if ($path eq '') { $i=&search('ppmtobmp'); }
	else { $i=(-e "$path/ppmtobmp") && $path; }
	if ($i) { $answer2.="\t<dd>BMP : 書出可</dd>\n"; $path=$i; }
	else { $answer2.="\t<dd>BMP : <strong>書出不可</strong></dd>\n"; $pbm=0; }

	if ($path eq '') { $i=&search('pbmtowbmp'); }
	else { $i=(-e "$path/pbmtowbmp") && $path; }
	if ($i) { $answer2.="\t<dd>WBMP: 書出可</dd>\n\n"; $path=$i; }
	else { $answer2.="\t<dd>WBMP: <strong>書出不可</strong></dd>\n\n"; $pbm=0; }

	#PNG関連。
	$answer2.="\t<dt>PNG画像</dt>\n";
	if ($path eq '') { $i=&search('pngtopnm'); }
	else { $i=(-e "$path/pngtopnm") && $path; }
	if ($i) { $answer2.="\t<dd>読込: 可/"; $path=$i; }
	else { $answer2.="\t<dd>読込: <strong>不可</strong>/"; $pbm=0; }

	if ($path eq '') { $i=&search('pnmtopng'); }
	else { $i=(-e "$path/pnmtopng") && $path; }
	if ($i) { $answer2.="書出: 可</dd>\n\n"; $path=$i; }
	else { $answer2.="書出: <strong>不可</strong></dd>\n\n"; $pbm=0; }

	#処理関連。
	$answer2.="\t<dt>画像処理</dt>\n";
	if ($path eq '') { $i=&search('pnmscale') || &search('pamscale'); }
	else { $i=((-e "$path/pnmscale") || (-e "$path/pamscale")) && $path; }
	if ($i) { $answer2.="\t<dd>縮小: 可</dd>\n"; $path=$i; }
	else { $answer2.="\t<dd>縮小: <strong>不可</strong></dd>\n"; $pbm=0; }

	if ($path eq '') { $i=&search('pnmquant') || &search('pamquant'); }
	else { $i=((-e "$path/pnmquant") || (-e "$path/pamquant")) && $path; }
	if ($i) { $answer2.="\t<dd>減色: 可</dd>\n\n"; $path=$i; }
	else { $answer2.="\t<dd>減色: <strong>不可</strong></dd>\n\n"; $pbm=0; }

	if ($path eq '') { $i=&search('ppmtopgm') && &search('pgmtopbm'); }
	else { $i=(-e "$path/ppmtopgm") && (-e "$path/pgmtopbm") && $path; }
	if ($i) { $answer2.="\t<dd>白黒: 可</dd>\n\n"; $path=$i; }
	else { $answer2.="\t<dd>白黒: <strong>不可</strong></dd>\n\n"; $pbm=0; }

	#結論。
	$answer2.="\t</dl>\n";
	if ($pbm) {
		$answer.=<<ED;
<p>お使いの環境ではNetPBMが利用出来ます。</p>
<p>NetPBMへのパスは <strong>$path/</strong> です。</p>
<h3>NetPBMの詳細。</h3>
$answer2
ED
		}
	else {
		$answer.="<p>お使いの環境ではNetPBMは<strong>利用出来ません</strong>。</p>\n";
		$answer.="<p>NetPBMへのパスは <strong>$path/</strong> ですが、一部実装されていないものがあります。\n" if $path ne '';
		$answer.=$answer2;
		}
	}
else {
	$answer.="<p>お使いの環境はウィンドウズのため、NetPBMは<strong>利用出来ません</strong>。</p>\n";
	$pbm=0;
	}

#結論。
if (!$magick && !$pbm) {
	eval { require Compress::Zlib; };
	$i='';
	if ($@) { $i="<p>Zlibも使えないため、PNG画像の扱いにも制限が加わります。</p>"; }
	$answer=<<ED;
<p>お使いの環境では<strong>利用出来る画像に大きな制限が加わります</strong>。</p>
$i
<p>『<a href="http://www.marguerite.jp/Nihongo/Labo/index.html">しらぎくさいと実験室</a>』の作品をご利用になるのであれば、<strong>サーヴァの変更を強く推奨致します</strong>。</p>
$answer
ED
	}
else {
	$answer=<<ED;
<p>お使いのサーヴァは以下のような環境となっております。</p>

$answer
ED
	}

$answer=<<ED;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<title>お使いのサーヴァの画像処理環境。</title>
<h1>お使いのサーヴァの画像処理環境。</h1>

$answer
<hr>
<address>Copyright (c)平成19年 さいたま・<a href="http://www.marguerite.jp/">しらぎくさいと</a> 版権所有</address>
</html>
ED

binmode(STDOUT);
print "content-type: text/html;charset=shift_jis\ncontent-length: ",length($answer),"\n\n$answer";
exit();

	
#検索。
sub search {
	my $n=$_[0];
	my ($i);

	foreach $i (@paths) {
		return($i) if (-e "$i/$n");
		}
	return('');
}