- 追加された行はこの色です。
- 削除された行はこの色です。
スレ産の成果物を転がしておく場所です。
#contents
スレ産の成果物を転がしておく場所です。
#br
* 保守スクリプト [#gdf4fd23]
たぶんPerl5.8+必須。ソースはUTF-8で保存すること。ライセンスはパブリックドメイン相当でおk
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use LWP;
use LWP::Debug qw(+);
use HTTP::Date;
use HTTP::Status;
use Encode;
our $VERSION = '0.01';
my $ua = LWP::UserAgent->new(
agent => "Monazilla/1.00 hoshu-bot.pl/$VERSION",
cookie_jar => {},
);
sub sjis { encode('cp932', $_[0]) }
sub write_something {
my ($host, $board_key, $thread_key) = @_;
my $name = '';
my $mail = '';
my $message = 'ほしゅ';
REQ:
my $res = $ua->post("http://$host/test/bbs.cgi",
[ bbs => $board_key, key => $thread_key,
FROM => sjis($name), mail => sjis($mail), MESSAGE => sjis($message),
submit => sjis('書き込む'), time => 1, hana => 'mogera' ],
Referer => "http://$host/$board_key/");
for (decode('cp932', $res->content)) {
if (/書きこみました/ || /2ch_X:true/) { print {*STDERR} "OK! :-)\n"; }
elsif (/2ch_X:false/) { print {*STDERR} "maybe OK?\n"; }
elsif (/書き込み確認/ || /2ch_X:cookie/) {
print {*STDERR} "Cookie needed; retry\n"; goto REQ;
} else {
print {*STDERR} "ERROR!\n"; exit 1;
}
}
}
if ($0 eq __FILE__) {
my $thread_url = $ARGV[0];
my ($host, $board_key, $thread_key) =
$thread_url =~ m{http://([\w.]+)/test/read\.cgi/(\w+)/(\d+)/};
die "Usage: $0 <thread_url>"
unless 3 == grep {defined} ($host, $board_key, $thread_key);
my $interval = 60 * 15;
my $last_modified = 0;
while (1) {
my $res = $ua->head(
"http://${host}/${board_key}/dat/${thread_key}.dat",
'If-Modified-Since' => time2str($last_modified));
if ($res->code == RC_NOT_MODIFIED) {
write_something($host, $board_key, $thread_key);
redo;
}
elsif ($res->code == RC_OK) {
$last_modified = str2time($res->header('Last-Modified'));
my $now = str2time($res->header('Date'));
my $wait = $last_modified + $interval - $now;
sleep($wait > 0 ? $wait : 1);
}
else {
die 'error!';
}
}
}