#!/usr/bin/perl --
#	↑サーバーの「perl」のパスを指定。
#	駄目なら｢#!/usr/local/bin/perl5｣
#	それでも駄目ならサーバー管理者に問い合わせて下さい。

###########################################################################
##------------------------ Maga CGI(backno2.cgi)  -------------------
##   (C)Copyright 2001 by Chama.ne.jp
##   E-mail:master@chama.ne.jp
##   HP:http://www.chama.ne.jp
###########################################################################
# 免責事項、バージョン情報などはkanri.cgiを参照
#---------- ↓初期設定項目 -----------------------------------------------#
#E-mail管理用CGI名
$index = 'index.cgi';

#管理ＣＧＩ名
$kanri_cgi = 'kanri.cgi';

#基本情報ファイルの指定
$k_file = 'def/kihon.dat';

#ＣＧＩ名著作権表示ファイル名
$cgi_file = 'def/cgi.dat';

#メルマガ情報の取得
$m_file = 'def/index2.dat';

#---------- ↓プログラム--------------------------------------------------#
#----------↑設定終了↓以下は修正しない。---------------------------------
require './jcode.pl';
&decode;
#ファイルロック
&o_lock;

#基本ファイルを開く
&k_open;

#ＣＧＩファイルを開く
&cgi_open;

#メルマガ情報の取得
&title_in;
&data_in;

#入力チェック
✓

#ロック解除
&c_lock;

&prev;

