$subject

#!/usr/bin/perl use strict; use vars qw($bbs $key $st $to $ls $im $nf $ko $db @dat $resno); use vars qw($datdir $kakodir $cgiver $cginame $baseurl $daturl $size $now $ONE); $cgiver = "ir.cgi / 0.4 (02/09/03)"; $cginame = "ir.cgi"; $datdir = "../dat"; $kakodir = "../dat2"; $baseurl = "http://$ENV{'HTTP_HOST'}"; $now = time; #decode { my ($name,$value,%get,$range); if($ENV{'QUERY_STRING'} ne ""){ foreach(split /&/, $ENV{'QUERY_STRING'}){ ($name, $value) = split /=/; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2',$1)/eg; $get{$name} = $value; } $bbs = $get{'bbs'}; $key = $get{'key'}; $st = $get{'st'}; $to = $get{'to'}; $ls = $get{'ls'}; $im = $get{'imode'}; $nf = $get{'nofirst'}; $ko = $get{'kako'}; $db = $get{'debug'}; } elsif($ENV{'PATH_INFO'} ne ""){ ($name,$bbs, $key, $range) = split (/\//,$ENV{'PATH_INFO'}); if($range =~ /^l(\d+)/){$ls = $1;} if($range =~ /^(\d+)\-(\d+)/){$st = $1; $to = $2;} elsif ($range =~ /\-(\d+)/){$to = $1;} elsif ($range =~ /(\d+)\-/){$st = $1;} elsif ($range =~ /^(\d+)/){$st = $1; $to = $1; $nf = "true"; $ONE = 1;} if($range =~ /\./){$nf = "false";} if($range =~ /n/){$nf = "true";} if($range =~ /k/){$ko = "true";} #kakolog } else{&error("ｵﾌﾟｼｮﾝ無いよ。");} } #main { # datファイル指定/サイズ取得 my $datfile = $datdir . "/" . $key . ".dat"; my $kakofile = $kakodir . "/" . $key . ".dat"; my $k_flag = 0; $size = (stat($datfile))[7]; $size = int($size/1024); #存在確認/新スレ立て if($key eq "New_thread"){&new_thread;} if(!-e "$datfile"){&error("ﾌｧｲﾙ見つからないよ");} print "Content-type: text/html\n\n"; #dat読み出し。 my ($name, $mail, $date, $message, $subject,$mailto,$nom); open(IN,"$datfile"); @dat = ;#! close(IN); $resno=@dat+1; ($name, $mail, $date, $message, $subject) = split /<>/, $dat[0]; chomp($subject); if($ls =~ /(\d+)/){$st = $resno - $1;} if($st < 1){$st = 1;} if(!$to){$to=$resno;} #dat表示 my $str = $st; print "$subject"; #リンク・タイトル print "ｽﾚ一覧 1- 最新

$subject

"; ### 1の書き込み if($nf ne "true" || $st == 1){ $message = &Message($message,1); $name =~ s///g;$name =~ s/<\/b>//g;$name =~ s/ ◆/◆/;$name =~ s/ ★/★/; if($name =~ /]*>//gi; $name =~ s/<\/font>//gi; $name = "$name"; } if($date =~ /(\d*)\/(\d*)\/(\d*)$[^$]*\) (\d*)\:(\d*)(.*)/){ $date = &Time_Cut($2) . "/" . &Time_Cut($3) . " " . &Time_Cut($4) . ":" . &Time_Cut($5) . $6; } $nom = "1"; $mailto = $name; if($message eq ""){ $name=$mail="";$subject=$message="[ここ壊れてます]";} print "$nom:$mailto ($date)
$message
"; if($st ==1){$st++;} } ### 2以降の書き込み while($st != ($to+1)){ if($dat[$st-1] eq ""){last;} chomp($dat[$st-1]); ($name, $mail, $date, $message) = split /<>/, $dat[$st-1]; my $st1 = $st + 1; $message = &Message($message,$st); # 省略 $name =~ s///g;$name =~ s/<\/b>//g;$name =~ s/ ◆/◆/;$name =~ s/ ★/★/; if($name =~ /]*>//gi; $name =~ s/<\/font>//gi; $name = "$name"; } if($date =~ /(\d*)\/(\d*)\/(\d*)$[^$]*\) (\d*)\:(\d*)(.*)/){ $date = &Time_Cut($2) . "/" . &Time_Cut($3) . " " . &Time_Cut($4) . ":" . &Time_Cut($5) . $6;} $nom = "$st"; $mailto = "$name"; if($message eq ""){$name=$mail="";$subject=$message="[ここ壊れてます]";} print "$nom:$mailto ($date)
$message
"; $st++; } $st--; unless($resno - 1 > $st){ my $st1=$st + 1; print " 新着"; } # 前10 if($st > 10){ if ($ls eq "") { my $st1 = $st - 10; my $st2 = $st1 - 9; $st2 = 1 if $st2 < 1; print " 前"; }else{ my $st1 = $st - $ls; my $st2 = $st1 - 10; $st2 = 1 if $st2 < 1; print " 前"; } } # 次10＆最新10 if(!($ls || $to > 1001 || $to > $resno)){ my $st1=$st+10; my $st2=$st+1; print " 次"; print " 最新"; } # 書き込みフォーム if ($ko eq "true") {print "書込不可\n";} elsif($resno < 1001){ print "
名前：

