408 lines
9.6 KiB
Plaintext
408 lines
9.6 KiB
Plaintext
|
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 = '<27>Q<EFBFBD><51><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>˂<EFBFBD>' ;
|
|||
|
|
|||
|
$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><45> = $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>; #<23><><EFBFBD>O<EFBFBD><4F><EFBFBD>z<EFBFBD><7A><EFBFBD>ɓǂݍ<C782><DD8D><EFBFBD>
|
|||
|
close(THREAD) ;
|
|||
|
}
|
|||
|
#<23>P<EFBFBD>ڂ̗v<CC97>f<EFBFBD><66><EFBFBD>ǂݍ<C782><DD8D><EFBFBD>
|
|||
|
my $firstlog = $logdat[0];
|
|||
|
#<23><><EFBFBD>s<EFBFBD>J<EFBFBD>b<EFBFBD>g
|
|||
|
chomp($firstlog);
|
|||
|
|
|||
|
#<23>P<EFBFBD>ڂ̗v<CC97>f<EFBFBD><66><EFBFBD><EFBFBD><EFBFBD>H<EFBFBD><48><EFBFBD><EFBFBD>
|
|||
|
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>@<40>ߋ<EFBFBD><DF8B><EFBFBD><EFBFBD>O<EFBFBD>q<EFBFBD><71></TITLE>
|
|||
|
</HEAD>
|
|||
|
<BODY>
|
|||
|
<a href="/$itaname/index.html"><3E><><EFBFBD>f<EFBFBD><66><EFBFBD>ɖ߂遡</a>
|
|||
|
<a href="/kakolog.html"><3E><><EFBFBD>ߋ<EFBFBD><DF8B><EFBFBD><EFBFBD>O<EFBFBD>q<EFBFBD>ɂ߂ɂ<DF82><C982>[<5B>ɖ߂遡</a><P>
|
|||
|
<EFBFBD><EFBFBD><EFBFBD>V<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>f<EFBFBD>[<5B>^<5E>`<60><>(teri<72>̃^<5E>C<EFBFBD>v)<29>̃X<CC83><58><EFBFBD>b<EFBFBD>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;#<23><>
|
|||
|
$kikan /= 60;#<23><><EFBFBD><EFBFBD>
|
|||
|
$kikan /= 24;#<23><>
|
|||
|
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>
|
|||
|
<EFBFBD>X<EFBFBD><EFBFBD><EFBFBD>b<EFBFBD>h<EFBFBD><EFBFBD> = $ttlt<BR>
|
|||
|
<EFBFBD>X<EFBFBD><EFBFBD><EFBFBD>b<EFBFBD>h<EFBFBD><EFBFBD><EFBFBD>ăX<EFBFBD>s<EFBFBD>[<5B>h = $speed / day
|
|||
|
<HR>
|
|||
|
<EFBFBD><EFBFBD><EFBFBD>蓙<EFBFBD>A<EFBFBD>Ȃ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><A HREF="http://soko.disk.io/"><font color="green"><3E>q<EFBFBD>ɔ<EFBFBD> <20><></font></A><3E>ւ<EFBFBD><D682>肢<EFBFBD><E882A2><EFBFBD>܂<EFBFBD><DC82>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 <20>ߋ<EFBFBD><DF8B><EFBFBD><EFBFBD>O<EFBFBD>q<EFBFBD><71> $itakname <20><></TITLE>
|
|||
|
</HEAD>
|
|||
|
<BODY TEXT="#000000" BGCOLOR="#FFFFFF" link="#0000FF" alink="#FF0000" vlink="#660099" background="ba.gif">
|
|||
|
<CENTER>
|
|||
|
<h1>$chanName <20>ߋ<EFBFBD><DF8B><EFBFBD><EFBFBD>O<EFBFBD>q<EFBFBD><71></h1><P>
|
|||
|
<h2>$itakname <20><></h2><P>
|
|||
|
</CENTER>
|
|||
|
|
|||
|
<A HREF="$chanHome">$chanName <20>ɖ߂<C996><DF82>B</A>
|
|||
|
<P>
|
|||
|
<A HREF="/kakolog.html"><3E>ߋ<EFBFBD><DF8B><EFBFBD><EFBFBD>O<EFBFBD>q<EFBFBD>ɂ߂ɂ<DF82><C982>[ <20>ɖ߂<C996><DF82>B($ssvv<76>T<EFBFBD>[<5B>o)</A>
|
|||
|
<P>
|
|||
|
<A HREF="/$itaname/index.html">$itakname<6D><65>$chanName <20>ɖ߂<C996><DF82>B</A>
|
|||
|
<P>
|
|||
|
<A HREF="subject.txt">subject.txt</A>
|
|||
|
<TABLE BORDER=2>
|
|||
|
<TR><TD><3E>q<EFBFBD>ɔԍ<C994></TD><TD><3E>X<EFBFBD><58><EFBFBD>b<EFBFBD>h<EFBFBD><68></TD><TD><3E>X<EFBFBD>s<EFBFBD>[<5B>h</TD><TD align=center>.txt</TD></TR>
|
|||
|
EOF
|
|||
|
|
|||
|
}
|
|||
|
##############################################################################
|
|||
|
sub html_foot
|
|||
|
{
|
|||
|
print PINDEXFILE<<EOF;
|
|||
|
</TABLE>
|
|||
|
<EFBFBD>q<EFBFBD>ɔԍ<EFBFBD> <A HREF="index3.html"><3E><><EFBFBD>q<EFBFBD>ɁBNo2</A><BR>
|
|||
|
<EFBFBD>q<EFBFBD>ɔԍ<EFBFBD> <A HREF="index9.html">999999999 <20>ȑO</A><BR>
|
|||
|
<P>
|
|||
|
</CENTER>
|
|||
|
<HR>
|
|||
|
<EFBFBD><EFBFBD><EFBFBD>蓙<EFBFBD>A<EFBFBD>Ȃ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><A HREF="http://soko.disk.io/"><font color="green"><3E>q<EFBFBD>ɔ<EFBFBD> <20><></font></A><3E>ւ<EFBFBD><D682>肢<EFBFBD><E882A2><EFBFBD>܂<EFBFBD><DC82>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;
|