mitsudori
e8685a4807
new file: _bg/.htaccess new file: _bg/F35lastBBS.txt new file: _bg/Rock54.txt new file: _bg/Rock54_Collect.cgi new file: _bg/f15.cgi new file: _bg/f22.cgi new file: _bg/f22info.cgi new file: _bg/f35.cgi new file: _bg/index.html new file: _bg/lastbbs.txt new file: _bg/lastbbs15.txt new file: _bg/logs/20100928.txt new file: _bg/logs/20100929.txt new file: _bg/logs/20100930.txt new file: _bg/logs/20101001.txt new file: _bg/logs/20101002.txt new file: _bg/logs/Rock54-110-10-1.txt new file: _bg/logs/Rock54-110-10-2.txt new file: _bg/logs/Rock54-110-9-28.txt new file: _bg/logs/Rock54-110-9-29.txt new file: _bg/logs/Rock54-110-9-30.txt new file: _bg/logs/proxy_log.txt new file: _bg/pool.cgi new file: _boo80server/boo80server.cgi new file: _boo80server/index.html new file: bbs-entry.cgi new file: bbs-main.cgi new file: bbs.cgi new file: home/bbs-entry.cgi new file: home/bbs-main.cgi new file: home/fox.cgi new file: targz/2chbg.tar.gz new file: targz/2chboo.tar.gz new file: targz/2chhan.tar.gz
408 lines
9.6 KiB
Perl
408 lines
9.6 KiB
Perl
use strict;
|
||
use File::stat;
|
||
use Sys::Hostname;
|
||
use POSIX qw(strftime);
|
||
|
||
local our (%kname, %server); # italist.pl
|
||
local our ($remake, $magic, $DATAREA, $chanHome, $chanName, $ssvv);
|
||
|
||
##############################################################################
|
||
sub Pool
|
||
{
|
||
my $ike = $_[0] ;
|
||
if($ike =~ /tr$/) {return 0;}
|
||
|
||
require '../test/asokin/italist.pl' ;
|
||
&readItaList ;
|
||
|
||
print "<br><br>START($ike)------------><br>\n" ;
|
||
|
||
$remake = 0 ;
|
||
|
||
$magic = 1000 ;
|
||
$DATAREA = '../../_datArea' ;
|
||
print "DATAREA = $DATAREA<br>\n\n" ;
|
||
|
||
$chanHome = 'http://www.2ch.net/' ;
|
||
$chanName = '‚Q‚¿‚á‚ñ‚Ë‚é' ;
|
||
|
||
$ssvv = (split(/\./, $ENV{SERVER_NAME} || $server{$ike} || hostname))[0];
|
||
|
||
if(&Pool3Kako($ike)) {&Kakolist3($ike) ;}
|
||
print "<------- end\n" ;
|
||
}
|
||
##############################################################################
|
||
sub Pool3Kako
|
||
{
|
||
my $itaName = $_[0] ;
|
||
my $folder = "$DATAREA/$itaName/pool/" ;
|
||
|
||
print "Pool3Kako($folder)<br>\n" ;
|
||
|
||
if($itaName =~ /tr$/) {return 0;}
|
||
|
||
my @dirs ;
|
||
if(opendir(DIR, $folder))
|
||
{
|
||
@dirs = grep(!/^\./ && -f "$folder$_" && /\.dat$/, readdir(DIR));
|
||
closedir DIR ;
|
||
}
|
||
|
||
my $fileNum = @dirs ;
|
||
print "FILE<4C>” = $fileNum ($remake)<br>\n" ;
|
||
if(!$remake && !$fileNum) {return 0;}
|
||
|
||
my $ccc = 0 ;
|
||
foreach(@dirs)
|
||
{
|
||
my $xxx = $_ ;
|
||
$xxx =~ s/\.dat$//i ;
|
||
if($ccc >= $magic) {last;}
|
||
if(int($xxx) < 1000000000) {next;}
|
||
|
||
|
||
my $moveto = "$DATAREA/$itaName/oyster/" ;
|
||
mkdir($moveto, 0777) ;
|
||
chmod(0777, $moveto) ;
|
||
|
||
my $bangof0 = substr($xxx,0,4) ;
|
||
$moveto = "$DATAREA/$itaName/oyster/$bangof0/" ;
|
||
mkdir($moveto, 0777) ;
|
||
chmod(0777, $moveto) ;
|
||
|
||
my $cmdx1 = "$folder$xxx.dat" ;
|
||
my $cmdx2 = "$moveto$xxx.dat" ;
|
||
|
||
if(-e $cmdx2) {next;}
|
||
|
||
# print "cmdx1=$cmdx1\n" ;
|
||
# print "cmdx2=$cmdx2\n" ;
|
||
|
||
rename($cmdx1,$cmdx2) ;
|
||
$ccc ++ ;
|
||
}
|
||
return 1;
|
||
}
|
||
##############################################################################
|
||
sub Kakolist3
|
||
{
|
||
my $itaname = $_[0] ;
|
||
my $folder = "$DATAREA/$itaname/oyster/" ;
|
||
my $indexfile = "../$itaname/kako/index.html" ;
|
||
my $subjectxt = "../$itaname/kako/subject.txt" ;
|
||
|
||
print "Kakolist3($itaname)<br>\n" ;
|
||
|
||
my @sdirs ;
|
||
if(opendir(DIR, $folder))
|
||
{
|
||
@sdirs = sort { $b cmp $a; } grep(!/^\./ && -d "$folder$_" && /.../ && /^1/, readdir(DIR));
|
||
closedir DIR ;
|
||
}
|
||
|
||
foreach my $ttt (@sdirs)
|
||
{
|
||
my $subd = 0 ;
|
||
my $infofile = "../$itaname/kako/o$ttt/info.txt";
|
||
if(open(PINFOFILE, $infofile))
|
||
{
|
||
my $infoA = <PINFOFILE>;
|
||
close(PINFOFILE);
|
||
chomp($infoA) ;
|
||
(undef,undef,undef,$subd,undef) = split(/\t/,$infoA);
|
||
}
|
||
&html_ctrl($itaname,$ttt,$subd);
|
||
}
|
||
|
||
local *PINDEXFILE ;
|
||
open(PSUBJECTT,'>',$subjectxt) ;
|
||
open(PINDEXFILE,'>',$indexfile) ;
|
||
|
||
&html_head($itaname) ;
|
||
foreach my $ttt (@sdirs)
|
||
{
|
||
my ($subd, $subs);
|
||
my $infofile = "../$itaname/kako/o$ttt/info.txt";
|
||
if(open(PINFOFILE, $infofile))
|
||
{
|
||
my $infoA = <PINFOFILE>;
|
||
close(PINFOFILE);
|
||
chomp($infoA) ;
|
||
(undef,undef,undef,$subd,$subs) = split(/\t/,$infoA);
|
||
print PINDEXFILE<<EOF;
|
||
<TR><TD><A TARGET="_blank" HREF="o$ttt/">#$itaname$ttt</A></TD><TD align=right>$subd</TD><TD align=right>$subs</TD><TD align=right><A HREF="o$ttt/subject.txt">subject.txt</A></TD></TR>
|
||
EOF
|
||
print PSUBJECTT "o$ttt<>$ttt ($subd)\n";
|
||
}
|
||
}
|
||
&html_foot ;
|
||
close(PINDEXFILE) ;
|
||
close(PSUBJECTT) ;
|
||
|
||
}
|
||
##############################################################################
|
||
sub html_ctrl
|
||
{
|
||
my $bbs = $_[0] ;
|
||
my $numx0 = &getDatNum($bbs,$_[1]) ;
|
||
my $numx1 = $_[2] ;
|
||
if(!$remake && $numx1 == $numx0) {return;}
|
||
|
||
print "sate $_[1] $numx1/$numx0\n";
|
||
|
||
mkdir("../$bbs/kako/o$_[1]",0777);
|
||
chmod(0777,"../$bbs/kako/o$_[1]");
|
||
|
||
&Kakohtml3($bbs,$_[1]) ;
|
||
}
|
||
##############################################################################
|
||
sub Kakohtml3
|
||
{
|
||
my ($itaname, $sokonum) = @_ ;
|
||
|
||
my $sx = substr($sokonum,0,4) ;
|
||
my $folder = "$DATAREA/$itaname/oyster/$sx/" ;
|
||
my $pfolder = "../$itaname/kako/o$sx/" ;
|
||
my $infofile = "../$itaname/kako/o$sx/info.txt" ;
|
||
|
||
my $indexfile = $pfolder . 'index.html' ;
|
||
my $subjecttxt = $pfolder . 'subject.txt' ;
|
||
|
||
print "Kakohtml3 $itaname ($sokonum)<br>\n" ;
|
||
|
||
mkdir($pfolder, 0777) ;
|
||
chmod(0777, $pfolder) ;
|
||
|
||
my @junban ;
|
||
if(opendir(DIR, $folder))
|
||
{
|
||
@junban = sort { $b cmp $a; } grep(!/^\./ && -f "$folder$_", readdir(DIR));
|
||
closedir DIR ;
|
||
}
|
||
|
||
my %threTitle ;
|
||
|
||
if(open(YSUBJECTT, $subjecttxt))
|
||
{
|
||
local $_; while(<YSUBJECTT>)
|
||
{
|
||
my ($tNo,$tTitle) = split(/<>/) ;
|
||
$tNo =~ s/\.dat$//i ;
|
||
chomp($tTitle) ;
|
||
#print "$tNo,$tTitle<BR>\n";
|
||
$threTitle{$tNo} = $tTitle ;
|
||
}
|
||
close(YSUBJECTT) ;
|
||
}
|
||
|
||
my $ttlt = 0;
|
||
local (*MSUBJECTT, *MINDEXFILE) ;
|
||
open(MSUBJECTT,'>',$subjecttxt) ;
|
||
if(open(MINDEXFILE,'>',$indexfile))
|
||
{
|
||
&html_index_head($itaname) ;
|
||
foreach(@junban)
|
||
{
|
||
my $xxx = $_ ;
|
||
$xxx =~ s/\.dat$//i ;
|
||
#print "$_ $threTitle{$xxx}\n";
|
||
if(!defined $threTitle{$xxx})
|
||
{
|
||
&html_index_body($folder,$xxx,$itaname) ;
|
||
}
|
||
else
|
||
{
|
||
print MINDEXFILE "$xxx <A HREF=\"/test/read.cgi/$itaname/$xxx/\">$threTitle{$xxx}</A><BR>\n";
|
||
print MSUBJECTT "$xxx.dat<>$threTitle{$xxx}\n";
|
||
}
|
||
$ttlt ++ ;
|
||
}
|
||
&html_index_foot($itaname,$sokonum,$infofile,$ttlt) ;
|
||
close(MINDEXFILE) ;
|
||
}
|
||
close(MSUBJECTT) ;
|
||
}
|
||
##############################################################################
|
||
sub html_index_body
|
||
{
|
||
my ($folder, $datno, $itaname) = @_ ;
|
||
|
||
my $threadfile = "$folder$datno.dat" ;
|
||
my @logdat = '' ;
|
||
if(open(THREAD, $threadfile))
|
||
{
|
||
@logdat=<THREAD>; #ƒ<>ƒO‚ð”z—ñ‚É“Ç‚Ý<E2809A>ž‚Þ
|
||
close(THREAD) ;
|
||
}
|
||
#‚P‚–ڂ̗v‘f‚ð“Ç‚Ý<E2809A>ž‚Þ
|
||
my $firstlog = $logdat[0];
|
||
#‰ü<E280B0>sƒJƒbƒg
|
||
chomp($firstlog);
|
||
|
||
#‚P‚–ڂ̗v‘f‚ð‰Á<E280B0>H‚·‚é
|
||
my ($name,$mail,$time,$message,$subject) = split(/<>/,$firstlog);
|
||
my $typeSign = '<27>¦';
|
||
my $acho = '-' ;
|
||
if(!$time)
|
||
{
|
||
$firstlog =~ /([^,]*),([^,]*),([^,]*),([^,]*),([^,]*)$/;
|
||
($name,$mail,$time,$message,$subject) = ($1,$2,$3,$4,$5);
|
||
$typeSign = '<27>@';
|
||
$acho = '*' ;
|
||
}
|
||
|
||
if($acho eq '-')
|
||
{
|
||
$mail =~ s/ //gi;
|
||
# $message =~ s/&/&/gi;
|
||
$message =~ s/&(?!;)/&/g;
|
||
|
||
$message =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/<a href=\"$1\:$2\" target=\"_blank\">$1\:$2<\/a>/ig;
|
||
}
|
||
else
|
||
{
|
||
$name =~ s/<2F>—<EFBFBD>M/,/gi;
|
||
$mail =~ s/<2F>—<EFBFBD>M/,/gi;
|
||
$subject =~ s/<2F>—<EFBFBD>M/,/gi;
|
||
$message =~ s/<2F>—<EFBFBD>M/,/gi;
|
||
$message =~ s/&/&/gi;
|
||
$message =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/<a href=\"$1\:$2\" target=\"_blank\">$1\:$2<\/a>/ig;
|
||
}
|
||
|
||
$message =~ s/blank">/blank">/gi;
|
||
|
||
my $resnum=@logdat;
|
||
|
||
#print "$datno.dat<> ($resnum)\n";
|
||
|
||
print MINDEXFILE "$datno <A HREF=\"/test/read.cgi/$itaname/$datno/\">$subject ($resnum)</A><BR>";
|
||
print MSUBJECTT "$datno.dat<>$subject ($resnum)\n";
|
||
$acho = '#';
|
||
}
|
||
##############################################################################
|
||
sub html_index_head
|
||
{
|
||
my $itaname = $_[0] ;
|
||
|
||
print MINDEXFILE<<EOF;
|
||
|
||
<HTML>
|
||
<HEAD>
|
||
<TITLE>$chanName<6D>@‰ß‹Žƒ<C5BD>ƒO‘qŒÉ</TITLE>
|
||
</HEAD>
|
||
<BODY>
|
||
<a href="/$itaname/index.html"><3E>¡ŒfŽ¦”‚ɖ߂é<E2809A>¡</a>
|
||
<a href="/kakolog.html"><3E>¡‰ß‹Žƒ<C5BD>ƒO‘qŒÉ‚ß‚É‚ã<E2809A>[‚É–ß‚é<E2809A>¡</a><P>
|
||
<EFBFBD>¦<EFBFBD>V‚µ‚¢ƒf<EFBFBD>[ƒ^Œ`Ž®(teri‚̃^ƒCƒv)‚̃XƒŒƒbƒh
|
||
<P>
|
||
EOF
|
||
}
|
||
##############################################################################
|
||
sub html_index_foot
|
||
{
|
||
my ($itaname, $sokonum, $infofile, $ttlt) = @_;
|
||
my $sss = $sokonum ;
|
||
my $sss0 = $sss . '000000';
|
||
my $sss9 = $sss . '999999';
|
||
my $NOWTIME = time;
|
||
if($sss9 > $NOWTIME){$sss9 = $NOWTIME;}
|
||
|
||
my $kikan = int($sss9) - int($sss0);
|
||
$kikan /= 60;#•ª
|
||
$kikan /= 60;#ŽžŠÔ
|
||
$kikan /= 24;#“ú
|
||
my $speed = sprintf('%5.02f',$ttlt/$kikan) ;
|
||
|
||
if(open(INFOFILE, '>', $infofile))
|
||
{
|
||
print INFOFILE "$ssvv\t$itaname\t$sss\t$ttlt\t$speed\n";
|
||
close(INFOFILE);
|
||
}
|
||
|
||
|
||
print MINDEXFILE<<EOF;
|
||
<P>
|
||
<HR>
|
||
ƒXƒŒƒbƒh<EFBFBD>” = $ttlt<BR>
|
||
ƒXƒŒƒbƒh—§‚ăXƒs<EFBFBD>[ƒh = $speed / day
|
||
<HR>
|
||
–â‘è“™<EFBFBD>A‚È‚ñ‚©‚ ‚Á‚½‚ç<A HREF="http://soko.disk.io/"><font color="green">‘qŒÉ”Ô <20>š</font></A>‚Ö‚¨Šè‚¢‚µ‚Ü‚·<E2809A>B
|
||
</BODY>
|
||
</HTML>
|
||
EOF
|
||
}
|
||
##############################################################################
|
||
sub html_head
|
||
{
|
||
my $itaname = $_[0] ;
|
||
my $itakname = $kname{$itaname} ;
|
||
|
||
print PINDEXFILE<<EOF;
|
||
|
||
<HTML>
|
||
<HEAD>
|
||
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=Shift_JIS">
|
||
<TITLE>$chanName ‰ß‹Žƒ<C5BD>ƒO‘qŒÉ $itakname ”Â</TITLE>
|
||
</HEAD>
|
||
<BODY TEXT="#000000" BGCOLOR="#FFFFFF" link="#0000FF" alink="#FF0000" vlink="#660099" background="ba.gif">
|
||
<CENTER>
|
||
<h1>$chanName ‰ß‹Žƒ<C5BD>ƒO‘qŒÉ</h1><P>
|
||
<h2>$itakname ”Â</h2><P>
|
||
</CENTER>
|
||
|
||
<A HREF="$chanHome">$chanName ‚É–ß‚é<E2809A>B</A>
|
||
<P>
|
||
<A HREF="/kakolog.html">‰ß‹Žƒ<C5BD>ƒO‘qŒÉ‚ß‚É‚ã<E2809A>[ ‚É–ß‚é<E2809A>B($ssvvƒT<C692>[ƒo)</A>
|
||
<P>
|
||
<A HREF="/$itaname/index.html">$itakname<6D>—$chanName ‚É–ß‚é<E2809A>B</A>
|
||
<P>
|
||
<A HREF="subject.txt">subject.txt</A>
|
||
<TABLE BORDER=2>
|
||
<TR><TD>‘qŒÉ”Ô<E2809D>†</TD><TD>ƒXƒŒƒbƒh<C692>”</TD><TD>ƒXƒs<C692>[ƒh</TD><TD align=center>.txt</TD></TR>
|
||
EOF
|
||
|
||
}
|
||
##############################################################################
|
||
sub html_foot
|
||
{
|
||
print PINDEXFILE<<EOF;
|
||
</TABLE>
|
||
‘qŒÉ”Ô<EFBFBD>† <A HREF="index3.html">‹Œ‘qŒÉ<C592>BNo2</A><BR>
|
||
‘qŒÉ”Ô<EFBFBD>† <A HREF="index9.html">999999999 ˆÈ‘O</A><BR>
|
||
<P>
|
||
</CENTER>
|
||
<HR>
|
||
–â‘è“™<EFBFBD>A‚È‚ñ‚©‚ ‚Á‚½‚ç<A HREF="http://soko.disk.io/"><font color="green">‘qŒÉ”Ô <20>š</font></A>‚Ö‚¨Šè‚¢‚µ‚Ü‚·<E2809A>B
|
||
</BODY>
|
||
</HTML>
|
||
EOF
|
||
}
|
||
##############################################################################
|
||
sub getLastUpdateP
|
||
{
|
||
local $_ = stat($_[0]) ;
|
||
my @flt = localtime($_ ? $_->mtime : 0) ;
|
||
return {
|
||
xupdate => strftime('%Y%m%d%H%M%S', @flt),
|
||
lupdate => strftime('%Y/%m/%d %T', @flt)
|
||
};
|
||
}
|
||
##############################################################################
|
||
sub getDatNum
|
||
{
|
||
my $bbx = $_[0] ;
|
||
my $datnum = 0 ;
|
||
my $folder = "$DATAREA/$bbx/oyster/$_[1]/" ;
|
||
if(!opendir(DIR, $folder)) {return 0;}
|
||
my @dirs = grep(!/^\./ && -f "$folder$_", readdir(DIR));
|
||
closedir DIR ;
|
||
|
||
foreach my $ccccc (@dirs)
|
||
{
|
||
if($ccccc ne 'index.html' && $ccccc =~ /\.dat$/) {$datnum ++;}
|
||
}
|
||
return $datnum ;
|
||
}
|
||
##############################################################################
|
||
1;
|