メール：

本文：

"; } print " $cgiver"; print ""; exit; } sub new_thread { print "Content-type: text/html\n\nｽﾚ立て"; print "$bbsに新ｽﾚを立てます
項目埋めて｢ｽﾚ立て｣を押して下さい
ｽﾚ名：

名前：

メール：

本文：

"; print " $cgiver"; print ""; exit; } sub error { my $topic = shift; print "Content-type: text/html\n\nERROR[ 掲示板に戻る ]
ｴﾗｰ:$topic
$cgiver"; exit; } sub Message { my $message = $_[0]; my $st = $_[1]; if(&StrCount($message , '　 ') > 3){$message = '(AA略)';} else{ $message = &Link($message); # $message =~ s///g; $message =~ s///g; # $message =~ s/\/test\/read.cgi/hoge/g; $message =~ s/>>(\d{1,3})/>$1/g; $message =~ s/>/>/g; $message =~ s/　/ /g; $message =~ s/ */ /g; $message =~ s/
(
)*/
/g; $message =~ s/
/
/g; $message =~ s/
/
/g; $message =~ s/^ (.*)$/$1/; if(!$ONE){ my $m2 = $message; my $br_count = 0; $br_count = ($m2 =~ s/
//g); if($br_count > 4){ my @Mes = (); @Mes = split(/
/,$message); $message = ""; foreach (0 .. 3){$message .= "$Mes[$_]
";} $br_count++; $message .= "(略:$br_count行)"; } } } return $message; } sub Link { my $link = $_[0]; my $url; my @URL; my $r = ''; my %URL; my $X; $URL{'sub-all.com'} = '他ｽﾚ'; $URL{'bbs2.jp'} = '他ｽﾚ'; $URL{'bbs2.net'} = '他ｽﾚ'; $URL{'bbs2.com'} = '他ｽﾚ'; while ( $link =~ /^(.*)?http\:\/\/([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)(.*)?$/i ){ $url = $2; $link = $1; $r = "$3$r"; if($url =~ /^([^\.]*\.2ch\.net\/test\/)(read\.cgi|r\.i)([^\/]*)\/(\d*)(.*)?$/){ $r = "2chｽﾚｯﾄﾞ" . "$r";} elsif($url =~ /^([^\/]*)(\/test\/read\.cgi\/)([^\/]*)\/(\d*)(.*)?$/){ @URL = ($1 , $2 , $3 , $4 , $5); if($URL[4] !~ /\//){ $URL[4] .= '/'; } if($URL[4] !~ /i/){ $URL[4] .= 'i'; } $X = $URL{$URL[0]}; $X = '2ch型掲示板' if ($X eq ''); $r = "$X" . "$r"; }else{ my $url2 = $url; if($url2 =~ /^www\.(.*)$/){ $url2 = $1; } $url2 = substr($url2 , 0 , 8) if (length($url2) > 7); $r = "$url2" . "$r"; } } $r = $link . $r; return $r; } sub Time_Cut{ my $x = $_[0]; if($x =~ /^0(.*)/){$x = $1;} return $x; } sub StrCount { my ($Str,$Str2) = @_; my $Count = 0; $Count = ($Str =~ s/$Str2//g); return $Count; }