API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jan 2nd, 2016
887
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 21.08 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/local/bin/perl -w
  2. use strict 'vars';
  3. use warnings;
  4.  
  5. # ソースコードはUTF-8として保存
  6. # utf8プラグマを有効にする
  7. ##use open ':std', ':encoding(UTF-8)';
  8. #use utf8;
  9. #use Encode 'decode';
  10. #use Encode 'encode';
  11.  
  12. use LWP::UserAgent;
  13. use HTTP::Request;
  14. use HTTP::Status;
  15. use HTTP::Request::Common;
  16.  
  17. $| = 1 ;
  18. umask(0) ;
  19.  
  20. my $P53 = "off" ; # "off" = off , "on" = on
  21. $P53 = "on" ; # "off" = off , "on" = on
  22. my $KB = 1024 * 400 ; #　出動バイト数
  23.  
  24. # 自動修復 p53 を作るぞ at hello.2ch.net/_bg/
  25. my $debdeb = 1;
  26. #my $thisCgi = "p53.cgi ver 0.00 (Perl,SJIS) 2015/11/18 FOX. [$P53]";
  27. my $thisCgi = "p53 ver 0.05 (Perl,SJIS) 2015/12/26 FOX. [$P53]";
  28. my $home = $ENV{"HOME"};
  29. my $here = "$home/public_html/_bg";
  30. my $debFile = "$here/1p53.txt";
  31. my $semFile = "$here/sem.p53.txt";
  32.  
  33. # タイムゾーンの設定
  34. $ENV{'TZ'} = "JST-9";
  35. my $now = time ;
  36. my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($now);
  37. $year += 1900 ;
  38. $mon ++ ;
  39.  
  40. my $exe_uptime= `/usr/bin/uptime`;
  41.  
  42. my $LA1 = $exe_uptime;
  43. $LA1 =~ s/.+load averages: //;
  44. $LA1 =~ s/,.+//;
  45. $LA1 =~ s/\n//;
  46.  
  47.  
  48. if($mon < 10) {$mon = "0$mon" ;}
  49. if($mday < 10) {$mday = "0$mday";}
  50. if($hour < 10) {$hour = "0$hour";}
  51. if($min < 10) {$min = "0$min" ;}
  52. if($sec < 10) {$sec = "0$sec" ;}
  53. my $repFile = "$home/public_html/_service/p53-$year$mon$mday.txt";
  54. $debFile = "$here/logs/p$year$mon$mday.txt";
  55. &debLog("===== $thisCgi =====") ;
  56. #&debLog("here=[$here]") ;
  57.  
  58. if(-f $semFile)
  59. {
  60. print "$year/$mon/$mday $hour:$min:$sec skip ?\n";
  61. my $modtime = time - (stat($semFile))[9];
  62.  
  63. print " # $modtime pasted.\n";
  64. if($modtime < 60*15)
  65. {
  66. print " # < 15 min skiped.\n";
  67. exit;
  68. }
  69. print " # > 15 run !\n";
  70. }
  71. print "$year-$mon-$mday $hour:$min:$sec run run run !\n";
  72. if(open(SEM,"> $semFile"))
  73. {
  74. print SEM "now making $thisCgi\n";
  75. close(SEM);
  76. }
  77.  
  78. my $SRV = &getThisServer() ;
  79. my $BBS = "bbs ???" ;
  80. my $KEY = "key 123 ???" ;
  81. my $SUB = "sub スレタイ ???" ;
  82. my $OLDkey = "old key 123 ???" ;
  83. my $MAEstr = "" ;
  84. my $MAElen = 0 ;
  85.  
  86. if($min eq "00") {&Report("## これは = $thisCgi)");}
  87.  
  88. &foxP53() ;
  89.  
  90. &debLog("### ended. $thisCgi") ;
  91.  
  92. unlink($semFile);
  93. exit;
  94.  
  95.  
  96. #################################################################################
  97. # getThisServer #
  98. #################################################################################
  99. sub getThisServer()
  100. {
  101. my $fName = "/var/tmp/hostname";
  102.  
  103. my @srv = () ;
  104. if(!open(HOST,"$fName")) {return "??? $fName";}
  105. @srv = <HOST> ;
  106. close(HOST) ;
  107.  
  108. my $server = $srv[0] ;
  109. return "$server" ;
  110. }
  111. #################################################################################
  112. # foxP53 #
  113. #################################################################################
  114. sub foxP53()
  115. {
  116. #my ($dir,$oFile) = @_;
  117. #&debLog("foxP53()") ;
  118.  
  119. #&execP53("../newsplus") ;
  120.  
  121. $BBS = "iPhone" ;
  122. #&execP53("../$BBS") ;
  123. #&execP53("$home/public_html/_zzz/$BBS") ;
  124. #return 1;
  125.  
  126. my $dir = ".." ;
  127. $dir = "$home/public_html" ;
  128. #&debLog("dir=[$dir]") ;
  129. if(!opendir(DIR, "$dir"))
  130. {
  131. &debLog("foxP53() open Error $dir");
  132. return 0;
  133. }
  134. my @filelist = grep !/^\./, readdir DIR;
  135. closedir(DIR);
  136.  
  137.  
  138. foreach my $time (@filelist)
  139. {
  140. #&debLog("foxP53() $time");
  141. $BBS = $time ;
  142. if($BBS =~ /tr$/) {next;}
  143. #&execP53("../$BBS") ;
  144. my $speed = &getSpeed("$home/public_html/$BBS/SETTING.TXT") ;
  145. if(!$speed) {next;}
  146.  
  147. &execP53($speed,"$home/public_html/_zzz/$BBS") ;
  148. }
  149.  
  150.  
  151. return 1 ;
  152. }
  153. #################################################################################
  154. # getSpeed #
  155. #################################################################################
  156. sub getSpeed()
  157. {
  158. my ($txt) = @_ ;
  159. my @set= () ;
  160.  
  161. return 300;
  162. return 1000;
  163.  
  164. if(!open(SET,"$txt")) {return 0;}
  165.  
  166. @set = <SET> ;
  167. close(SET) ;
  168.  
  169. foreach my $line (@set)
  170. {
  171. if($line =~ /FOX_P53=(\d+)/)
  172. {
  173. my $speed = $1 ;
  174. if($speed < 1) {$speed = 0;}
  175. if($speed > 3333) {$speed = 3333;}
  176. #&debLog("stopSetting($txt)=$line($speed)");
  177. return $speed ;
  178. }
  179. }
  180. return 0;
  181. }
  182. #################################################################################
  183. # existDat #
  184. #################################################################################
  185. sub existDat()
  186. {
  187. my ($key) = @_;
  188.  
  189. my $dat = "123" ;
  190. # check here
  191. $dat = "$home/public_html/_zzz/$BBS/dat/$key.dat" ;
  192. if(-f "$dat")
  193. {
  194. #&debLog("here =[$dat]") ;
  195. return 1;
  196. }
  197.  
  198. # check there 1
  199. $dat = "$home/_datArea/$BBS/pool/$key.dat" ;
  200. if(-f "$dat")
  201. {
  202. #&debLog("there 1=[$dat]") ;
  203. return 1;
  204. }
  205.  
  206. # check there 2
  207. my $k4 = substr($key,0,4) ;
  208. $dat = "$home/_datArea/$BBS/oyster/$k4/$key.dat" ;
  209. if(-f "$dat")
  210. {
  211. #&debLog("there 2=[$dat]") ;
  212. return 1;
  213. }
  214.  
  215. return 0 ;
  216. }
  217. #################################################################################
  218. # makeNextKey #
  219. #################################################################################
  220. sub makeNextKey()
  221. {
  222. my ($key) = @_;
  223. my $ii = 0 ;
  224.  
  225. for($ii=0;$ii<200;$ii++)
  226. {
  227. $key ++ ;
  228. if(!&existDat($key)) {return $key;}
  229. }
  230.  
  231. return 0 ;
  232. }
  233. #################################################################################
  234. # execP53 #
  235. #################################################################################
  236. sub execP53()
  237. {
  238. my ($speed,$bbsDir) = @_;
  239. #&debLog("execP53($bbsDir)") ;
  240.  
  241. my $dir = "$bbsDir/dat" ;
  242. #&debLog("dir=[$dir]") ;
  243. if(!opendir(DIR, "$dir"))
  244. {
  245. #&debLog("execP53() open Error $dir");
  246. return 0;
  247. }
  248. my @filelist = grep !/^\./, readdir DIR;
  249. closedir(DIR);
  250.  
  251. my %timefile;
  252. foreach my $file (@filelist)
  253. {
  254. #my $mtime = (stat("$dir/$file"))[9];
  255. my $mtime = (stat("$dir/$file"))[7]; ## file size
  256. #my $mtime = $file; ## file name
  257. #&debLog("execP53() $file = $mtime");
  258. #print "$file = $mtime\n";
  259. push @{$timefile{$mtime}},"$file";
  260. }
  261.  
  262. my $delCount = 0 ;
  263. my $thrCount = 0 ;
  264. foreach my $time (sort {$b <=> $a} keys %timefile)
  265. {
  266. foreach (@{$timefile{$time}})
  267. {
  268. if($_ !~ /\.dat$/) {next;}
  269.  
  270. $thrCount ++ ;
  271. my $key = $_ ;
  272.  
  273. $key =~ s/\.dat// ;
  274.  
  275.  
  276. $OLDkey = $key ;
  277. $KEY = &makeNextKey($key);
  278. if(!$KEY) {next;}
  279.  
  280. my $kaimeX = $KEY - $key ;
  281. my $kaime = $KEY - $key ;
  282. if($kaime < 1) {$kaime = 1;}
  283. if($kaime > 5) {$kaime = 5;}
  284.  
  285. my $limit = int($speed * (0.7 ** $kaime)) ;
  286.  
  287. my $rNum = getResNum("$dir/$_") ;
  288. if($rNum < 20) {next;}
  289. my $ratio = int($time / $rNum ) ;
  290. if($ratio < $limit) {next;}
  291.  
  292. if(!(-w "$dir/$_")) {next;}
  293.  
  294. #next;
  295. # if($time < $KB) {next;}
  296.  
  297. #if($key ne "1447778990") {next;}
  298. #if($key ne "1447905734") {next;}
  299.  
  300. #&debLog("execP53($BBS) $time/$rNum=$ratio($speed,$kaime,$limit) $key - $KEY");
  301.  
  302.  
  303. if(&removeUme("$dir/$key.dat","$dir/$KEY.dat",$kaimeX,$key))
  304. {
  305. &debLog("execP53($BBS) $time/$rNum=$ratio($speed,\033[0;33m${kaimeX}\033[0;39m,$limit) $key - $KEY");
  306. $delCount ++ ;
  307. }
  308. }
  309. }
  310. #&debLog("execP53($BBS) $delCount/$thrCount found.");
  311. return 1 ;
  312. }
  313. #################################################################################
  314. # removeUme #
  315. #################################################################################
  316. sub removeUme()
  317. {
  318. my ($datFile,$newFile,$kaime,$orgKey) = @_;
  319. #&debLog("removeUme($datFile)") ;
  320. #&debLog("removeUme($newFile)") ;
  321.  
  322. # check
  323. if(-f $datFile)
  324. {
  325. #&debLog("checkD($datFile)=exist") ;
  326. }
  327. else
  328. {
  329. &debLog("checkD($datFile)=NOT exist") ;
  330. return 0;
  331. }
  332. if(-f $newFile)
  333. {
  334. &debLog("checkN($newFile)=exist") ;
  335. return 0;
  336. }
  337. else
  338. {
  339. #&debLog("checkN($newFile)=NOT exist") ;
  340. }
  341.  
  342. if(-w $datFile)
  343. {
  344. #&debLog("checkD($datFile)=writable") ;
  345. }
  346. else
  347. {
  348. if($BBS eq "iPhone") {&debLog("checkD($BBS/$KEY)=NOTw");}
  349. return 0;
  350. }
  351. if(-w $newFile)
  352. {
  353. #&debLog("checkN($newFile)=writable") ;
  354. }
  355. else
  356. {
  357. #&debLog("checkN($newFile)=NOT writable") ;
  358. }
  359.  
  360. #return 0;
  361. # read
  362. my @dat = () ;
  363. if(!open(DAT,"$datFile"))
  364. {
  365. &debLog("removeUme() open Error $datFile");
  366. return 0;
  367. }
  368. @dat = <DAT> ;
  369. close(DAT) ;
  370.  
  371. my $resMax = @dat ;
  372. if($resMax < 900)
  373. {
  374. #&debLog("removeUme resMax=$resMax") ;
  375. # return 0;
  376. }
  377.  
  378.  
  379. #remove
  380. my $ume = 0 ;
  381. my $ii = 0 ;
  382. $MAEstr = "" ;
  383. $MAElen = 0 ;
  384. my @hash= () ;
  385. foreach my $line(@dat)
  386. {
  387. my $jj = $ii + 1 ;
  388. my ($name,$mail,$hizke,$honb,$sub) = split(/<>/,$line) ;
  389.  
  390. if($jj eq 1)
  391. {
  392. if($name !~ /(●=|侍=|☆=|旭=|麒=)/)
  393. {
  394. #&Report("　★スレ=skip[$name]");
  395. return 0;
  396. }
  397. else
  398. {
  399. $sub =~ s/\n//g;
  400. #&Report("　★スレ=GO[$name] $orgKey $sub");
  401. &debLog("GO! $BBS:$orgKey:$resMax") ;
  402. }
  403.  
  404. $SUB = "$sub";
  405. $SUB =~ s/\n$// ;
  406. }
  407.  
  408. $hash[$ii] = &makeHash($ii,$line,$orgKey) ;
  409. $ii ++ ;
  410.  
  411. if(!&isUmetate($jj,$line,$orgKey,@hash)) {next;}
  412.  
  413. $ume ++ ;
  414. #&debLog("AAremoveUme $jj=$hizke") ;
  415.  
  416. }
  417. if($ume < 1)
  418. {
  419. #&debLog("P53 ng($BBS:$KEY) ume=${ume} [$P53]") ;
  420. return 0;
  421. }
  422.  
  423. ##return 0;
  424.  
  425. # create new dat
  426. #unlink("$newFile") ;
  427. #&debLog("removeUme(new) $newFile") ;
  428. if(-f "$newFile")
  429. {
  430. &debLog("removeUme() already exist $newFile");
  431. #return 0;
  432. }
  433.  
  434. #&debLog("removeUme($datFile)") ;
  435. #&debLog("ume=$ume") ;
  436. #return 0;
  437.  
  438. &debLog("P53 \033[0;36mgo\033[0;39m($BBS:$orgKey) ume=${ume} [$P53]") ;
  439. #&debLog("http://${SRV}/test/read.cgi/${BBS}/${OLDkey}/l2") ;
  440.  
  441. if($P53 ne "on") {return 1;}
  442. #return 0;
  443.  
  444. if(!open(DAT,"> $newFile"))
  445. {
  446. &debLog("removeUme() open Error $newFile");
  447. return 0;
  448. }
  449.  
  450. my $p53 = "P53a<>やっとでました<>date<>やっとでた<>title";
  451. $ii = 0 ;
  452. my $xx = 1 ;
  453. my @zz = () ;
  454. $MAEstr = "" ;
  455. $MAElen = 0 ;
  456. foreach my $line(@dat)
  457. {
  458. my $jj = $ii + 1 ;
  459. $ii ++ ;
  460.  
  461. # バイト文字列(外部からの入力)を内部文字列に変換($strがShift_Jisの場合)
  462. #$line = decode('Shift_Jis',$line);
  463.  
  464. my ($name,$mail,$hizke,$honb,$sub) = split(/<>/,$line) ;
  465. #my $p53 = "P53a<>やっとでました<>$hizke<>やっとでた<>$sub";
  466. if(&isUmetate($jj,$line,$orgKey,@hash))
  467. {
  468. next ;
  469. }
  470. $zz[$jj] = $xx ;
  471. $xx ++ ;
  472.  
  473. $p53 = $line ;
  474. ##if($jj eq 1) {$p53 =~ s/\n$/ p53\n/ ;}
  475.  
  476. #href="../test/read.cgi/iPhone/1447905734/742" target="_blank">
  477. #if($p53 =~ /href=\"\.\.\/test\/read.cgi\/(\.+)\/([-\d]+)\/(\d+)\" target=\"_blank\">/)
  478. if($p53 =~ /\/([0-9a-zA-Z]+)\/([0-9]+)\/([0-9]+)\"/)
  479. {
  480. my $bbs = $1 ;
  481. my $key = $KEY ;
  482. my $nn = $3 ;
  483. if(!$nn) {$nn = 1;}
  484. if($nn >= $jj) {$nn = 1;}
  485. my $yy = $zz[$nn] ;
  486. if(!$yy) {$yy = 1;}
  487. #&debLog(">>$nn - $yy($jj)") ;
  488. #$p53 =~ s/href=\"\.\.\/test\/read.cgi\/\.+\/[-\d]+\/\d+\"/href=\"\.\.\/test\/read.cgi\/$bbs\/$key\/$yy\"/ ;
  489. #$p53 =~ s/href=/href=AAA\/${bbs}\/${key}\/${yy}BBB/ ;
  490. $p53 =~ s/href=\"\.\.\/test\/read\.cgi\/([0-9a-zA-Z]+)\/([0-9]+)\/([0-9]+)\"/href=\"..\/test\/read.cgi\/${bbs}\/${key}\/${yy}\"/ ;
  491. $p53 =~ s/&gt;&gt;[\d]+/&gt;&gt;${yy}/ ;
  492. }
  493.  
  494. ## if($p53 =~ /&gt;&gt;([\d]+)/)
  495. ## {
  496. ## my $nn = $1 ;
  497. ## my $yy = $zz[$nn] ;
  498. ## #$p53 =~ s/&gt;&gt;[\d]+/&gt;&gt;yy ${nn} → ${yy}/ ;
  499. ## $p53 =~ s/&gt;&gt;[\d]+/&gt;&gt;${yy}/ ;
  500. ## }
  501.  
  502. # 内部文字列をUTF-8バイト文字列に変換する場合
  503. #$p53 = encode('Shift_Jis', $p53);
  504.  
  505. print DAT "$p53";
  506. }
  507. close(DAT) ;
  508.  
  509. my $szOld = (stat("$datFile"))[7]; ## file size
  510. my $szNew = (stat("$newFile"))[7]; ## file size
  511.  
  512. if($kaime < 1)
  513. {
  514. if(!open(DAT,">> $newFile"))
  515. {
  516. &debLog("removeUme(2) open Error $newFile");
  517. return 0;
  518. }
  519.  
  520. my $OLDkey = $KEY ;
  521. $SUB =~ s/\n//g;
  522.  
  523. $p53 = "" ;
  524. $p53 .= "p53 ★<>" ;
  525. $p53 .= "やっとでました<>" ;
  526. $p53 .= "やっと出た<>" ;
  527. #$p53 .= "$thisCgi <br>" ;
  528. $p53 .= "<a href=\"../test/read.cgi/${BBS}/${OLDkey}/1\">&gt;&gt;1</a> 元のスレ " ;
  529. #$p53 .= "<br>" ;
  530. #$p53 .= "$SUB " ;
  531. $p53 .= "<b>$szOld -> $szNew</b> (バイト)<br>" ;
  532. #$p53 .= 'p53　テストに夢中。これ以降書いても消えちゃうかも<br>' ;
  533. #$p53 .= 'p53　テストに夢中。ちょっと通りますよ。再開↓<br>' ;
  534. #$p53 .= 'p53 とは、http://server.maido3.com/?txt=kirei#top<br>' ;
  535. $p53 .= "<>\n" ;
  536. print DAT "$p53";
  537.  
  538. close(DAT) ;
  539. }
  540. # swap
  541.  
  542. chmod(0555, "$datFile") ;
  543. rename("$datFile","$datFile.tmp") ;
  544. rename("$newFile","$datFile") ;
  545. rename("$datFile.tmp","$newFile") ;
  546.  
  547. my $sakusei = "作成済";
  548. if($kaime > 10)
  549. #if($kaime > 1)
  550. {
  551. $sakusei = "不作成" ;
  552. unlink("$newFile") ;
  553. #unlink("$datFile.tmp") ;
  554. }
  555. else
  556. {
  557. my $pool = "$home/_datArea/$BBS/pool/$KEY.dat" ;
  558. #&debLog("BBS[$BBS]") ;
  559. #&debLog("newFile[$newFile]") ;
  560. #&debLog("pool[$pool]") ;
  561.  
  562. #rename("$datFile.tmp","$newFile") ;
  563. my $cmd = "mv $newFile $pool" ;
  564. #&debLog("cmd[$cmd]") ;
  565. system("$cmd") ;
  566. #rename("$newFile","$pool") ;
  567. #_mv("$datFile.tmp","$pool") ;
  568. }
  569.  
  570. $SUB =~ s/[ \t　]+$//;
  571. $SUB =~ s/\[転載禁止\]//;
  572. $SUB =~ s/&#169;2ch.net//;
  573.  
  574. $xx -- ;
  575.  
  576. &Report("$BBS $szOld -(${ume}削)-> $szNew(bytes) $SUB($xx)");
  577. &Report("　現スレ=http://${SRV}/test/read.cgi/${BBS}/${OLDkey}/l2 ${kaime}回目");
  578. &Report("　元スレ=http://${SRV}/test/read.cgi/${BBS}/${KEY}/l2 ${sakusei}");
  579.  
  580. return 1;
  581. }
  582. #################################################################################
  583. # getResNum #
  584. #################################################################################
  585. sub getResNum()
  586. {
  587. my ($fName) = @_;
  588. my @dat = () ;
  589. if(!open(DAT,"$fName"))
  590. {
  591. return 0;
  592. }
  593. @dat = <DAT> ;
  594. close(DAT) ;
  595.  
  596. my $resMax = @dat ;
  597. return $resMax ;
  598. }
  599. #################################################################################
  600. # HowManyDan #
  601. #################################################################################
  602. sub HowManyDan()
  603. {
  604. my ($honb) = @_;
  605.  
  606. if(!$honb) {return 0;}
  607. my @n1 = $honb =~ /<br>/gi ; # 数えられる(文字列の個数もOK)
  608. my $ko = scalar(@n1) ; #個数
  609.  
  610. return $ko ;
  611. }
  612. #################################################################################
  613. # HowMany #
  614. #################################################################################
  615. sub HowMany()
  616. {
  617. my ($word,$honb) = @_;
  618.  
  619. if(!$honb) {return 0;}
  620. my @n1 = $honb =~ /${word}/gi ; # 数えられる(文字列の個数もOK)
  621. my $ko = scalar(@n1) ; #個数
  622.  
  623. return $ko ;
  624. }
  625. #################################################################################
  626. # onaji #
  627. #################################################################################
  628. sub onaji()
  629. {
  630. my ($n0,$n1) = @_;
  631.  
  632. if($n0 < $n1)
  633. {
  634. my $nx = $n0 ;
  635. $n0 = $n1 ;
  636. $n1 = $nx ;
  637. }
  638.  
  639. if($n0 < 20) {return 0;}
  640.  
  641. my $sa = int($n0 * 0.2) ;
  642. if($n0 - $n1 < $sa) {return 1;}
  643.  
  644. return 0 ;
  645. }
  646. #################################################################################
  647. # isUmetate #
  648. #################################################################################
  649. sub isUmetate()
  650. {
  651. my ($resNo,$line,$orgKey,@hash) = @_;
  652. #&debLog("isUmetate()") ;
  653. #&debLog("isUmetate($resNo,$orgKey) Hash=$#hash") ;
  654.  
  655. if($resNo < 20) {return 0;}
  656. if(!$line) {return 0;}
  657.  
  658. my ($name,$mail,$hizke,$honb,$sub) = split(/<>/,$line) ;
  659. my $mailLen = length($mail) ;
  660. if($mailLen > 12) {return 1;}
  661.  
  662. my @gyo = split(/<br>/, $honb) ;
  663. my $gyoN = $#gyo ;
  664. if($gyoN > 13) {return 1;}
  665. if($gyoN > 5)
  666. {
  667. #&debLog("gyoN=$gyoN");
  668. my @ll = () ;
  669. my $ii= 0 ;
  670. foreach my $gg (@gyo)
  671. {
  672. my $lll = length($gg) ;
  673.  
  674. if($lll < 20) {next;}
  675. if($ii > 1 && !($ll[$ii-1] -30 < $lll && $lll < $ll[$ii-1] +30)) {next;}
  676. $ll[$ii] = length($gg) ;
  677. #&debLog(" -- $orgKey $resNo -- gyoN=$gyoN [$ii]=$ll[$ii]");
  678. $ii++;
  679. }
  680. ##if($#ll > 4 && $ll[1] eq $ll[3] && $ll[1] eq $ll[4]) {return 1;}
  681. if($#ll > 4 && &onaji($ll[1],$ll[3]) && &onaji($ll[1],$ll[4]) ) {return 1;}
  682. #return 0;
  683. }
  684.  
  685. my $abc = $honb ;
  686. $abc =~ s/<br>//gi ;
  687. $abc =~ s/[\. 0-9a-zA-Z\/\:　]//gi ;
  688. my $abcLen = length($abc) ;
  689. if($abcLen < 10) {&debLog("abcLen=$abcLen [$abc][$mail]");}
  690. if($abcLen < 10) {return 1;}
  691.  
  692. if($honb =~ /Rock/i) {return 1;}
  693.  
  694. my $len = length($honb);
  695. if($len > 1500) {return 1;}
  696. #if($len > 1000) {&debLog("len=$len");}
  697.  
  698. #my $dan = &HowManyDan($honb);
  699. #if($dan > 13) {return 1;}
  700.  
  701. my $href = &HowMany("href",$honb);
  702. #if($href > 5) &debLog("HowMany(href) = $href") ;
  703. if($href > 5) {return 1;}
  704.  
  705. my $ttp = &HowMany("ttp",$honb);
  706. #if($ttp > 9) &debLog("HowMany(ttp) = $ttp") ;
  707. if($ttp > 9) {return 1;}
  708.  
  709. #&debLog("Hash=$#hash") ;
  710. if($resNo < 2) {return 1;}
  711. my $resIdx = $resNo-1;
  712. my $ImaStr = $hash[$resIdx] ;
  713. my $ImaLen = length($ImaStr) ;
  714. for(my $iii=0;$iii<$resNo-1;$iii++)
  715. {
  716.  
  717. my $MaeStr = $hash[$iii] ;
  718. my $MaeLen = length($MaeStr) ;
  719. #&debLog("Hash[$iii] L=$hashL") ;
  720. #&debLog("000($resIdx,$iii) Hash=$#hash len $MaeLen -> $ImaLen \n Mae=[$MaeStr] \n Ima=[$ImaStr]") ;
  721. if(&samePost($MaeStr,$MaeLen,$ImaStr,$ImaLen))
  722. {
  723. &debLog("($resIdx,$iii) Hash=$#hash len $MaeLen -> $ImaLen \n Mae=[$MaeStr] \n Ima=[$ImaStr]") ;
  724. return 1 ;
  725. } }
  726. return 0;
  727.  
  728. my $IMAstr = $honb ;
  729. #$IMAstr =~ s/[0-9a-zA-Z]+//g ;
  730. $IMAstr =~ s/\d+//g ;
  731. #$IMAstr =~ s/(ー|？|！|。|、)//g ;
  732. $IMAstr =~ s/\x83[\x40-\x96]//g ; # カタカナ
  733. #$IMAstr =~ s/\x82[\x9f-\xf1]//g ; # ひらがな
  734. #$IMAstr =~ s/(ア|イ|ウ|エ|オ)//g ;
  735. $IMAstr =~ s/<\/?.*>//g ;
  736. $IMAstr =~ s/\n//g ;
  737. $IMAstr =~ s/ //g ;
  738. $IMAstr =~ s/　//g ;
  739. $IMAstr =~ s/<br>//g ;
  740.  
  741. my $IMAlen = length($IMAstr) ;
  742.  
  743. if(&samePost($MAEstr,$MAElen,$IMAstr,$IMAlen))
  744. {
  745. &debLog("($resNo) len $MAElen -> $IMAlen \n $MAEstr \n $IMAstr") ;
  746. $MAEstr = $IMAstr ;
  747. $MAElen = $IMAlen ;
  748. return 1 ;
  749. }
  750.  
  751. $MAEstr = $IMAstr ;
  752. $MAElen = $IMAlen ;
  753.  
  754. return 0;
  755. }
  756. #################################################################################
  757. # makeHash #
  758. #################################################################################
  759. sub makeHash()
  760. {
  761. my ($resNo,$line,$orgKey) = @_;
  762. #&debLog("makeHash($resNo,$orgKey)") ;
  763.  
  764. #if($resNo < 20) {return "";}
  765. if(!$line) {return "";}
  766.  
  767. my ($name,$mail,$hizke,$honb,$sub) = split(/<>/,$line) ;
  768.  
  769. my $IMAstr = $honb ;
  770. #$IMAstr =~ s/[0-9a-zA-Z]+//g ;
  771. $IMAstr =~ s/\d+//g ;
  772. #$IMAstr =~ s/(ー|？|！|。|、)//g ;
  773. $IMAstr =~ s/\x83[\x40-\x96]//g ; # カタカナ
  774. #$IMAstr =~ s/\x82[\x9f-\xf1]//g ; # ひらがな
  775. #$IMAstr =~ s/(ア|イ|ウ|エ|オ)//g ;
  776. $IMAstr =~ s/<\/?.*>//g ;
  777. $IMAstr =~ s/\n//g ;
  778. $IMAstr =~ s/ //g ;
  779. $IMAstr =~ s/　//g ;
  780. $IMAstr =~ s/<br>//g ;
  781.  
  782. return "$IMAstr";
  783. }
  784. #################################################################################
  785. # debLog #
  786. #################################################################################
  787. sub samePost()
  788. {
  789. my ($maeStr,$maeLen,$imaStr,$imaLen) = @_;
  790.  
  791. if($maeStr eq $imaStr) {return 1;}
  792.  
  793. #if($imaLen < $maeLen - 2) {return 0;}
  794. #if($imaLen > $maeLen + 2) {return 0;}
  795.  
  796. return 0;
  797. }
  798. #################################################################################
  799. # debLog #
  800. #################################################################################
  801. sub debLog()
  802. {
  803. my ($mes) = @_;
  804.  
  805. my $now = time ;
  806. my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($now);
  807. $year += 1900 ;
  808. $mon ++ ;
  809. if($mon < 10) {$mon = "0$mon" ;}
  810. if($mday < 10) {$mday = "0$mday";}
  811. if($hour < 10) {$hour = "0$hour";}
  812. if($min < 10) {$min = "0$min" ;}
  813. if($sec < 10) {$sec = "0$sec" ;}
  814.  
  815. #print "$year/$mon/$mday $hour:$min:$sec $mes\n";
  816.  
  817. if(!$debdeb) {return 0;}
  818. if(!open(LOG,">> $debFile")) {return 0;}
  819.  
  820. print "$hour:$min:$sec $mes\n";
  821. #print LOG "$year/$mon/$mday $hour:$min:$sec $mes\n";
  822. print LOG "$min:$sec $mes\n";
  823.  
  824. close(LOG) ;
  825. return 0;
  826. }
  827. #################################################################################
  828. # Report #
  829. #################################################################################
  830. sub Report()
  831. {
  832. my ($mes) = @_;
  833.  
  834. my $now = time ;
  835. my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($now);
  836. $year += 1900 ;
  837. $mon ++ ;
  838. if($mon < 10) {$mon = "0$mon" ;}
  839. if($mday < 10) {$mday = "0$mday";}
  840. if($hour < 10) {$hour = "0$hour";}
  841. if($min < 10) {$min = "0$min" ;}
  842. if($sec < 10) {$sec = "0$sec" ;}
  843.  
  844. #print "$year/$mon/$mday $hour:$min:$sec $mes\n";
  845.  
  846. if(!open(LOG,">> $repFile")) {return 0;}
  847.  
  848. print LOG "$mon/$mday $hour:$min $mes\n";
  849.  
  850. close(LOG) ;
  851. return 0;
  852. }
  853. ##################################################
  854. sub _cp
  855. {
  856. local $/;
  857. open(local *SRC, $_[0]) or return;
  858. open(local *DST, '>', $_[1]) or close(SRC), return;
  859. my $st = stat(*SRC);
  860. print DST <SRC>;
  861. close(DST);
  862. close(SRC);
  863. chmod($st->mode, $_[1]);
  864. utime($st->atime, $st->mtime, $_[1]);
  865. 1;
  866. }
  867. sub _mv
  868. {
  869. rename($_[0], $_[1]) and return 1;
  870. $! == EXDEV or return;
  871. _cp($_[0], $_[1]) and unlink($_[0]);
  872. }
  873. sub _rm_rf
  874. {
  875. opendir(local *D, $_[0]) or return;
  876. while (defined (my $e = readdir(D))) {
  877. if ($e eq '.' || $e eq '..') {
  878. }
  879. elsif (-d "$_[0]/$e") {
  880. _rm_rf("$_[0]/$e");
  881. }
  882. else {
  883. unlink("$_[0]/$e");
  884. }
  885. }
  886. closedir(D);
  887. rmdir($_[0]);
  888. }
  889.  
  890. exit;
  891. #################################################################################
  892. # end of hs file #
  893. #################################################################################
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!