#サブルーチン--------------------------------------------------------------#
#デコード処理-------------------------------------------------------------
sub decode{
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $buff, $ENV{'CONTENT_LENGTH'});
	} else {
		$buff = $ENV{'QUERY_STRING'};
	}
	@pairs = split(/&/,$buff);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ s/ /　/g;
		&jcode'convert(*value,'sjis');
		$in{$name} = $value;
	}
	$in_no = $in{'no'};
}
#基本ファイルのOPEN------------------------------------------------------
sub k_open{
	open KF,"$k_file" or die "$k_file OPEN ERROR (READ)";
		while (<KF>){
			chomp $_;
			$_ =~s/\r//g;
			($mail,$url,$logo,$title,$title_size,$title_color,
			$word_size,$word_color,$table_color,$td_color,$data,
			$bg_file,$pass,$sendmail,$pc_prevmax,$i_prevmax,$track_color,
			$face_color,$shadow_color,$darkshadow_color,$hightlight_color,
			$dlight_color,$arrow_color,$subject_form,$subject_in,$subject_out,
			$mail_on,$title_on,$i_url,$i_logo,$i_bg_file) = split(/<>/,$_);
		}
	close KF;
}
#CGI情報ファイルのOPEN-------------------------------------------------------
sub cgi_open{
	open CGIIN,"$cgi_file" or die "$cgi_file OPEN ERROR (READ)";
		while (<CGIIN>){
			$_ =~ s/[\r\n\t\f]//g;;
			$copyright = $_;
		}
	close CGIIN;
	$copyright2 = $copyright;
	$copyright2 =~ s/&copy;/\(c\)/g;
	$copyright2 =~ s/<\/?$_[^>]*>//ig;
	$copyright2 =~ s/[\r\n\t\f]//g;
}
#メルマガタイトルの取得--------------------------------------------------
sub title_in{
	open TIN,"$m_file" or die "$m_file OPEN ERROR (READ)";
		while (<TIN>){
			chomp $_;
			($m_no,$m_title,$m_time) = split(/<>/,$_);
			if($m_no == $in_no){
				$h_title = $m_title;
			}
		}
	close TIN;
}
#メルマガタイトルの取得--------------------------------------------------
sub data_in{
	$d_cnt = 0;
	$in_com = '';
	$data_file = 'data/';
	$data_file .= $in_no;
	$data_file .= '.dat';

	open DIN,"$data_file" or die "$data_file OPEN ERROR (READ)";
		while (<DIN>){
			$in_com .= $_;
		}
	close DIN;
}
#パスワード入力チェック---------------------------------------------------
sub check{
	unless($h_title){
		$err = 2;
		&err;
	}
	unless($in_com){
		$err = 3;
		&err;
	}
}
#配信内容確認画面---------------------------------------------------------
sub prev{
	&top;
	print "<br><br>\n";
	print "<table border=\"0\" width=\"640\" cellpadding=\"0\" cellspacing=\"0\">\n";
	print "<tbody>\n";
	print "<tr>\n";
	print "<td align=\"center\" bgcolor=\"$word_color\">\n";
	print "<font size=3 color=\"#FFFFFF\">\n";
	print "メルマガバックナンバー\n";
	print "</font>\n";
	print "</td>\n";
	print "</tr>\n";
	print "<tr>\n";
	print "<td align=\"center\">\n";
	print "<br>\n";
	print "<table border=0 bgcolor=$table_color width=90%>\n";
	print "<tbody>\n";
	print "<tr bgcolor=$td_color>\n";
	print "<td align=\"center\">\n";
	print "<font size=$word_size color=$word_color>\n";
	print "$h_title\n";
	print "</font>\n";
	print "</td>\n";
	print "</tr>\n";
	print "<tr bgcolor=$td_color>\n";
	print "<td>\n";
	print "<font size=$word_size color=$word_color>\n";

	#入力されたコメントの中のリンクを生成し表示
	@pcom = split(/<br>/,$in_com);
	foreach $p_(@pcom){
		$p_p = &link($p_);
		print "$p_p";
		print "\n<br>\n";
	}
	print "</font>\n";
	print "</td>\n";
	print "</tr>\n";
	print "</tbody>\n";
	print "</table>\n";
	print "<br>\n";
	print "<A href=\"$url\">\n";
	print "ホームページに戻る\n";
	print "</A>\n";
	print "　\n";
	print "<A href=\"$index\">\n";
	print "メルマガの購読開始・解除\n";
	print "</A>\n";

	print "</td>\n";
	print "</tr>\n";
	print "</tbody>\n";
	print "</table>\n";
	&last;
}
#入力されたコメント中にＵＲＬやE-mailがある場合にはリンクに変換-----------------
sub link{
	# $str の中の URI(URL) にリンクを張った $result を作る
	$str= $_[0];

	$tag_regex_ = q{(?:[^"'<>]|"[^"]*"|'[^']*')*(?:>|(?=<)|$(?!\n))}; #'}}}

	$http_URL_regex =
	q{\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f} .
	q{][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)} .
	q{*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.} .
	q{[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f]} .
	q{[0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-} .
	q{Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f} .
	q{])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)} .
	q{*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])} .
	q{*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} .
	q{)?};

	$ftp_URL_regex =
	q{\bftp://(?:(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} .
	q{(?::(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?@)?(?} .
	q{:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)*[a-zA-Z](?:[-a-zA-} .
	q{Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)?} .
	q{(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:/(?} .
	q{:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(?:;type=[} .
	q{AIDaid])?)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9} .
	q{A-Fa-f])*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A} .
	q{-Fa-f])*)?};

	$mail_regex =
	q{(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\} .
	q{\[\]\000-\037\x80-\xff])|"[^\\\\\x80-\xff\n\015"]*(?:\\\\[^\x80-\xff][} .
	q{^\\\\\x80-\xff\n\015"]*)*")(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x} .
	q{80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff])|"[^\\\\\x80-} .
	q{\xff\n\015"]*(?:\\\\[^\x80-\xff][^\\\\\x80-\xff\n\015"]*)*"))*@(?:[^(} .
	q{\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\0} .
	q{00-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[^\x80-\xff])*} .
	q{\])(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,} .
	q{;:".\\\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[} .
	q{^\x80-\xff])*\]))*};

	$text_regex = q{[^<]*};

	$result = '';  $skip = 0;
	while ($str =~ /($text_regex)($tag_regex)?/gso) {
		last if $1 eq '' and $2 eq '';
		$text_tmp = $1;
		$tag_tmp = $2;
		if ($skip) {
			$result .= $text_tmp . $tag_tmp;
			$skip = 0 if $tag_tmp =~ /^<\/[aA](?![0-9A-Za-z])/;
		} else {
			$text_tmp =~ s{($http_URL_regex|$ftp_URL_regex|($mail_regex))}
				{my($org, $mail) = ($1, $2);
				(my $tmp = $org) =~ s/"/&quot;/g;
				'<A HREF="' . ($mail ne '' ? 'mailto:' : '') . "$tmp\">$org</A>"}ego;
			$result .= $text_tmp . $tag_tmp;
			$skip = 1 if $tag_tmp =~ /^<[aA](?![0-9A-Za-z])/;
			if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) {
				$str =~ /(.*?(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$))/gsi;
				$result .= $1;
			}
		}
	}
	return($result);
}

