#!/usr/bin/perl ########################################################## # JBBS ログコンバートスクリプト Ver 2.00 (JBBS to 12chBBS) # みちのく掲示板 http://mitinoku.jp/ # タカヒロ@みちのく掲示板 12ch@miyagino.com # # Ver.2.0 2010/02/20 # #【概要】 # JBBSのログを12chBBS形式にオンライン上で変換するスクリプトです。 # JBBS・JBBS@したらば両方に対応しています。 # #【使用法】 # 1) ./admin/にいれます。 # 2) URLをいれます。 # 3) 移転先板IDを選びます。 # 4) 取得します。 # 5) リメイクして完了 # 6) 複数あるときは(2)に戻る # 7) 【これ重要】終わったらこのスクリプトをサーバー上から抹消します。 # # ※) レス数がズレるバグがありますので、管理画面でもう一度リメイクしてください # #【注意事項】 # このスクリプトは、既に運営している12chBBS掲示板に使用した場合、99%くらいの確立で既存のデータを上書きします。(泣) # 必ず新しく作成した板でご利用ください。 # 終わったらこのスクリプトはサーバー上から速やかに削除しましょう。 # そうしないと、やられます。 # このスクリプトは相手先にそれなりの負荷をかけてしまいます。 # JBBS側に予め問い合わせるのが吉かと思います。 # JBBSの生ログを取得するわけではありませんのでバックアップには使用出来ないと思います。 # #【使用条件】 # 動作確認等はしていますが、知りえないバグ・ミス等あるかもしれません。 # お気軽に掲示板か、メールでお知らせ頂ければ嬉しいです。 # このスクリプトを使用して起きた如何なる損害に対してもタカヒロは一切責任は持ちませんので、自己責任でお願いします。 # 著作権は放棄出来そうにないですが、商用利用・再配布・改造・その他何でもOKです。 # その際、一言連絡を頂ければ嬉しいです。 # # # DATの取得方法は次の通りです。 #http://jbbs.livedoor.jp/bbs/rawmode.cgi/[カテゴリ]/[掲示板番号]/[スレッド番号]/ #・DATファイルの内容は次の通りです。 #[レス番号]<>[名前]<>[メール]<>[日付]<>[本文]<>[スレッドタイトル]<>[ID] # # # 以上 #=============================================================== use strict; use Time::Local; use FindBin qw($Script); $| = 1; my $basepath = '..'; require $basepath.'/jcode.pl'; undef my ($buffer); undef my (%form); if ("\U$ENV{'REQUEST_METHOD'}\E" ne "POST") { $buffer = $ENV{'QUERY_STRING'}; } else { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } foreach (split /&/, $buffer) { my ($name, $value) = split /=/; $value =~ tr/+/ /; $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg; $form{$name} = $value; } my $url = $form{url} eq '' ? 'http://' : $form{url}; print <<"HTML"; Content-type: text/html JBBSコンバータ

JBBSコンバータ

