package strana;
;# ====================================================================
;#
;# strana.pl: フォーム解析ライブラリ Ver1.00
;#
;# 著作権は放棄しません。改造可／再配布不可です。
;#
;# 更新履歴:
;#    2001.08.20 初版
;#
;# mail: webmaster@ace-cgi.jp
;# url : http://www.ace-cgi.jp/
;#
;# ====================================================================

#--------------------------------------------------#
# 複数文字列の中から<a <img を使った部分を取り出す #
#--------------------------------------------------#
sub link_pickup
{
	local(@lines)=@_;
	local(@ans)=();

	local($i,$f,$p1,$p2,$dmy);

	foreach $line (@lines){
		local($line2) = "\L$line";
		for($i=0,$f=0; $i<100; $i++,$f=0){

			#----<IMG>----#
			$p1 = index($line2, "<img ");
			if($p1 >= 0){
				$p2 = &one_block($line2,$p1);
				if($p2 < 0 || $p1 >= $p2){ last; }
				$f=1;
			}

			#----<A>----#
			if($f == 0){
				$p1 = index($line2, "<a ");
				if($p1 >= 0){
					$p2 = &one_block($line2,$p1);
					if($p2 < 0 || $p1 >= $p2){ last; }
					$f=1;
					$aflg=1;
				}
			}

			if($f == 1){
				if($p1 < 0 || $p2 < 0){ last; }
				$str=substr($line,$p1,$p2-$p1+1);
				push(@ans, "$str");
				$dmy=substr($line2,0,$p1);
				$dmy.=substr($line2,$p2+1);
				$line2=$dmy;
				$dmy=substr($line,0,$p1);
				$dmy.=substr($line,$p2+1);
				$line=$dmy;
			}
			else{
				last;
			}
		}
	}

	return @ans;
}

#----------------#
# 無効リンク削除 #
#----------------#
sub inv_link_del
{
	local(@lines)=@_;
	local(@ans)=&link_pickup(@lines);
	local($p1,$p2);
	foreach $line (@ans){
		$p1=&value_get($line,"type");
		if($p1 eq "a"){
			$p2=&value_get($line,"href");
			if($p2 eq ""){
				foreach $line2 (@lines){
					$line2 =~ s/$line(.|\n)*<\/[a,A]>//g;
				}
			}
		}
		elsif($p1 eq "img"){
			$p2=&value_get($line,"src");
			if($p2 eq ""){
				foreach $line2 (@lines){
					$line2 =~ s/$line//g;
				}
			}
		}
	}
	return @lines;
}

#--------------#
# 要素の値取得 #
#--------------#
sub value_get
{
	local($val,$nam)=@_;
	$nam .= "=";
	local($val2)="\L$val";
	if(index($nam,"type") >= 0){
		if(index($val2,"<select") >= 0){ return "select"; }
		if(index($val2,"</select") >= 0){ return "/select"; }
		if(index($val2,"<option") >= 0){ return "option"; }
		if(index($val2,"<a href") >= 0){ return "a"; }
		if(index($val2,"</a") >= 0){ return "/a"; }
		if(index($val2,"<img ") >= 0){ return "img"; }
	}
	local($p1,$p2);
	$p1 = index($val2, "$nam");
	if($p1 < 0){ return ""; }
	$p2 = index($val2, " ", $p1);
	if($p2 < 0){ $p2 = index($val2, ">", $p1); }
	if($p2 < 0){ return ""; }
	$p1+=length($nam);
	local($str)=substr($val2,$p1,$p2-$p1);
	local($str)=substr($val,$p1,$p2-$p1);
	$str =~ s/\"//g;
	if($str eq "mailto:"){ return ""; }
	return $str;
}