#エラー処理--------------------------------------------------------------
sub err{
	&top;
	print "<font size=+2 color=#ff0000>\n";
	if($err==1){
		print "パスワードに誤りがあります。";
	}elsif($err == 2){
		print "メルマガのタイトルが見つかりません。";
	}elsif($err == 2){
		print "メルマガの本文が見つかりません。";
	}
	print "<br><br>ブラウザの戻るボタンで戻り修正して下さい。</font><br>\n";
	&last;
}
#HTMLprintサブルーチン---------------------------------------------------
sub top{
	print "Content-type:text/html\n\n";
	print "<html><head><title>$title</title>\n";
	print '<meta HTTP-EQUIV="Content-type" CONTENT="text/html; charset=Shift_JIS">',"\n";
	print "<STYLE type=text/css>\n";
	print '<!--',"\n";
	print 'body {scrollbar-Track-Color:',$track_color,';',"\n";
	print 'scrollbar-Face-Color:',$face_color,';',"\n";
	print 'scrollbar-Shadow-Color:',$shadow_color,';',"\n";
	print 'scrollbar-DarkShadow-Color:',$darkshadow_color,';',"\n";
	print 'scrollbar-Highlight-Color:',$hightlight_color,';',"\n";
	print 'scrollbar-3dLight-Color:',$dlight_color,';',"\n";
	print 'scrollbar-Arrow-Color:',$arrow_color,';}',"\n";
	print 'INPUT{',"\n";
	print 'color : blown;border-width : 1px 1px 1px 1px;border-style : solid solid solid solid;border-color : navy navy navy navy;}',"\n";
	print '-->',"\n";
	print "</STYLE>\n";
	print "</head>\n";
	if($bg_file){
		print "<body background=$bg_file>\n";
	}else{
		print "<body bgcolor=$bg_color>\n";
	}
	print "<center>\n";
	print "<font size=$word_size color=$word_color>\n";
	if($logo){
		print "<IMG src=$logo>\n";
		print "<br>\n";
	}
	unless($title_on == 2){
		print "<table border=\"0\" cellpadding=\"0\" cellspacing=\"1\" bgcolor=\"$table_color\">\n";
		print "<tbody>\n";
		print "<tr bgcolor=\"$td_color\">\n";
		print "<td align=center>\n";
		print "<font size=$title_size color=$title_color>\n";
		print "$title\n";
		print "</font>\n";
		print "</td>\n";
		print "</tr>\n";
		print "</tbody>\n";
		print "</table>\n";
	}
}
sub last{
	print "<HR width=\"90%\" color=\"$word_color\">\n";
	print "<font size=\"$word_size\" color=\"$word_color\">\n";
	print $copyright;
	print "</font>\n";
	print "</center>";
	print "</body></html>\n";
	exit;
}

#データロック------------------------------------------------
sub o_lock{
	open(LOCK,">data.lock");
	flock(LOCK,2);
}
#ロック解除--------------------------------------------------
sub c_lock{
	close(LOCK);
}