コンバートしたいJBBSのURLを入れてください。
HTML if ($form{act} eq 'get' and $form{url} ne ''){ print "

\n"; chomp $url; # my $mode = $url =~ /jbbs\.shitaraba\.com/ ? 1 : undef; my $mode = $url =~ /jbbs\.livedoor\.jp/ ? 1 : undef; $url =~ s/http:\/\///; $url =~ s/(.[^\/]*)$//g; $url =~ s/\/$//g; $url =~ /(\w[^\/]*)\/(\w[^\/]*)$/; #旧形式 #http://jbbs.shitaraba.com/***/bbs/read.cgi?BBS=**&KEY=*** #新したらばURL #http://jbbs.livedoor.com/bbs/read.cgi/****/**/***/ # my $offlaw = $mode ? "jbbs.shitaraba.com/bbs/read.cgi?BBS=$2&KEY=" : "www.jbbs.net/$1/bbs/offlaw.cgi?BBS=$2&KEY="; my $offlaw = "jbbs.livedoor.jp/bbs/rawmode.cgi/$1/$2/"; print "【"; print $mode ? "JBBS@したらば" : "JBBS"; print "】モードで処理します
データを取得していますので暫くお待ちください・・・・

\n"; $url .= '/subject.txt'; my @tmpsubj = ConnectHost($url); pop @tmpsubj; my $sub = join "\n", @tmpsubj; if ($sub eq '' or $sub =~ /302 Found<\/TITLE>/i) { print "<hr>subject.txtが取得出来ませんでした。 ・・・ URLが間違ってないですか?<br>\n<a href=\"$Script?url=$form{url}\">戻る</a>\n</body>\n</html>"; exit; } else { print "■ subject.txtの取得に成功しました。<br>■ スレッドの取得処理を始めます。<br><br>\n"; } unless ($mode) { jcode::sjis2euc(\$sub); } $sub =~ s/\r//g; undef my (@index); undef my (%thread); foreach my $line (split /\n/, $sub) { chomp $line; if ($line =~ /^\D/ or $line eq '') { next; }; $line =~ s/(\d[^\D]*)\.cgi,(.*)\((\d*)\)$//; push @index, "$1\f$2\f$3\f\n"; $thread{$1} = "$offlaw$1"; } open (IN, "> $basepath/$form{id}/index"); print IN @index; close IN; foreach (@index) { chomp; if ($_ eq '') { next; } my ($id,$title,$num) = split /\f/; print "「$title」を取得中です ・・・ "; my $val = join '', ConnectHost($thread{$id}); print $val eq '' ? "<font color=\"ff0000\">[失敗]</font><br>\n" : "<font color=\"#0000ff\">$thread{$id} [成功]</font><br>\n"; $val =~ s/\r//g; unless ($mode) { jcode::sjis2euc(\$val); } undef my (@thread); my $cnt_no = 0; foreach my $line (split /\n/, $val) { chomp $line; # $cnt_no++; # if ($mode) { # if ($line !~ /^<dt>\d[^\D]*\s(.*)<dd>(.*)<br><br>$/i) { next; } # my $res = "$1\f$2"; # my $mail = $res =~ /<a href="mailto:(.[^"]*)">/i ? $1 : undef; # $res =~ s/<br>/\0/g; # $res = DeleteTag($res); # my ($data,$comment) = split /\f/, $res; # my @tmp = split /\s/, $data; # my $key = MakeKey("$tmp[4] $tmp[5]"); # push @thread, "$key\f<b>$tmp[1]</b>\f$mail\f$comment\f\n"; # } # else { # my ($name,$mail,$date,$comment,$sub,$ip) = split /,/, $line; my ($no,$name,$mail,$date,$comment,$sub,$ip) = split /<>/, $line; $comment =~ s/@`/,/g; $comment =~ s/<br>/\0/g; my $result = DeleteTag($comment); my $key = MakeKey($date); # if(($key eq 0) && ($no < 2) ){ next; } if(($key eq 0) && ($cnt_no eq 0) ){ next; } $cnt_no++; if($cnt_no ne $no){ #ダミーdata my $i; for($i = $cnt_no ;$i < $no ;$i++,$cnt_no++){ push @thread, "---\f<b>---</b>\f---\f---\f\n"; } # $cnt_no++; # $cnt_no == $no; } push @thread, "$key\f<b>$name</b>\f$mail\f$result\f\n"; # } } open (IN, "> $basepath/$form{id}/msg/$id"); print IN @thread; close IN; } print "<br>移転が完了しましたので<a href=\"$basepath/bbs.cgi?bbs=$form{id}&mail=remake&edit=remake\" target=\"_blank\">リメイクしてみて下さい。</a><br>\n"; print "<a href=\"$Script?url=$form{url}\">別の板をやるときはここから戻ります。</a>\n"; } else { undef my ($cb); open (IN, "../headline"); while (<IN>) { chomp; $cb .= "<option value=\"".(split /\f/)[1]."\">".(split /\f/)[2]; } close IN; print <<"HTML"; <input type="text" name="url" size="80" maxlength="80" value="$url"><br> 12chBBS側移転先板ID : <select name="id">$cb</select> <input type="submit" value=" 移 転 処 理 開 始 "> <input type="hidden" name="act" value="get"><br><br> <b>【注意事項】</b><br> サーバーによってはタイムアウトしてしまうかも知れません。<br> その場合はスクリプトを改造してfork等を使いバックグランドで動作させる事をお奨めします。 HTML } print "</form>\n</body>\n</html>\n"; exit; sub MakeKey { $_[0] =~ /(\d[^\D]*)\/(\d[^\D]*)\/(\d[^\D]*)\((.[^\)]*)\)\s(\d[^\D]*):(\d[^\D]*)/; my $y = $1 - 1900; my $m = sprintf("%d", $2 - 1); my $d = sprintf("%d", $3); my $hh = sprintf("%d", $4); my $mm = sprintf("%d", $5); if ($y eq '' or $y == -1900) { return 0; } return timelocal(0, $mm, $hh, $d, $m, $y); } sub DeleteTag { my $comment = $_[0]; my $tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}} my $c_tag_regex = '<!(?:--[^-]*(?:(?!--)-[^-]*)*--(?:(?!--)[^>])*)*(?:>|$(?!\n)|--.*$)'; my $tag_regex = qq{$c_tag_regex|<$tag_regex_}; my $text_regex = q{[^<]*}; undef my ($result); while ($comment =~ /($text_regex)($tag_regex)?/gso) { if ($1 eq '' and $2 eq '') { last; } $result .= $1; my $tag_tmp = $2; if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) { undef my ($text_tmp); $comment =~ /(.*?)(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$)/gsi; ($text_tmp = $1) =~ s/</</g; $text_tmp =~ s/>/>/g; $result .= $text_tmp; } } return $result; } sub ConnectHost { my $host = $_[0]; undef my ($path); undef my (@getdata); $host =~ s/http:\/\///; $path = $host; $host = (split /\//, $host)[0]; $path =~ s/$host//i; my $name = pack("S n a4 x8", 2, 80, (gethostbyname($host))[4]); socket(S, 2, 1, 0); connect(S, $name); binmode(S); select(S); $| = 1; select(STDOUT); print S "GET $path HTTP/1.0\r\nHost: $host\r\n\r\n"; while(<S>){ if (/Content/) { last; } } while(<S>){ @getdata = <S>; } close(S); return @getdata; }