#------------------------------------#
# タグの一区切り<から>までを取り出す #
#------------------------------------#
sub one_block
{
	local($val,$p1)=@_;
	local(@dmy)=split(//,$val);
	local($i);
	local($sq)=0;
	local($dq)=0;
	local($cm)=0;
	for($i=0; $i<@dmy; $i++){
		if($i < $p1){ next; }
		if($dmy[$i] eq "\'"){
			if($dq == 0 && $cm == 0){
				$sq=($sq==0)?1:0;
				next;
			}
		}
		if($dmy[$i] eq "\""){
			if($sq == 0 && $cm == 0){
				$dq=($dq==0)?1:0;
				next;
			}
		}
		if($dmy[$i] eq "<" && $dmy[$i+1] eq "!" && $dmy[$i+2] eq "-"){
			if($sq == 0 && $dq == 0){
				$cm=1;
				next;
			}
		}
		if($cm == 1){
			if($dmy[$i] eq ">" && $dmy[$i-1] eq "-"){
				$cm=0;
				next;
			}
		}

		if($sq == 1 || $dq == 1 || $cm == 1){ next; }
		if($dmy[$i] eq ">"){ return $i; }
	}
	return 0;
}

#----------------------------------------------------------------#
# 複数文字列の中からform要素のinput/selectを使った部分を取り出す #
#----------------------------------------------------------------#
sub form_pickup
{
	local(@lines)=@_;
	local(@ans)=();

	local($i,$j,$f,$p1,$p2,$dmy);

	foreach $line (@lines){
		local($line2) = "\L$line";
		for($i=0,$f=0; $i<100; $i++,$f=0){

			#----<INPUT>----#
			$p1 = index($line2, "<input ");
			if($p1 >= 0){
				$p2 = index($line2, ">", $p1);
				if($p2 < 0 || $p1 >= $p2){ last; }
				$f=1;
			}

			#----<SELECT>----#
			if($f == 0){
				$p1 = index($line2, "<select ");
				if($p1 >= 0){
					$p2 = index($line2, ">", $p1);
					if($p2 < 0 || $p1 >= $p2){ last; }
					$f=1;
					$selflg=1;
				}
			}

			#----<OPTION>---#
			if($f == 0 && $selflg == 1){
				$p1 = index($line2, "<option");
				if($p1 >= 0){
					$p2 = index($line2, ">", $p1);
					if($p2 < 0 || $p1 >= $p2){ last; }
					$f=1;
				}
			}

			#----</SELECT>----#
			if($f == 0 && $selflg == 1){
				$p1 = index($line2, "</select");
				if($p1 >= 0){
					$p2 = index($line2, ">", $p1);
					if($p2 < 0 || $p1 >= $p2){ last; }
					$f=1;
					$selflg=0;
				}
			}

			if($f == 1){
				if($p1 < 0 || $p2 < 0){ last; }
				$str=substr($line,$p1,$p2-$p1+1);
				push(@ans, "$str");
				$dmy=substr($line2,0,$p1);
				$dmy.=substr($line2,$p2+1);
				$line2=$dmy;
				$dmy=substr($line,0,$p1);
				$dmy.=substr($line,$p2+1);
				$line=$dmy;
			}
			else{
				last;
			}
		}
	}

	return @ans;
}

#----------------#
# タグに値を挿入 #
#----------------#
sub value_insert
{
	local($str,$name,$value)=@_;
	local($str2) = "\L$str";
	local($name2) = "\L$name";
	local($p1,$p2,$p3,$p4,$p5);
	local($val)=$str;

	$p1 = index($str,"<");
	if($p1 < 0){ return $str; }
	$p2 = index($str,">", $p1);
	if($p2 < 0){ return $str; }

	if($name ne ""){
		$name2 .= "=";
		$p3 = index($str2, "$name2");
		#すでにname値がある場合、指定文字列で置き換え
		if($p3 >= 0){
			$p4 = index($str2, "\"", $p3);
			if($p4 >= 0){
				$p4 = index($str2, "\"", $p4+1);
			}
			if($p4 < 0 || $p2 < $p4){ $p4=-1; }
			$p5 = index($str2, " ", $p3);
			if($p5 < 0 || $p2 < $p5){ $p5=-1; }
			if($p5 >= 0){
				$p5--;
				if($p4 < 0){ $p4=$p5; }
				if($p4 > $p5){ $p4=$p5; }
			}
			if($p4 >= 0){ $p4++; }
			if($p4 < 0){ $p4=$p2; }
			$val = substr($str,0,$p3);
			$val .= "$name=\"$value\"";
			$val .= substr($str,$p4);
		}
		#$name値がない場合、末尾に追加する
		else{
			$val = substr($str,0,$p2);
			$val .= " $name=\"$value\"";
			$val .= substr($str,$p2);
		}
	}
	#name値指定がない場合、末尾に追加する
	else{
		$val = substr($str,0,$p2);
		$val .= " $value";
		$val .= substr($str,$p2);
	}

	return $val;
}

#-----------------------------------#
# iconselectのvalue値と文字列を取得 #
#-----------------------------------#
sub option_get
{
	local(@lines)=@_;
	local(@dmy)=&form_pickup(@lines);
	local(@new)=();
	local($p1,$p2,$p3,$val);

	foreach $line (@dmy){
		$p1=&value_get($line,"type");
		$p2=&value_get($line,"name");
		$p3=&value_get($line,"value");
		if($p1 eq "select" && $p2 eq "icon"){ $f=1; }
		if($f == 0){ next; }
		if($p1 eq "/select" && $f == 1){ last; }
		if($p1 eq "option" && $f == 1){
			$val="";
			foreach $line2 (@lines){
				$p1 = index($line2,$line);
				if($p1 >= 0){
					$p2 = &one_block($line2, $p1);
					if($p2 >= 0){
						$val=substr($line2, $p2+1);
						$val =~ s/\r//g;
						$val =~ s/\n//g;
					}
					last;
				}
			}
			if($val ne ""){ $val = "$p3<>$val\n"; }
			if($val ne ""){ push(@new, $val); }
		}
	}
	return @new;
}

1;