--- /dev/null
+Copyright (c) 2006 - 2013, <OWNER>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+- Neither the name of the <ORGANIZATION> nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
--- /dev/null
+Yet Another dchat
+======
+
+Chatroom script with dice that can hold many rooms.
+Its UI is based on mihana's dchat.
+
--- /dev/null
+function autoclear() {
+ if (self.document.send) {
+ if (self.document.cmode && self.document.cmode.autoclear) {
+ if (self.document.cmode.autoclear.checked) {
+ if (self.document.send.msg) {
+ self.document.send.msg.value = "";
+ self.document.send.msg.focus();
+ }
+ }
+ }
+ }
+}
\ No newline at end of file
--- /dev/null
+##### TADChat\94ÅCGI\8aÖ\98A\8f\88\97\9d\83\89\83C\83u\83\89\83\8a
+### CGI Lib / 2007 © \8c\8b\8fé\97R\97\85\81\97\90¢\8aE\94E\8eÒ\8d\91 / BSD Lisence
+### $Id: cgilib.pl,v 1.2 2007/05/06 03:27:40 jyugoya Exp $
+### CGI.pm \82É\88Ú\8ds\92\86
+
+###
+# \83N\83b\83L\81[\8eæ\93¾
+sub getCookie {
+ local($cookiekey) = $_[0];
+ local(@cook) = split(/;/, $ENV{'HTTP_COOKIE'});
+ foreach (@cook) {
+ local($key, $val) = split(/=/);
+ $key =~ s/\s//g;
+ if ($key eq $cookiekey) {
+ local(%ck) = split(/<>/, $val);
+ return %ck;
+ }
+ }
+}
+
+###
+# \83N\83b\83L\81[\90Ý\92è
+sub setCookie {
+ local($cookiekey, $ck, $expday) = @_;
+
+ local (@t) = gmtime(time + $expday*24*60*60);
+ local ($expt) = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
+ (qw(Sun Mon Tue Wed Thu Fri Sat))[$t[6]],
+ $t[3],
+ (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$t[4]],
+ $t[5]+1900, $t[2], $t[1], $t[0]);
+
+ print "Set-Cookie: $cookiekey=$ck; expires=$expt\n";
+}
+
+###
+# URL\83G\83\93\83R\81[\83h
+sub url_enc {
+ local($_) = @_;
+
+ s/(\W)/'%' . unpack('H2', $1)/eg;
+ s/\s/+/g;
+ $_;
+}
+
+# end of cgilib
+1;
--- /dev/null
+##### \90Ý\92è\83t\83@\83C\83\8b #####
+
+# \95¶\8e\9a\89»\82¯\82·\82é\82±\82Æ\82ª\81c
+# \83f\83o\83b\83O\83\82\81[\83h\81F ON=1, OFF=0
+$DEBUG=1;
+
+##################################
+##### \90Ý\92è\92è\90\94\81F\83\86\81[\83U\90Ý\92è\95\94 #####
+
+###
+### \95K\90{\90Ý\92è\8d\80\96Ú
+###
+
+# \8cÂ\95Ê\83`\83\83\83b\83g\8dÅ\91å\8bL\8e\96\90\94
+$CONF{'max'} = 3000;
+
+# \8cy\97Ê\83\82\81[\83h\82Å\82Ì\95\\8e¦\8ds\90\94
+$CONF{'lightline'} = 20;
+
+# \8cÂ\95Ê\83`\83\83\83b\83g\83\81\83\93\83o\81[\8f\9c\8b\8e\97p\8aú\8cÀ (\95b\90\94)
+$CONF{'memexp'} = 60;
+
+# \8aÇ\97\9d\97p\83p\83X\83\8f\81[\83h (\97v\95Ï\8dX)
+$CONF{'pass'} = 'pass';
+
+# \83`\83\83\83b\83g\83^\83C\83g\83\8b\96¼
+$CONF{'title'} = 'Yet Another Dice Chat';
+
+# \83C\83\93\83f\83b\83N\83X\95\94\82©\82ç\82Ì\96ß\82è\90æ
+$CONF{'home'} = '../';
+
+# \8cÂ\95Ê\83`\83\83\83b\83g\82Ì\96ß\82è\90æURL(index.html\82È\82Ç)
+$CONF{'indexurl'} = './index.cgi';
+
+# \95\94\89®\82Ì\90à\96¾\95¶
+$CONF{'topdesc'} = "\95\94\89®\82Ì\90à\96¾\95¶";
+
+# \83\8d\83O\89{\97\97 (\82È\82µ\81F0\81A\95¶\8e\9a\97ñ\81F1\81A\83v\83\8b\83_\83E\83\93\81F2)
+$CONF{'loglink'} = 1;
+
+# \83`\83\83\83b\83g\83\8b\81[\83\80\82Ì\8cx\8d\90\95¶
+$CONF{'chatalart'} = "\83\8d\83O\82Í\95Û\91¶\82³\82ê\82Ü\82·\81B\90Ø\8fo\82µ\82Ì\95K\97v\82ª\82 \82é\8fê\8d\87\82Í\8aÇ\97\9d\90l\8eº(DC)\82Ö\81B";
+
+###
+### \83_\83C\83X\83\82\81[\83h: ON: 1, OFF: 0
+###
+$CONF{'dicemode'} = 1;
+
+###
+### \83X\83^\83C\83\8b\83t\83@\83C\83\8b\90Ý\92è(\8c©\82½\96Ú\82Ì\83R\83\93\83g\83\8d\81[\83\8b\82Í\82±\82ê\82ç\82Ì\83t\83@\83C\83\8b\82Å)
+###
+# \83C\83\93\83f\83b\83N\83X\95\94\83X\83^\83C\83\8b\83t\83@\83C\83\8b
+$CONF{'indexstyle'} = './yadchat.css';
+
+# \8cÂ\95Ê\83`\83\83\83b\83g\83X\83^\83C\83\8b\83t\83@\83C\83\8b
+$CONF{'chatstyle'} = "./kenranstyle.css";
+
+###
+### \83t\83H\81[\83\80\82Ì\91I\91ð\8d\80\96Ú
+###
+
+# \83\8a\83\8d\81[\83h\8e\9e\8aÔ\82Ì\91I\91ð\95b\90\94
+@reload = (0,10,30,40,50,60);
+
+# \83\8a\83\8d\81[\83h\8e\9e\8aÔ\82Ì\8f\89\8aú\92l
+$CONF{'retime'} = $reload[2];
+
+# \95\\8e¦\8ds\90\94
+@line = (20,50,100,500,1000,2000);
+
+# \95\\8e¦\8ds\90\94\82Ì\8f\89\8aú\92l
+$CONF{'line'} = $line[2];
+
+# \95¶\8e\9a\90F\82ð\8ew\92è\81i\95K\82¸\8bô\90\94\82Å\81B\8fã\89º\82Ì\94z\97ñ\82Í\83y\83A\82Å)
+@COLORS = ('39037c','3366FF','00859b','008c4b','ad1e25','cc001b','e60099','63355e',
+'ffc34c','ff8119','ddded3','FFFFFF','3100b2','89bdde','94b61f','22c350',
+'ef7585','ff0037','d993ac','8e00cc','eed96d','9e4f2d','666666','191919');
+@IROIRO = ('\8d®\97\95','\90Â','\90ó\89©','\90X\97Î','\91h\96F','\8aØ\8dg','\89²\92O','\96Å\8e\87',
+'\96¨\8a¹','\8a¹\8eq','\8fÛ\89å','\8f\83\94\92','\97Ú\97\9e','\8bó','\96G\94K','\8fí\94Õ',
+'\93\8d','åKåN','\95\8f\8eq','\8fÒ\8a\97','\90\97','\8cI\94~','\93Ý\90F','\8e½\8d\95');
+
+# \95¶\8e\9a\90F\82Ì\8f\89\8aú\92l
+$CONF{'color'} = $COLORS[0];
+
+# \8aç\95¶\8e\9a
+@faces = ('(\81EL\81E)', '(\81O_\81O)', '(*\81O\81O*)', '(\81G_\81G)', '(\81[L\81[\81G', ' \82\8d\81i_ _\81j\82\8d',
+ '(\81E_\81E)', '(\81O\81O\81j/~~', '(\81\97_\81\97)', '\81_\81i\81O\82n\81O\81j\81^', '\81iß\81|ß\81j\81U');
+
+# \83^\83C\83g\83\8b\82Ì\91å\82«\82³
+$t_size = '18px';
+
+
+###
+### \83\8d\83O\95\\8e¦\95\94\95ª\90Ý\92è
+###
+
+### \93ü\91Þ\8eº\8aÖ\8cW
+# \93ü\91Þ\8eº\88Ä\93à\8eÒ\96¼
+$CONF{'navi'} = "MAKI";
+
+# \93ü\91Þ\8eº\83\81\83b\83Z\81[\83W
+$CONF{'in_msg'} = "\82³\82ñ\81A\96é\96¾\82¯\82Ì\91D\82Ö\82æ\82¤\82±\82»\81I"; # \93ü\8eº\8e\9e
+$CONF{'out_msg'} = "\82³\82ñ\81A\82¨\94æ\82ê\97l\82Å\82µ\82½\81B"; # \91Þ\8eº\8e\9e
+
+# \93ü\91Þ\8eº\83\81\83b\83Z\81[\83W\82Ì\90F 5673FF 3366FF
+$CONF{'navicolor'} = "DB5673";
+
+# \83|\83C\83\93\83^\82Ì\8c`\8fó\81i\83\8d\83O\95\\8e¦\95\94\82Å\81u\96¼\91O\81v\82Ì\91O\82É\82Â\82\81j
+$CONF{'pointer'} = "*";
+
+###
+### \83I\83v\83V\83\87\83\93\8b@\94\\91I\91ð
+###
+
+# \8eÀ\8ds\83t\83@\83C\83\8b\81i\82±\82Ì\83X\83N\83\8a\83v\83g\81j
+$CONF{'indexcgi'} = 'index.cgi';
+
+# \83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b
+$CONF{'indexdat'} = 'index.dat';
+
+# \83`\83\83\83b\83g\8eÀ\8ds\83t\83@\83C\83\8b
+$CONF{'chatcgi'} = 'kenranchat.cgi';
+
+### \83g\83\8a\83b\83v\8aÖ\8cW
+# \83g\83\8a\83b\83v\8eg\97p (1 = \8eg\97p\82·\82é, 0 = \8eg\97p\82µ\82È\82¢)
+$CONF{'usetrip'} = 1;
+
+### IP\83A\83h\83\8c\83X\95\\8e¦
+# \93ü\8eº\8e\9e\82ÉIP\83A\83h\83\8c\83X\82ð\95\\8e¦ (0=no 1=yes)
+$CONF{'showip'} = 0;
+
+### \94\8c¾\8f\9c\8b\8e\8b@\94\
+# \94\8c¾\8f\9c\8b\8e\8b@\94\ 0=\8eg\82í\82È\82¢ 1=\8eg\82¤
+$CONF{'clearlog'} = 0;
+
+# \8f\9c\8b\8e\83R\83}\83\93\83h (\94\8c¾\82Æ\82µ\82Ä\93ü\97Í)
+$CONF{'clearcom'} = 'clear';
+
+### RP\82Ì\83\8d\83O\8b@\94\
+# 0=\83\8d\83O\8eæ\82ç\82È\82¢ 1=\83\8d\83O\82ð\8eæ\82é
+$CONF{'rplog'} = 1;
+
+#\81@\95Û\91¶\82·\82é\83f\83B\83\8c\83N\83g\83\8a
+$CONF{'rpdir'} = './rp';
+
+### \83t\83@\83C\83\8b\83\8d\83b\83N\8aÖ\8cW
+# \83t\83@\83C\83\8b\83\8d\83b\83N\8c`\8e®
+# 0=\83\8d\83b\83N\82µ\82È\82¢(\8aë\8c¯) 1=symlink\8aÖ\90\94(UNIX) 2=mkdir\8aÖ\90\94(Win)
+$CONF{'lockmode'} = 1;
+
+# \83\8d\83O\83t\83@\83C\83\8b\82Ì\95Û\8e\9d\83f\83B\83\8c\83N\83g\83\8a
+$CONF{'lockdir'} = './lock';
+
+# \83\8d\83b\83N\8eæ\93¾\83\8a\83g\83\89\83C\89ñ\90\94
+$CONF{'retry'} = 5;
+
+# \83\8d\83b\83N\83t\83@\83C\83\8b\82Ì\83^\83C\83\80\83A\83E\83g (\95b\90\94)
+$CONF{'timeout'} = 60;
+
+# \8eQ\89Á\8eÒ\83t\83@\83C\83\8b\95Û\8e\9d\83f\83B\83\8c\83N\83g\83\8a
+$CONF{'memdir'} = './member';
+
+# \83f\81[\83^\83t\83@\83C\83\8b\95Û\8e\9d\83f\83B\83\8c\83N\83g\83\8a
+$CONF{'datdir'} = './dat';
+
+# \83\8d\83O\83t\83@\83C\83\8b\95Û\8e\9d\83f\83B\83\8c\83N\83g\83\8a
+$CONF{'logdir'} = './log';
+
+###
+### GZIP\88³\8fk\91Î\89\9e
+###
+# gzip\82Ì\83p\83X (\82±\82Ì\95Ï\90\94\82ª\8bó('')\82Ì\8fê\8d\87\81A\88³\8fk\93®\8dì\82µ\82È\82¢)
+$gzip = '/usr/bin/gzip';
+
+###
+### \89{\97\97\8b\91\94Û\8aÖ\8cW\90Ý\92è\8d\80\96Ú
+###
+# \89{\97\97\8b\91\94ÛIP\83A\83h\83\8c\83X\95Û\8e\9d\83t\83@\83C\83\8b
+$CONF{'denyfile'} = './deny.dat';
+
+# \89{\97\97\8b\91\94Û\83\81\83b\83Z\81[\83W
+$CONF{'denymsg'} = '\90\\82µ\96ó\82 \82è\82Ü\82¹\82ñ\82ª\81A\82 \82È\82½\82Ì\83A\83h\83\8c\83X\82É\82Í\89{\97\97\8b\96\89Â\82ª\82 \82è\82Ü\82¹\82ñ\81B\8aÇ\97\9d\8eÒ\82É\82¨\96â\8d\87\82¹\82\82¾\82³\82¢\81B';
+
+###
+### \8aî\96{\8cÅ\92è\8d\80\96Ú (\88È\89º\82Ì\8d\80\96Ú\82Í\8aî\96{\93I\82É\90G\82ç\82È\82¢)
+###
+# CGI\93ü\97Ímethod\82Ì\8c`\8e® (POST/GET)
+$CONF{'method'} = 'POST';
+
+# \8aÇ\97\9d\83X\83N\83\8a\83v\83g\82Ì\83p\83X\82ð\8ew\92è
+$CONF{'adminscript'} = './chatmgr.cgi';
+
+# \8b@\94\\8ag\92£\97pJavaScript\83\89\83C\83u\83\89\83\8a (\83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[\82È\82Ç)
+$CONF{'javascript'} = './kenranutil.js';
+
+### \89^\97p\92n\88æ\8aÖ\8cW (\8c»\8fó\8eÀ\8e¿\93ú\96{\8cÅ\92è)
+# \83\8d\81[\83P\81[\83\8b
+$CONF{'lang'} = 'ja'; # html lang \8by\82Ñ Content-language
+
+# \83^\83C\83\80\83]\81[\83\93\90Ý\92è
+$CONF{'timezone'} = "JST-9"; # \93ú\96{
+
+# \93ú\96{\8cê\83R\81[\83h (\8c»\8fó\82Ì\83R\81[\83h\82ÍShift_JIS\82É\88Ë\91¶)
+$CONF{'charset'} = 'Shift_JIS';
+
+# Content-Type (\8eb\92è\81A\8f\9c\8b\8e\97\\92è)
+$CONF{'content-type'} = "text/html; charset=$CONF{'charset'}";
+
+### \83N\83b\83L\81[\8aÖ\8cW
+# \97L\8cø\8aú\8aÔ (\93ú\90\94)
+$CONF{'expire'} = 60;
+
+# \83N\83b\83L\81[\82Ì\83L\81[
+$CONF{'cookiekey'} = 'KENRANCHAT';
+
+### \90Ý\92è\8a®\97¹
+1;
\ No newline at end of file
--- /dev/null
+This folder contains dat file. Please don't delete this folder.
--- /dev/null
+#!/usr/bin/perl
+
+##### Yet Another Dice Chat #####
+### $Id: index.cgi,v 1.2 2007/05/06 03:27:40 jyugoya Exp $
+### YADChat / 2007 © \8c\8b\8fé\97R\97\85\81\97\90¢\8aE\94E\8eÒ\8d\91 / BSD Lisence
+### mihana\82³\82ñ\82É\98A\97\8d\82ª\82Â\82©\82È\82¢\82Ì\82Å\83R\81[\83h\82ðrewrite\92\86\81B
+
+##### \90Ý\92è\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý #####
+require 'config.cgi';
+
+##### \83\89\83C\83u\83\89\83\8a\93Ç\82Ý\8d\9e\82Ý #####
+require 'yadchatlib.pl';
+
+########################
+##### \83\81\83C\83\93\8f\88\97\9d\95\94 #####
+########################
+
+##### CGI\83p\83b\83P\81[\83W #####
+use CGI qw/:standard/;
+
+##### \83O\83\8d\81[\83o\83\8b\95Ï\90\94 #####
+# CGI \83I\83u\83W\83F\83N\83g
+$query = new CGI;
+
+# \83p\83\89\83\81\81[\83^\8eæ\93¾
+$IN{'mode'} = $query->param('mode');
+$IN{'name'} = $query->param('name');
+$IN{'comment'} = $query->param('comment');
+$IN{'del'} = $query->param('del');
+$IN{'close'} = $query->param('close');
+$IN{'pass'} = $query->param('pass');
+
+##### HTML\95¶\8f\91\95\\8e¦ #####
+# \83w\83b\83_\81[
+print $query->header(-charset => $CONF{'charset'});
+print $query->start_html(-lang => $CONF{'lang'},
+ -encoding => $CONF{'charset'},
+ -head => meta({-http_equiv => 'Content-Type',
+ -content => 'text/html'}),
+ -title=>$CONF{'title'},
+ -style=>{-src=>$CONF{'indexstyle'}});
+
+# \83K\83C\83h
+print<<EOM;
+<a href="$CONF{'home'}">
\83z
\81[
\83\80</a> | <a href="$CONF{'indexcgi'}">
\83\8b\81[
\83\80\88ê
\97\97</a>
+
+<div class="main">
+EOM
+
+# \83^\83C\83g\83\8b
+print $query->h1($CONF{'title'});
+print "\n";
+
+# \83f\83o\83b\83O
+if ($DEBUG) {
+ &printDebug();
+}
+
+# \8f\88\97\9d\95ª\8aò
+if ($IN{'name'} && $IN{'comment'} && $IN{'pass'}) {
+ if ($DEBUG) {
+ print "<p>create New Room ...\n";
+ }
+ &createNewRoom($IN{'name'}, $IN{'comment'});
+} elsif ($IN{'del'} && $IN{'pass'} eq $CONF{'pass'}) {
+ if ($DEBUG) {
+ print "<p>delete a Room ...\n";
+ }
+ &deleteRoom($IN{'del'});
+} elsif ($IN{'close'}) {
+ if ($DEBUG) {
+ print "<p>close a Room ...\n";
+ }
+ &closeRoom($IN{'pass'}, $IN{'close'});
+}
+if ($DEBUG) {
+ print "done</p>\n";
+}
+
+
+# \92\8d\88Ó\8f\91\82«
+&printNotice();
+
+# \95\\8e¦\95ª\8aò
+if (!$IN{'mode'}) {
+ &printRoomList();
+} elsif ($IN{'mode'} eq "make") {
+ &printMakeRoom();
+} elsif ($IN{'mode'} eq "log") {
+ &printLogList();
+} elsif ($IN{'mode'} eq "admin"){
+ &printAdminMenu();
+}
+
+print<<EOM;
+</div>
+EOM
+
+# \83t\83b\83^\81[
+print &genCopyright();
+
+# \95\\8e¦\8fI\97¹
+print $query->end_html;
+
+### End of index.cgi
--- /dev/null
+package jcode;
+;######################################################################
+;#
+;# jcode.pl: Perl library for Japanese character code conversion
+;#
+;# Copyright (c) 1995-2000 Kazumasa Utashiro <utashiro@iij.ad.jp>
+;# Internet Initiative Japan Inc.
+;# 3-13 Kanda Nishiki-cho, Chiyoda-ku, Tokyo 101-0054, Japan
+;#
+;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
+;# Software Research Associates, Inc.
+;#
+;# Use and redistribution for ANY PURPOSE are granted as long as all
+;# copyright notices are retained. Redistribution with modification
+;# is allowed provided that you make your modified version obviously
+;# distinguishable from the original one. THIS SOFTWARE IS PROVIDED
+;# BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE
+;# DISCLAIMED.
+;#
+;# Original version was developed under the name of srekcah@sra.co.jp
+;# February 1992 and it was called kconv.pl at the beginning. This
+;# address was a pen name for group of individuals and it is no longer
+;# valid.
+;#
+;# The latest version is available here:
+;#
+;# ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/
+;#
+;; $rcsid = q$Id: jcode.pl,v 1.1.1.1 2007/05/04 19:45:31 jyugoya Exp $;
+;#
+;######################################################################
+;#
+;# PERL4 INTERFACE:
+;#
+;# &jcode'getcode(*line)
+;# Return 'jis', 'sjis', 'euc' or undef according to
+;# Japanese character code in $line. Return 'binary' if
+;# the data has non-character code.
+;#
+;# When evaluated in array context, it returns a list
+;# contains two items. First value is the number of
+;# characters which matched to the expected code, and
+;# second value is the code name. It is useful if and
+;# only if the number is not 0 and the code is undef;
+;# that case means it couldn't tell 'euc' or 'sjis'
+;# because the evaluation score was exactly same. This
+;# interface is too tricky, though.
+;#
+;# Code detection between euc and sjis is very difficult
+;# or sometimes impossible or even lead to wrong result
+;# when it includes JIS X0201 KANA characters. So JIS
+;# X0201 KANA is ignored for automatic code detection.
+;#
+;# &jcode'convert(*line, $ocode [, $icode [, $option]])
+;# Convert the contents of $line to the specified
+;# Japanese code given in the second argument $ocode.
+;# $ocode can be any of "jis", "sjis" or "euc", or use
+;# "noconv" when you don't want the code conversion.
+;# Input code is recognized automatically from the line
+;# itself when $icode is not supplied (JIS X0201 KANA is
+;# ignored in code detection. See the above descripton
+;# of &getcode). $icode also can be specified, but
+;# xxx2yyy routine is more efficient when both codes are
+;# known.
+;#
+;# It returns the code of input string in scalar context,
+;# and a list of pointer of convert subroutine and the
+;# input code in array context.
+;#
+;# Japanese character code JIS X0201, X0208, X0212 and
+;# ASCII code are supported. X0212 characters can not be
+;# represented in SJIS and they will be replased by
+;# "geta" character when converted to SJIS.
+;#
+;# See next paragraph for $option parameter.
+;#
+;# &jcode'xxx2yyy(*line [, $option])
+;# Convert the Japanese code from xxx to yyy. String xxx
+;# and yyy are any convination from "jis", "euc" or
+;# "sjis". They return *approximate* number of converted
+;# bytes. So return value 0 means the line was not
+;# converted at all.
+;#
+;# Optional parameter $option is used to specify optional
+;# conversion method. String "z" is for JIS X0201 KANA
+;# to X0208 KANA, and "h" is for reverse.
+;#
+;# $jcode'convf{'xxx', 'yyy'}
+;# The value of this associative array is pointer to the
+;# subroutine jcode'xxx2yyy().
+;#
+;# &jcode'to($ocode, $line [, $icode [, $option]])
+;# &jcode'jis($line [, $icode [, $option]])
+;# &jcode'euc($line [, $icode [, $option]])
+;# &jcode'sjis($line [, $icode [, $option]])
+;# These functions are prepared for easy use of
+;# call/return-by-value interface. You can use these
+;# funcitons in s///e operation or any other place for
+;# convenience.
+;#
+;# &jcode'jis_inout($in, $out)
+;# Set or inquire JIS start and end sequences. Default
+;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
+;# character, "ESC-$" or "ESC-(" is prepended for each
+;# character respectively. Acutually "ESC-(-B" is not a
+;# sequence to end JIS code but a sequence to start ASCII
+;# code set. So `in' and `out' are somewhat misleading.
+;#
+;# &jcode'get_inout($string)
+;# Get JIS start and end sequences from $string.
+;#
+;# &jcode'cache()
+;# &jcode'nocache()
+;# &jcode'flush()
+;# Usually, converted character is cached in memory to
+;# avoid same calculations have to be done many times.
+;# To disable this caching, call &jcode'nocache(). It
+;# can be revived by &jcode'cache() and cache is flushed
+;# by calling &jcode'flush(). &cache() and &nocache()
+;# functions return previous caching state.
+;#
+;# ---------------------------------------------------------------
+;#
+;# &jcode'h2z_xxx(*line)
+;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
+;# (Zenkaku-KANA) code conversion routine. String xxx is
+;# any of "jis", "sjis" and "euc". From the difficulty
+;# of recognizing code set from 1-byte KATAKANA string,
+;# automatic code recognition is not supported.
+;#
+;# &jcode'z2h_xxx(*line)
+;# X0208 to X0201 KANA code conversion routine. String
+;# xxx is any of "jis", "sjis" and "euc".
+;#
+;# $jcode'z2hf{'xxx'}
+;# $jcode'h2zf{'xxx'}
+;# These are pointer to the corresponding function just
+;# as $jcode'convf.
+;#
+;# ---------------------------------------------------------------
+;#
+;# &jcode'tr(*line, $from, $to [, $option])
+;# &jcode'tr emulates tr operator for 2 byte code. Only 'd'
+;# is interpreted as an option.
+;#
+;# Range operator like `A-Z' for 2 byte code is partially
+;# supported. Code must be JIS or EUC, and first byte
+;# have to be same on first and last character.
+;#
+;# CAUTION: Handling range operator is a kind of trick
+;# and it is not perfect. So if you need to transfer `-'
+;# character, please be sure to put it at the beginning
+;# or the end of $from and $to strings.
+;#
+;# &jcode'trans($line, $from, $to [, $option)
+;# Same as &jcode'tr but accept string and return string
+;# after translation.
+;#
+;# ---------------------------------------------------------------
+;#
+;# &jcode'init()
+;# Initialize the variables used in this package. You
+;# don't have to call this when using jocde.pl by `do' or
+;# `require' interface. Call it first if you embedded
+;# the jcode.pl at the end of your script.
+;#
+;######################################################################
+;#
+;# PERL5 INTERFACE:
+;#
+;# Current jcode.pl is written in Perl 4 but it is possible to use
+;# from Perl 5 using `references'. Fully perl5 capable version is
+;# future issue.
+;#
+;# Since lexical variable is not a subject of typeglob, *string style
+;# call doesn't work if the variable is declared as `my'. Same thing
+;# happens to special variable $_ if the perl is compiled to use
+;# thread capability. So using reference is generally recommented to
+;# avoid the mysterious error.
+;#
+;# jcode::getcode(\$line)
+;# jcode::convert(\$line, $ocode [, $icode [, $option]])
+;# jcode::xxx2yyy(\$line [, $option])
+;# &{$jcode::convf{'xxx', 'yyy'}}(\$line)
+;# jcode::to($ocode, $line [, $icode [, $option]])
+;# jcode::jis($line [, $icode [, $option]])
+;# jcode::euc($line [, $icode [, $option]])
+;# jcode::sjis($line [, $icode [, $option]])
+;# jcode::jis_inout($in, $out)
+;# jcode::get_inout($string)
+;# jcode::cache()
+;# jcode::nocache()
+;# jcode::flush()
+;# jcode::h2z_xxx(\$line)
+;# jcode::z2h_xxx(\$line)
+;# &{$jcode::z2hf{'xxx'}}(\$line)
+;# &{$jcode::h2zf{'xxx'}}(\$line)
+;# jcode::tr(\$line, $from, $to [, $option])
+;# jcode::trans($line, $from, $to [, $option)
+;# jcode::init()
+;#
+;######################################################################
+;#
+;# SAMPLES
+;#
+;# Convert any Kanji code to JIS and print each line with code name.
+;#
+;# while (defined($s = <>)) {
+;# $code = &jcode'convert(*s, 'jis');
+;# print $code, "\t", $s;
+;# }
+;#
+;# Convert all lines to JIS according to the first recognized line.
+;#
+;# while (defined($s = <>)) {
+;# print, next unless $s =~ /[\033\200-\377]/;
+;# (*f, $icode) = &jcode'convert(*s, 'jis');
+;# print;
+;# defined(&f) || next;
+;# while (<>) { &f(*s); print; }
+;# last;
+;# }
+;#
+;# The safest way of JIS conversion.
+;#
+;# while (defined($s = <>)) {
+;# ($matched, $icode) = &jcode'getcode(*s);
+;# if (@buf == 0 && $matched == 0) {
+;# print $s;
+;# next;
+;# }
+;# push(@buf, $s);
+;# next unless $icode;
+;# while (defined($s = shift(@buf))) {
+;# &jcode'convert(*s, 'jis', $icode);
+;# print $s;
+;# }
+;# while (defined($s = <>)) {
+;# &jcode'convert(*s, 'jis', $icode);
+;# print $s;
+;# }
+;# last;
+;# }
+;# print @buf if @buf;
+;#
+;######################################################################
+
+;#
+;# Call initialize function if it is not called yet. This may sound
+;# strange but it makes easy to embed the jcode.pl at the end of
+;# script. Call &jcode'init at the beginning of the script in that
+;# case.
+;#
+&init unless defined $version;
+
+;#
+;# Initialize variables.
+;#
+sub init {
+ $version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unknown';
+
+ $re_bin = '[\000-\006\177\377]';
+
+ $re_jis0208_1978 = '\e\$\@';
+ $re_jis0208_1983 = '\e\$B';
+ $re_jis0208_1990 = '\e&\@\e\$B';
+ $re_jis0208 = "$re_jis0208_1978|$re_jis0208_1983|$re_jis0208_1990";
+ $re_jis0212 = '\e\$\(D';
+ $re_jp = "$re_jis0208|$re_jis0212";
+ $re_asc = '\e\([BJ]';
+ $re_kana = '\e\(I';
+
+ $esc_0208 = "\e\$B";
+ $esc_0212 = "\e\$(D";
+ $esc_asc = "\e(B";
+ $esc_kana = "\e(I";
+
+ $re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
+ $re_sjis_kana = '[\241-\337]';
+
+ $re_euc_c = '[\241-\376][\241-\376]';
+ $re_euc_kana = '\216[\241-\337]';
+ $re_euc_0212 = '\217[\241-\376][\241-\376]';
+
+ # Use `geta' for undefined character code
+ $undef_sjis = "\x81\xac";
+
+ $cache = 1;
+
+ # X0201 -> X0208 KANA conversion table. Looks weird? Not that
+ # much. This is simply JIS text without escape sequences.
+ ($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\041-\176/\241-\376/;
+! !# $ !" % !& " !V # !W
+^ !+ _ !, 0 !<
+' %! ( %# ) %% * %' + %)
+, %c - %e . %g / %C
+1 %" 2 %$ 3 %& 4 %( 5 %*
+6 %+ 7 %- 8 %/ 9 %1 : %3
+6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
+; %5 < %7 = %9 > %; ? %=
+;^ %6 <^ %8 =^ %: >^ %< ?^ %>
+@ %? A %A B %D C %F D %H
+@^ %@ A^ %B B^ %E C^ %G D^ %I
+E %J F %K G %L H %M I %N
+J %O K %R L %U M %X N %[
+J^ %P K^ %S L^ %V M^ %Y N^ %\
+J_ %Q K_ %T L_ %W M_ %Z N_ %]
+O %^ P %_ Q %` R %a S %b
+T %d U %f V %h
+W %i X %j Y %k Z %l [ %m
+\ %o ] %s & %r 3^ %t
+__TABLE_END__
+ %h2z = split(/\s+/, $h2z . $h2z_high);
+ %z2h = reverse %h2z;
+
+ $convf{'jis' , 'jis' } = *jis2jis;
+ $convf{'jis' , 'sjis'} = *jis2sjis;
+ $convf{'jis' , 'euc' } = *jis2euc;
+ $convf{'euc' , 'jis' } = *euc2jis;
+ $convf{'euc' , 'sjis'} = *euc2sjis;
+ $convf{'euc' , 'euc' } = *euc2euc;
+ $convf{'sjis' , 'jis' } = *sjis2jis;
+ $convf{'sjis' , 'sjis'} = *sjis2sjis;
+ $convf{'sjis' , 'euc' } = *sjis2euc;
+ $h2zf{'jis' } = *h2z_jis;
+ $z2hf{'jis' } = *z2h_jis;
+ $h2zf{'euc' } = *h2z_euc;
+ $z2hf{'euc' } = *z2h_euc;
+ $h2zf{'sjis'} = *h2z_sjis;
+ $z2hf{'sjis'} = *z2h_sjis;
+}
+
+;#
+;# Set escape sequences which should be put before and after Japanese
+;# (JIS X0208) string.
+;#
+sub jis_inout {
+ $esc_0208 = shift || $esc_0208;
+ $esc_0208 = "\e\$$esc_0208" if length($esc_0208) == 1;
+ $esc_asc = shift || $esc_asc;
+ $esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
+ ($esc_0208, $esc_asc);
+}
+
+;#
+;# Get JIS in and out sequences from the string.
+;#
+sub get_inout {
+ local($esc_0208, $esc_asc);
+ $_[$[] =~ /($re_jis0208)/o && ($esc_0208 = $1);
+ $_[$[] =~ /($re_asc)/o && ($esc_asc = $1);
+ ($esc_0208, $esc_asc);
+}
+
+;#
+;# Recognize character code.
+;#
+sub getcode {
+ local(*s) = @_;
+ local($matched, $code);
+
+ if ($s !~ /[\e\200-\377]/) { # not Japanese
+ $matched = 0;
+ $code = undef;
+ } # 'jis'
+ elsif ($s =~ /$re_jp|$re_asc|$re_kana/o) {
+ $matched = 1;
+ $code = 'jis';
+ }
+ elsif ($s =~ /$re_bin/o) { # 'binary'
+ $matched = 0;
+ $code = 'binary';
+ }
+ else { # should be 'euc' or 'sjis'
+ local($sjis, $euc) = (0, 0);
+
+ while ($s =~ /(($re_sjis_c)+)/go) {
+ $sjis += length($1);
+ }
+ while ($s =~ /(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/go) {
+ $euc += length($1);
+ }
+ $matched = &max($sjis, $euc);
+ $code = ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1];
+ }
+ wantarray ? ($matched, $code) : $code;
+}
+sub max { $_[ $[ + ($_[ $[ ] < $_[ $[ + 1 ]) ]; }
+
+;#
+;# Convert any code to specified code.
+;#
+sub convert {
+ local(*s, $ocode, $icode, $opt) = @_;
+ return (undef, undef) unless $icode = $icode || &getcode(*s);
+ return (undef, $icode) if $icode eq 'binary';
+ $ocode = 'jis' unless $ocode;
+ $ocode = $icode if $ocode eq 'noconv';
+ local(*f) = $convf{$icode, $ocode};
+ &f(*s, $opt);
+ wantarray ? (*f, $icode) : $icode;
+}
+
+;#
+;# Easy return-by-value interfaces.
+;#
+sub jis { &to('jis', @_); }
+sub euc { &to('euc', @_); }
+sub sjis { &to('sjis', @_); }
+sub to {
+ local($ocode, $s, $icode, $opt) = @_;
+ &convert(*s, $ocode, $icode, $opt);
+ $s;
+}
+sub what {
+ local($s) = @_;
+ &getcode(*s);
+}
+sub trans {
+ local($s) = shift;
+ &tr(*s, @_);
+ $s;
+}
+
+;#
+;# SJIS to JIS
+;#
+sub sjis2jis {
+ local(*s, $opt, $n) = @_;
+ &sjis2sjis(*s, $opt) if $opt;
+ $s =~ s/(($re_sjis_c|$re_sjis_kana)+)/&_sjis2jis($1) . $esc_asc/geo;
+ $n;
+}
+sub _sjis2jis {
+ local($s) = shift;
+ $s =~ s/(($re_sjis_c)+|($re_sjis_kana)+)/&__sjis2jis($1)/geo;
+ $s;
+}
+sub __sjis2jis {
+ local($s) = shift;
+ if ($s =~ /^$re_sjis_kana/o) {
+ $n += $s =~ tr/\241-\337/\041-\137/;
+ $esc_kana . $s;
+ } else {
+ $n += $s =~ s/($re_sjis_c)/$s2e{$1}||&s2e($1)/geo;
+ $s =~ tr/\241-\376/\041-\176/;
+ $esc_0208 . $s;
+ }
+}
+
+;#
+;# EUC to JIS
+;#
+sub euc2jis {
+ local(*s, $opt, $n) = @_;
+ &euc2euc(*s, $opt) if $opt;
+ $s =~ s/(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/
+ &_euc2jis($1) . $esc_asc
+ /geo;
+ $n;
+}
+sub _euc2jis {
+ local($s) = shift;
+ $s =~ s/(($re_euc_c)+|($re_euc_kana)+|($re_euc_0212)+)/&__euc2jis($1)/geo;
+ $s;
+}
+sub __euc2jis {
+ local($s) = shift;
+ local($esc);
+
+ if ($s =~ tr/\216//d) {
+ $esc = $esc_kana;
+ } elsif ($s =~ tr/\217//d) {
+ $esc = $esc_0212;
+ } else {
+ $esc = $esc_0208;
+ }
+
+ $n += $s =~ tr/\241-\376/\041-\176/;
+ $esc . $s;
+}
+
+;#
+;# JIS to EUC
+;#
+sub jis2euc {
+ local(*s, $opt, $n) = @_;
+ $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
+ &euc2euc(*s, $opt) if $opt;
+ $n;
+}
+sub _jis2euc {
+ local($esc, $s) = @_;
+ if ($esc !~ /^$re_asc/o) {
+ $n += $s =~ tr/\041-\176/\241-\376/;
+ if ($esc =~ /^$re_kana/o) {
+ $s =~ s/([\241-\337])/\216$1/g;
+ }
+ elsif ($esc =~ /^$re_jis0212/o) {
+ $s =~ s/([\241-\376][\241-\376])/\217$1/g;
+ }
+ }
+ $s;
+}
+
+;#
+;# JIS to SJIS
+;#
+sub jis2sjis {
+ local(*s, $opt, $n) = @_;
+ &jis2jis(*s, $opt) if $opt;
+ $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
+ $n;
+}
+sub _jis2sjis {
+ local($esc, $s) = @_;
+ if ($esc =~ /^$re_jis0212/o) {
+ $s =~ s/../$undef_sjis/g;
+ $n = length;
+ }
+ elsif ($esc !~ /^$re_asc/o) {
+ $n += $s =~ tr/\041-\176/\241-\376/;
+ if ($esc =~ /^$re_jp/o) {
+ $s =~ s/($re_euc_c)/$e2s{$1}||&e2s($1)/geo;
+ }
+ }
+ $s;
+}
+
+;#
+;# SJIS to EUC
+;#
+sub sjis2euc {
+ local(*s, $opt,$n) = @_;
+ $n = $s =~ s/($re_sjis_c|$re_sjis_kana)/$s2e{$1}||&s2e($1)/geo;
+ &euc2euc(*s, $opt) if $opt;
+ $n;
+}
+sub s2e {
+ local($c1, $c2, $code);
+ ($c1, $c2) = unpack('CC', $code = shift);
+
+ if (0xa1 <= $c1 && $c1 <= 0xdf) {
+ $c2 = $c1;
+ $c1 = 0x8e;
+ } elsif (0x9f <= $c2) {
+ $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
+ $c2 += 2;
+ } else {
+ $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
+ $c2 += 0x60 + ($c2 < 0x7f);
+ }
+ if ($cache) {
+ $s2e{$code} = pack('CC', $c1, $c2);
+ } else {
+ pack('CC', $c1, $c2);
+ }
+}
+
+;#
+;# EUC to SJIS
+;#
+sub euc2sjis {
+ local(*s, $opt,$n) = @_;
+ &euc2euc(*s, $opt) if $opt;
+ $n = $s =~ s/($re_euc_c|$re_euc_kana|$re_euc_0212)/$e2s{$1}||&e2s($1)/geo;
+}
+sub e2s {
+ local($c1, $c2, $code);
+ ($c1, $c2) = unpack('CC', $code = shift);
+
+ if ($c1 == 0x8e) { # SS2
+ return substr($code, 1, 1);
+ } elsif ($c1 == 0x8f) { # SS3
+ return $undef_sjis;
+ } elsif ($c1 % 2) {
+ $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
+ $c2 -= 0x60 + ($c2 < 0xe0);
+ } else {
+ $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
+ $c2 -= 2;
+ }
+ if ($cache) {
+ $e2s{$code} = pack('CC', $c1, $c2);
+ } else {
+ pack('CC', $c1, $c2);
+ }
+}
+
+;#
+;# JIS to JIS, SJIS to SJIS, EUC to EUC
+;#
+sub jis2jis {
+ local(*s, $opt) = @_;
+ $s =~ s/$re_jis0208/$esc_0208/go;
+ $s =~ s/$re_asc/$esc_asc/go;
+ &h2z_jis(*s) if $opt =~ /z/;
+ &z2h_jis(*s) if $opt =~ /h/;
+}
+sub sjis2sjis {
+ local(*s, $opt) = @_;
+ &h2z_sjis(*s) if $opt =~ /z/;
+ &z2h_sjis(*s) if $opt =~ /h/;
+}
+sub euc2euc {
+ local(*s, $opt) = @_;
+ &h2z_euc(*s) if $opt =~ /z/;
+ &z2h_euc(*s) if $opt =~ /h/;
+}
+
+;#
+;# Cache control functions
+;#
+sub cache {
+ ($cache, $cache = 1)[$[];
+}
+sub nocache {
+ ($cache, $cache = 0)[$[];
+}
+sub flushcache {
+ undef %e2s;
+ undef %s2e;
+}
+
+;#
+;# X0201 -> X0208 KANA conversion routine
+;#
+sub h2z_jis {
+ local(*s, $n) = @_;
+ if ($s =~ s/$re_kana([^\e]*)/$esc_0208 . &_h2z_jis($1)/geo) {
+ 1 while $s =~ s/(($re_jis0208)[^\e]*)($re_jis0208)/$1/o;
+ }
+ $n;
+}
+sub _h2z_jis {
+ local($s) = @_;
+ $n += $s =~ s/(([\041-\137])([\136\137])?)/
+ $h2z{$1} || $h2z{$2} . $h2z{$3}
+ /ge;
+ $s;
+}
+
+sub h2z_euc {
+ local(*s) = @_;
+ $s =~ s/\216([\241-\337])(\216([\336\337]))?/
+ $h2z{"$1$3"} || $h2z{$1} . $h2z{$3}
+ /ge;
+}
+
+sub h2z_sjis {
+ local(*s, $n) = @_;
+ $s =~ s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/
+ $1 || ($n++, $h2z{$3} ? $e2s{$h2z{$3}} || &e2s($h2z{$3})
+ : &e2s($h2z{$4}) . ($5 && &e2s($h2z{$5})))
+ /geo;
+ $n;
+}
+
+;#
+;# X0208 -> X0201 KANA conversion routine
+;#
+sub z2h_jis {
+ local(*s, $n) = @_;
+ $s =~ s/($re_jis0208)([^\e]+)/&_z2h_jis($2)/geo;
+ $n;
+}
+sub _z2h_jis {
+ local($s) = @_;
+ $s =~ s/((\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+)/
+ &__z2h_jis($1)
+ /ge;
+ $s;
+}
+sub __z2h_jis {
+ local($s) = @_;
+ return $esc_0208 . $s unless $s =~ /^%/ || $s =~ /^![\#\"&VW+,<]/;
+ $n += length($s) / 2;
+ $s =~ s/(..)/$z2h{$1}/g;
+ $esc_kana . $s;
+}
+
+sub z2h_euc {
+ local(*s, $n) = @_;
+ &init_z2h_euc unless defined %z2h_euc;
+ $s =~ s/($re_euc_c|$re_euc_kana)/
+ $z2h_euc{$1} ? ($n++, $z2h_euc{$1}) : $1
+ /geo;
+ $n;
+}
+
+sub z2h_sjis {
+ local(*s, $n) = @_;
+ &init_z2h_sjis unless defined %z2h_sjis;
+ $s =~ s/($re_sjis_c)/$z2h_sjis{$1} ? ($n++, $z2h_sjis{$1}) : $1/geo;
+ $n;
+}
+
+;#
+;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
+;# can be done in &init but it's not worth doing. Similarly,
+;# precalculated table is not worth to occupy the file space and
+;# reduce the readability. The author personnaly discourages to use
+;# X0201 Kana character in the any situation.
+;#
+sub init_z2h_euc {
+ local($k, $s);
+ while (($k, $s) = each %z2h) {
+ $s =~ s/([\241-\337])/\216$1/g && ($z2h_euc{$k} = $s);
+ }
+}
+sub init_z2h_sjis {
+ local($s, $v);
+ while (($s, $v) = each %z2h) {
+ $s =~ /[\200-\377]/ && ($z2h_sjis{&e2s($s)} = $v);
+ }
+}
+
+;#
+;# TR function for 2-byte code
+;#
+sub tr {
+ # $prev_from, $prev_to, %table are persistent variables
+ local(*s, $from, $to, $opt) = @_;
+ local(@from, @to);
+ local($jis, $n) = (0, 0);
+
+ $jis++, &jis2euc(*s) if $s =~ /$re_jp|$re_asc|$re_kana/o;
+ $jis++ if $to =~ /$re_jp|$re_asc|$re_kana/o;
+
+ if (!defined($prev_from) || $from ne $prev_from || $to ne $prev_to) {
+ ($prev_from, $prev_to) = ($from, $to);
+ undef %table;
+ &_maketable;
+ }
+
+ $s =~ s/([\200-\377][\000-\377]|[\000-\377])/
+ defined($table{$1}) && ++$n ? $table{$1} : $1
+ /ge;
+
+ &euc2jis(*s) if $jis;
+
+ $n;
+}
+
+sub _maketable {
+ local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';
+
+ &jis2euc(*to) if $to =~ /$re_jp|$re_asc|$re_kana/o;
+ &jis2euc(*from) if $from =~ /$re_jp|$re_asc|$re_kana/o;
+
+ grep(s/(([\200-\377])[\200-\377]-\2[\200-\377])/&_expnd2($1)/ge,
+ $from, $to);
+ grep(s/($ascii-$ascii)/&_expnd1($1)/geo,
+ $from, $to);
+
+ @to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;
+ @from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;
+ push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
+ @table{@from} = @to;
+}
+
+sub _expnd1 {
+ local($s) = @_;
+ $s =~ s/\\(.)/$1/g;
+ local($c1, $c2) = unpack('CxC', $s);
+ if ($c1 <= $c2) {
+ for ($s = ''; $c1 <= $c2; $c1++) {
+ $s .= pack('C', $c1);
+ }
+ }
+ $s;
+}
+
+sub _expnd2 {
+ local($s) = @_;
+ local($c1, $c2, $c3, $c4) = unpack('CCxCC', $s);
+ if ($c1 == $c3 && $c2 <= $c4) {
+ for ($s = ''; $c2 <= $c4; $c2++) {
+ $s .= pack('CC', $c1, $c2);
+ }
+ }
+ $s;
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl
+
+##### YADChat\94Å\8d\8b\89Ø\88ºà£\83`\83\83\83b\83g #####
+### $Id: kenranchat.cgi,v 1.5 2007/07/14 14:00:19 jyugoya Exp $
+### YADChat / 2007 © \8c\8b\8fé\97R\97\85\81\97\90¢\8aE\94E\8eÒ\8d\91 / BSD Lisence
+### Kent-Web\82Ìcomchat\82Ì\81i\82Ù\82Ú\81j\8cÝ\8a·\95i\81A\82ð\82³\82ç\82É\8f\91\82«\8a·\82¦\82½\82à\82Ì
+
+# \83o\81[\83W\83\87\83\93\94Ô\8d\86
+$ver = 'KENRANCHAT 1.2';
+
+# \90Ý\92è\8d\80\96Ú\93Ç\82Ý\8d\9e\82Ý
+require './config.cgi';
+
+# CGI\8aÖ\98A\8f\88\97\9d\83\89\83C\83u\83\89\83\8a\93Ç\82Ý\8d\9e\82Ý
+require './cgilib.pl';
+
+# KENRANCHAT \83\89\83C\83u\83\89\83\8a
+require './kenranlib.pl';
+
+########################
+##### \83\81\83C\83\93\8f\88\97\9d\95\94 #####
+########################
+
+##### CGI\83p\83b\83P\81[\83W #####
+use CGI qw/:standard/;
+
+##### \83O\83\8d\81[\83o\83\8b\95Ï\90\94 #####
+# CGI \83I\83u\83W\83F\83N\83g
+$query = new CGI;
+
+# \93ü\97Í\83f\81[\83^\89ð\90Í (\83O\83\8d\81[\83o\83\8b\95Ï\90\94)
+&checkInput();
+
+# \83N\83b\83L\81[\82ð\8eæ\93¾ (\83O\83\8d\81[\83o\83\8b\95Ï\90\94)
+%CK = &getCookie($CONF{'cookiekey'});
+
+# \83_\83C\83XON\82È\82ç\82Î\83_\83C\83X\95¶\8e\9a\97ñ\92u\82«\8a·\82¦
+if ( $CONF{'dicemode'} ) {
+ if ($IN{'comment'} =~ /([1-9][0-9]*)[dD]([1-9][0-9]*)/) {
+ local($dstr) = &dice($1, $2);
+ $IN{'comment'} =~ s/[1-9][0-9]*[dD][1-9][0-9]*/$dstr/;
+ }
+}
+
+# RP\8b@\94\\82ªON\82È\82ç\82Î\95¶\8e\9a\97ñ\82Élogclear\82ª\82 \82Á\82½\82çRP\83\8d\83O\8fÁ\8b\8e
+if ( $CONF{'rplog'} ) {
+ if ($IN{'comment'} =~ /^logclear$/) {
+ &clearRPLog();
+ }
+}
+
+# \8aç\95¶\8e\9a\82ª\82 \82ê\82Î\81A\93ü\97Í\95¶\8e\9a\97ñ\82É\95t\8bL
+if ( $IN{'face'} ne "" ) {
+ $IN{'comment'} = "$IN{'comment'} $IN{'face'}";
+}
+
+# \83N\83\89\83C\83A\83\93\83g\82ÌIP\83A\83h\83\8c\83X\82Ì\8eæ\93¾ (\83O\83\8d\81[\83o\83\8b\95Ï\90\94)
+$client = $ENV{'REMOTE_ADDR'};
+
+# \96³\96¼\82Ì\8fê\8d\87\82Í\83N\83\89\83C\83A\83\93\83gIP\83A\83h\83\8c\83X\82ð\96¼\91O\82Æ\82·\82é
+if ($IN{'name'} eq "") {
+ $IN{'name'} = $client;
+}
+
+# \8e\9e\8aÔ\82ð\8eæ\93¾
+$date = &getDate();
+
+# \83g\83\8a\83b\83v\95Ï\8a·
+if ($CONF{'usetrip'} && $IN{'name'} =~ /(.*)(#|\81\94)(.*)/){
+ $trip = &genTrip($1, $3);
+ $tripped = "<b>" . $name . "</b>\81\9f" . $trip;
+} else {
+ $tripped = $IN{'name'};
+ $tripped =~ s/\81\9f/\81\9e/g;
+}
+
+# \83A\83N\83Z\83X\8b\91\94Û\83`\83F\83b\83N
+&checkDeny($client);
+
+# \83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b\82©\82ç\95\94\89®\83^\83C\83g\83\8b\82ð\8eæ\93¾\82µ\82Ä\8fã\8f\91\82«
+$CONF{'title'} = &getRoomTitle($IN{'room'});
+
+# \95\94\89®\83`\83F\83b\83N
+if ($IN{'room'} ne "") {
+ $datfile = $CONF{'datdir'}.'/'.$IN{'room'}.'.dat';
+ if (! -e $datfile) {
+ $logfile = $CONF{'logdir'}.'/'.$IN{'room'}.'.html';
+ if (-e $logfile) {
+ &printGoToLog();
+ } else {
+ &printError("\8ew\92è\82³\82ê\82½\83`\83\83\83b\83g\83\8b\81[\83\80\82Í\83\8d\83O\82à\91¶\8dÝ\82µ\82Ä\82¢\82Ü\82¹\82ñ");
+ }
+ }
+} else {
+ &printError("\95\94\89®\94Ô\8d\86\82ª\8ew\92è\82³\82ê\82Ä\82¢\82Ü\82¹\82ñ");
+}
+
+# \8cy\97Ê\89»ON\82É\82æ\82é\93®\8dì\95ª\8aò
+if ($IN{'weight'} eq 'light') {
+ if ($IN{'mode'} eq '' || $IN{'mode'} eq 'view' || $IN{'mode'} eq 'form') {
+ &printEntryFormAndDat();
+ } elsif ($IN{'mode'} eq 'login' || $IN{'mode'} eq 'chat') {
+ &printChatFormAndDat();
+ } elsif ($IN{'mode'} eq 'logout') {
+ &printLogout($tripped);
+ } else {
+ &printError("\82»\82Ì\82æ\82¤\82È\83\82\81[\83h\82Í\91¶\8dÝ\82µ\82Ü\82¹\82ñ");
+ }
+}
+
+# mode \82É\82æ\82é\93®\8dì\95ª\8aò
+if ($IN{'mode'} eq '') {
+ &printFrame();
+} elsif ($IN{'mode'} eq 'view') {
+ &viewDat();
+} elsif ($IN{'mode'} eq 'form') {
+ &printEntryForm();
+} elsif ($IN{'mode'} eq 'login') {
+ &printChatForm();
+} elsif ($IN{'mode'} eq 'chat') {
+ if ($IN{'comment'}) {
+ &writeDat($IN{'mode'});
+ }
+ &viewDat();
+} elsif ($IN{'mode'} eq 'logout') {
+ &printLogout($tripped);
+} else {
+ &printError("\82»\82Ì\82æ\82¤\82È\83\82\81[\83h\82Í\91¶\8dÝ\82µ\82Ü\82¹\82ñ");
+}
+
+### Main\8f\88\97\9d\8fI\97¹
+
+__END__
--- /dev/null
+##### TADChat\94Å\8d\8b\89Ø\88ºà£\83`\83\83\83b\83g\83\89\83C\83u\83\89\83\8a
+### Kenran Chat Lib / 2007 © \8c\8b\8fé\97R\97\85\81\97\90¢\8aE\94E\8eÒ\8d\91 / BSD Lisence
+### $Id: kenranlib.pl,v 1.7 2007/07/14 14:00:19 jyugoya Exp $
+### \96{\91Ì\82©\82ç\95ª\97£\81Ayadchatlib.pl\82É\83}\81[\83W\92\86
+
+# YADChat Lib \93Ç\82Ý\8d\9e\82Ý
+require './yadchatlib.pl';
+
+# \95¶\8e\9a\83R\81[\83h\95Ï\8a·\83\89\83C\83u\83\89\83\8a\8eæ\8d\9e\82Ý
+require './jcode.pl';
+
+###
+### \83\86\81[\83e\83B\83\8a\83e\83B
+###
+
+##### \8aÖ\90\94\81F\93ú\95t\90¶\90¬ #####
+sub getDate {
+ $ENV{'TZ'} = $CONF{'timezone'};
+ local($times) = time;
+ local($sec,$min,$hour,$mday,$mon) = localtime($times);
+ return sprintf("%s/%s-%02d:%02d:%02d",$mon+1,$mday,$hour,$min,$sec);
+}
+
+##### \8aÖ\90\94\81F\83_\83C\83X #####
+sub dice {
+ local($num, $type) = @_;
+ srand;
+ #"$num\8cÂ\82Ì$type\96Ê\91Ì";
+ local($ret) = $num."d".$type.": ";
+ for ($i=0; $i<$num; $i++) {
+ $d = int(rand($type)) + 1;
+ $sum += $d;
+ $ret .= $d;
+ if ($i < $num -1) { $ret .= " + " }
+ }
+ $ret .= " = $sum";
+}
+
+##### \8aÖ\90\94\81F\93ü\97Í\8f\88\97\9d #####
+sub checkInput {
+ $IN{'room'} = $query->param('room');
+ $IN{'name'} = $query->param('name');
+ $IN{'weight'} = $query->param('weight');
+ $IN{'reverse'} = $query->param('reverse');
+ $IN{'comment'} = $query->param('comment');
+ $IN{'mode'} = $query->param('mode');
+ $IN{'face'} = $query->param('face');
+ $IN{'email'} = $query->param('email');
+ $IN{'color'} = $query->param('color');
+ $IN{'retime'} = $query->param('retime');
+ $IN{'line'} = $query->param('line');
+
+ foreach $key (keys %IN) {
+ # \95¶\8e\9a\83R\81[\83h\82ðEUC\95Ï\8a· (\95¶\8e\9a\83R\81[\83h\82Ì\93\9d\88ê\82Æ\83T\83j\83^\83C\83W\83\93\83O\82Ì\82½\82ß)
+ local($c) = &jcode::getcode(\$IN{$key});
+ #print "code: $c\n";
+ if ($c eq 1 || $c eq 2) {
+ &jcode::convert(\$IN{$key}, 'euc');
+ }
+
+ # \83^\83O\8f\88\97\9d (\83T\83j\83^\83C\83W\83\93\83O)
+ $IN{$key} =~ s/&/&/g;
+ $IN{$key} =~ s/</</g;
+ $IN{$key} =~ s/>/>/g;
+ $IN{$key} =~ s/"/"/g; # "
+ $IN{$key} =~ s/\r//g;
+ $IN{$key} =~ s/\n//g;
+
+ # \95¶\8e\9a\83R\81[\83h\82ð\8f\88\97\9d\8cn\82É\8d\87\82í\82¹\82é
+ local($code) = 'euc';
+ if ($CONF{'charset'} eq 'Shift_JIS') {
+ $code = 'sjis';
+ } elsif ($CONF{'charset'} eq 'ISO-2202-JP') {
+ $code = 'jis';
+ }
+ &jcode::convert(\$IN{$key}, $code);
+ }
+}
+
+##### \8aÖ\90\94\81F\83g\83\8a\83b\83v\8eæ\93¾\8f\88\97\9d #####
+sub getTrip {
+ local($name) = $_[0];
+ local($tripped) = $name;
+ # \83g\83\8a\83b\83v\8b@\94\\82ª\97L\8cø\82È\82ç\82Î\81A\83g\83\8a\83b\83v\82ð\82»\82ê\88È\8aO\82È\82ç\82Î\82»\82Ì\82Ü\82Ü\82ð\95Ô\82·
+ if ($CONF{'usetrip'} && $name =~ /(.*)(#|\81\94)(.*)/){
+ $trip = &genTrip($1, $3);
+ $tripped = $1 . "\81\9f" . $trip;
+ } else {
+ $tripped =~ s/\81\9f/\81\9e/g;
+ }
+ return $tripped;
+}
+
+##### \8aÖ\90\94\81F\83g\83\8a\83b\83v\90¶\90¬ #####
+sub genTrip {
+ local($name, $key) = @_;
+ local($salt) = substr($key."H.", 1, 2);
+ $salt =~ s/[^\.-z]/\./go;
+ $salt =~ tr/:;<=>?@[\\]^_`/ABCDEFGabcdef/; #`
+ return substr(crypt($key, $salt), -10);
+}
+
+##### \8aÖ\90\94\81F\83A\83N\83Z\83X\8b\91\94Û\8f\88\97\9d #####
+sub checkDeny {
+ local($client) = $_[0];
+ local($find)=0;
+ open(DENY, "$CONF{'denyfile'}")
+ || &error("Open Error : denyfile : $CONF{'denyfile'} : $!");
+ while (<DENY>) {
+ s/\n//g;
+ next if (!$_);
+ s/\*/\.\*/g;
+ if ($client =~ /$_/i) { $find=1; last; }
+ }
+ close(DENY);
+ if ($find) { &error($CONF{'denymsg'}); }
+}
+
+###
+# \94\8c¾\8f\9c\8b\8e\8f\88\97\9d
+sub clear {
+ local($client, @lines) = @_;
+ local(@temp) = ();
+ local($match)=0;
+ foreach (@lines) {
+ local($cip) = (split(/<>/))[5];
+ if ($client eq $cip) {
+ $match=1;
+ } else {
+ push(@temp, $_);
+ }
+ }
+ if ($match) {
+ $IN{'comment'}="All Clear (^-^)v";
+ return @temp;
+ }
+}
+
+###
+# \83\8d\83O\8f\91\82«\8d\9e\82Ý\8f\88\97\9d
+sub writeDat {
+ # \83\82\81[\83h\91I\91ð
+ local($mode) = $_[0];
+ local($datfile) = $CONF{'datdir'}.'/'.$IN{'room'}.'.dat';
+ local($lockfile) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.lock';
+
+ # \96¼\91O\82Ì\93ü\97Í\82ª\82È\82¯\82ê\82Î\83G\83\89\81[
+ if ($IN{'name'} eq "") {
+ &error("\8cä\8bL\96¼\8aè\82¢\82Ü\82·\81B");
+ }
+ # \83g\83\8a\83b\83v\8f\88\97\9d
+ local($tripped) = &getTrip($IN{'name'});
+
+ $bye = 0; # \83O\83\8d\81[\83o\83\8b\95Ï\90\94
+ local($name, $email, $color)= ("", "", "");
+ # \93ü\8eº\83\82\81[\83h
+ if ($mode eq 'login') {
+ # \93ü\8eº\83\81\83b\83Z\81[\83W\90Ý\92è
+ $IN{'comment'} = "$tripped $CONF{'in_msg'}";
+ if ($CONF{'showip'}) {
+ $IN{'comment'} .= " <$client>";
+ }
+ $email = "";
+ $name = $CONF{'navi'};
+ $color = $CONF{'navicolor'};
+ }
+ # \91Þ\8eº\83\82\81[\83h
+ elsif ($mode eq 'logout') {
+ $IN{'comment'} = "$tripped $CONF{'out_msg'}";
+ $email = "";
+ $name = $CONF{'navi'};
+ $color = $CONF{'navicolor'};
+ $bye=1;
+ }
+ # \92Ê\8fí\83\82\81[\83h
+ else {
+ # \93ü\97Í\82ª\82È\82¢\8fê\8d\87\82Í\82»\82Ì\82Ü\82Ü\95Ô\82é
+ if ($IN{'comment'} eq "") { return; }
+
+ if ($IN{'email'} eq "") {
+ $name = "<B>$CONF{'pointer'}</B>";
+ }
+ else {
+ $name = "<B><a href=\"mailto:$IN{'email'}\">";
+ $name .= "$CONF{'pointer'}</a></B>";
+ }
+ $name .= " $tripped ";
+ $email = $IN{'email'};
+ $color = $IN{'color'};
+ }
+
+ # \83\8d\83O\83t\83@\83C\83\8b\82Ì\83\8d\83b\83N\8aJ\8en
+ if ($CONF{'lockmode'}) { &lock($lockfile); }
+
+ # \83\8d\83O\83t\83@\83C\83\8b\82ð\8aJ\82¢\82Ä\83f\81[\83^\93Ç\82Ý\8d\9e\82Ý (\94z\97ñ\8dÅ\91å\92l\82É\92\8d\88Ó)
+ open(DAT, "<$datfile") || &error("Open Error : datfile : $datfile");
+ local(@lines) = <DAT>;
+ close(DAT);
+
+ # \94\8c¾\8f\9c\8b\8e\8f\88\97\9d (\83I\83v\83V\83\87\83\93)
+ # \8f\9c\8b\8e\83R\83}\83\93\83h\82ð\93ü\97Í\82·\82é\82±\82Æ\82Å\8e©\95ª\82Ì\8bL\8e\96\82ð\8dí\8f\9c
+ if ($CONF{'clearlog'} && $IN{'comment'} eq $CONF{'clearcom'}) {
+ @lines = &clear($client, @lines);
+ }
+
+ # \8dÅ\91å\8bL\8e\96\90\94\82Ü\82Å\8dí\82é
+ while ($CONF{'max'} <= @lines) {
+ pop(@lines);
+ }
+
+ # \8e\9e\8aÔ\82ð\8eæ\93¾
+ local($date) = &getDate();
+
+ # RP\90Ø\82è\8fo\82µ\8b@\94\\82ªON\82È\82ç\82ÎRP\82Ì\82Ý\94²\82«\8fo\82µ
+ if ($CONF{'rplog'} == 1) {
+ &writeRPLog($date, $IN{'name'}, $IN{'comment'});
+ }
+
+ # \83\8d\83O\82ð\83t\83H\81[\83}\83b\83g\82µ\82Ä\8dX\90V
+ local($newline) = "$date<>$name<>$email<>";
+ $newline .= "$IN{'comment'}<>$color<>$client<>\n";
+ unshift (@lines, $newline);
+ open(DAT, ">$datfile") || &error("Write Error : datfile : $datfile");
+ print DAT @lines;
+ close(DAT);
+
+ # \83\8d\83b\83N\89ð\8f\9c
+ if ($CONF{'lockmode'}) { &unlock($lockfile); }
+}
+
+###
+# RP\90Ø\82è\8fo\82µ\8b@\94\
+sub writeRPLog {
+ local($date, $name, $comment) = @_;
+ # RP\95Û\91¶\83t\83@\83C\83\8b
+ local($txtfile) = $CONF{'rpdir'}.'/'.$IN{'room'}.'.txt';
+ local($lockfile) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.rplock';
+
+ if ($comment =~ /\81u.+\81v/) {
+ local($line) = "$name \81F$comment ($date)\n";
+ # \83\8d\83O\83t\83@\83C\83\8b\82Ì\83\8d\83b\83N\8aJ\8en
+ if ($CONF{'lockmode'}) { &lock($lockfile); }
+ open(TXT, ">>$txtfile") || &error("Write Error : txtfile : $txtfile");
+ print TXT $line;
+ close(TXT);
+ # \83\8d\83b\83N\89ð\8f\9c
+ if ($CONF{'lockmode'}) { &unlock($lockfile); }
+ }
+}
+
+###
+# RP\83N\83\8a\83A\8b@\94\\81i\83o\83b\83N\83A\83b\83v\8b@\94\\82Â\82«\81j
+sub clearRPLog {
+ local($date, $name, $comment) = @_;
+ # RP\95Û\91¶\83t\83@\83C\83\8b
+ local($txtfile) = $CONF{'rpdir'}.'/'.$IN{'room'}.'.txt';
+ local($lockfile) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.rplock';
+ # RP\83o\83b\83N\83A\83b\83v\90æ\83t\83@\83C\83\8b
+ local($bakfile) = $CONF{'rpdir'}.'/'.$IN{'room'}.'-bak.txt';
+
+ # \83\8d\83O\83t\83@\83C\83\8b\82Ì\83\8d\83b\83N\8aJ\8en
+ if ($CONF{'lockmode'}) { &lock($lockfile); }
+ open(TXT, "<$txtfile") || &error("Read Error : txtfile : $txtfile");
+ open(BAK, ">>$bakfile") || &error("Write Error : bakfile : $bakfile");
+ while(<TXT>) {
+ print BAK $_;
+ }
+ close(BAK);
+ close(TXT);
+ open(TXT, ">$txtfile") || &error("Write Error : txtfile : $txtfile");
+ print TXT "old log is in $bakfile\n\n";
+ close(TXT);
+ # \83\8d\83b\83N\89ð\8f\9c
+ if ($CONF{'lockmode'}) { &unlock($lockfile); }
+}
+
+###
+### HTML\90¶\90¬\8aÖ\8cW
+###
+
+###
+# \83w\83b\83_\81[\8fo\97Í\8f\88\97\9d (\8b¤\92Ê)
+sub printHeader {
+ local($extra) = $_[0];
+
+ print "Content-type: $CONF{'content-type'}\n";
+ # GZIP\88³\8fk\91Î\89\9e\83R\81[\83h (2006/02/10)
+ if (${'HTTP_ACCEPT_ENCODING'} =~ /gzip/ && $gzip ne '') {
+ if (${'HTTP_ACCEPT_ENCODING'} =~ /x-gzip/) {
+ print "Content-encoding: x-gzip\n";
+ } else {
+ print "Content-encoding: gzip\n";
+ }
+ open (STDOUT, "|$gzip -1 -c"); # \88³\8fk\82Í\8dÅ\91¬(-1)\82Å
+ }
+ # GZIP\88³\8fk\91Î\89\9e\81A\82±\82±\82Ü\82Å
+ print "\n"; # \83w\83b\83_\8fI\97¹
+ print <<"EOM";
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html lang="$CONF{'lang'}">
+<head>
+<meta http-equiv="Content-type" content="$CONF{'content-type'}" />
+<meta http-equiv="Content-Language" content="$CONF{'lang'}" />
+<meta name='robots' content='noindex, nofollow' />
+<script type='text/javascript' src='$CONF{'javascript'}'></script>
+<link rel="stylesheet" type="text/css" href="$CONF{'chatstyle'}">
+<title>$CONF{'title'}</title>
+$extra
+</head>
+EOM
+}
+
+##### \8aÖ\90\94\81F\83\8d\83O\83t\83@\83C\83\8b\82Ö\82Ì\88Ú\93®\95\\8e¦ #####
+sub printGoToLog {
+ &printHeader();
+
+ print $query->p("\82±\82Ì\83`\83\83\83b\83g\83\8b\81[\83\80\82Í\8aù\82É\8fI\97¹\82µ\82Ä\82¢\82Ü\82·");
+ print $query->p("<a href=\"$CONF{'logdir'}/$IN{'room'}.html\" target=\"_top\">[ \83\8d\83O\82ð\8c©\82é ]</a>");
+
+ # \95\\8e¦\8fI\97¹
+ print $query->end_html;
+ exit(0);
+}
+
+###
+# \83t\83\8c\81[\83\80\8fo\97Í\8f\88\97\9d
+sub printFrame {
+ # \83N\83b\83L\81[\82É\83\8a\83\8d\81[\83h\8e\9e\8aÔ\81^\8ds\90\94\8ew\92è\82ª\82È\82¢\8fê\8d\87\82Í\8f\89\8aú\92l\82ð\91ã\93ü
+ if ($CK{'retime'} eq "") { $CK{'retime'} = $CONF{'retime'}; }
+ if ($CK{'line'} eq "") { $CK{'line'} = $CONF{'line'}; }
+
+ $formsrc = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=form&retime=$CK{'retime'}&line=$CK{'line'}";
+ $logsrc = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=view&retime=$CK{'retime'}&line=$CK{'line'}";
+
+ &printHeader();
+ print <<"EOM";
+<frameset rows="177,*" border=0>
+<frame name="form" src="$formsrc">
+<frame name="log" src="$logsrc">
+<noframes>
+<body>\83t\83\8c\81[\83\80\94ñ\91Î\89\9e\82Ì\83u\83\89\83E\83U\82Ì\95û\82Í\97\98\97p\82Å\82«\82Ü\82¹\82ñ</body>
+</noframes>
+</frameset>
+</html>
+EOM
+ exit(0);
+}
+
+###
+# \83v\83\8d\83_\83E\83\93\83\81\83j\83\85\81[\90¶\90¬
+sub genPullDown {
+ local($script) = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=view&retime=0";
+ local($pulldown) =<<"EOM";
+<b><a href="javaScript:pullDown()">
\83R
\83`
\83\89\82©
\82ç
\93ü
\8eº
\82¹
\82¸
\82É
\83\8d\83O
\82ª
\93Ç
\82ß
\82Ü
\82·</a></b> <div id="menu" style="position:absolute; visibility:hidden; background-color:#ffbdde; width:60px;">
+<a href="$script&line=500" target="_blank">\81@\82T\82O\82O</a><BR>
+<a href="$script&line=1000" target="_blank">\81@\82P\82O\82O\82O</a><BR>
+<a href="$script&line=1500" target="_blank">\81@\82P\82T\82O\82O</a><BR>
+<a href="$script&line=2000" target="_blank">\81@\82Q\82O\82O\82O</a><BR>
+</div>
+EOM
+ return $pulldown;
+}
+
+###
+# \8dX\90V\8e\9e\8aÔ\91I\91ð\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
+sub genReloadTimeSelection {
+ # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
+ if ($IN{'retime'} ne "") {
+ $CK{'retime'} = $IN{'retime'};
+ }
+ # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
+ if ($CK{'retime'} eq "") {
+ $CK{'retime'} = $CONF{'retime'};
+ }
+
+ local($reload) = "\8dX\90V <select name=retime>\n";
+ foreach (@reload) {
+ if ($CK{'retime'} == $_) {
+ $reload .= "<option value=\"$_\" selected>$_\95b\n";
+ } else {
+ $reload .= "<option value=\"$_\">$_\95b\n";
+ }
+ }
+ $reload .= "</select>\n";
+ return $reload;
+}
+
+###
+# \93ü\8eº\8fî\95ñ\93ü\97Í\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
+sub genLoginInput {
+ local($login) =<<"EOM";
+<b>NAME</b> <input type="text" name="name" size="25" value="$CK{'name'}"><br>
+<b>EMail</b> <input type="text" name="email" size="25" value="$CK{'email'}"><br>
+<input type="hidden" name="room" value="$IN{'room'}">
+EOM
+ return $login;
+}
+
+###
+# \83`\83\83\83b\83g\8fî\95ñ\93ü\97Í\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
+sub genChatInput {
+ # \83g\83\8a\83b\83v\96¼\82Ì\8f\88\97\9d
+ local($tripped) = &getTrip($IN{'name'});
+ local($chat) = << "EOM";
+<input type="hidden" name="mode" value="chat">
+<input type="hidden" name="room" value="$IN{'room'}">
+<input type="hidden" name="name" value="$IN{'name'}">
+<input type="hidden" name="email" value="$IN{'email'}">
+<b>NAME</b>\81F\81@<font color="$IN{'color'}">$tripped</font>
+<input type="submit" value="\94\8c¾\81^\83\8a\83\8d\81[\83h">
+<input type="reset" value="\83N\83\8a\83A"><br>
+<b>\94\8c¾</b>\81@\81F\81@<input type="text" size="85" name="comment"><br>
+EOM
+ return $chat;
+}
+
+###
+# \8ds\90\94\91I\91ð\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
+sub genLineNumSelection {
+ # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
+ if ($IN{'line'} ne "") {
+ $CK{'line'} = $IN{'line'};
+ }
+ # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
+ if ($CK{'line'} eq "") {
+ $CK{'line'} = $CONF{'line'};
+ }
+
+ local($lines) = "\8ds\90\94 <select name=line>\n";
+ foreach (@line) {
+ if ($CK{'line'} == $_) {
+ $lines .= "<option value=\"$_\" selected>$_\8ds\n";
+ } else {
+ $lines .= "<option value=\"$_\">$_\8ds\n";
+ }
+ }
+ $lines .= "</select><br>\n";
+ return $lines;
+}
+
+###
+# \95¶\8e\9a\90F\91I\91ð(\83\89\83W\83I\83{\83^\83\93)\82Ì\8fo\97Í\8f\88\97\9d
+sub genColorRadioBottun {
+ # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
+ if ($IN{'color'} ne "") {
+ $CK{'color'} = $IN{'color'};
+ }
+ # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
+ if ($CK{'color'} eq "") {
+ $CK{'color'} = $CONF{'color'};
+ }
+
+ local($colors) = "<B>\95¶\8e\9a\90F\91I\91ð</B><BR><BR>\n";
+
+ local($half) = int (@COLORS / 2); # \94¼\95ª\82É\8a\84\82é
+ local($i=0);
+ foreach (@COLORS) {
+ $i++;
+ if ($CK{'color'} eq $_) {
+ $colors .= "<input type=radio name=color value=\"$_\" checked>";
+ } else {
+ $colors .= "<input type=radio name=color value=\"$_\">";
+ }
+ $colors .= "<font color=\"$_\"><B>**</B></font>\n";
+ if ($i == $half) { $colors .= "<br>\n"; }
+ }
+ return $colors;
+}
+
+###
+# \95¶\8e\9a\90F\91I\91ð(\83Z\83\8c\83N\83g\83\81\83j\83\85\81[)\82Ì\8fo\97Í\8f\88\97\9d
+sub genColorSelection {
+ # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
+ if ($IN{'color'} ne "") {
+ $CK{'color'} = $IN{'color'};
+ }
+ # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
+ if ($CK{'color'} eq "") {
+ $CK{'color'} = $CONF{'color'};
+ }
+
+ local($colors) = "\95¶\8e\9a\90F <select name=color>\n";
+ for ($i = 0; $i < scalar(@COLORS); $i++) {
+ if ($IN{'color'} eq $COLORS[$i]) {
+ $colors .= "<option value=\"$COLORS[$i]\" selected>$IROIRO[$i]\n";
+ } else {
+ $colors .= "<option value=\"$COLORS[$i]\">$IROIRO[$i]\n";
+ }
+ }
+ $colors .= "</select>\n";
+}
+
+###
+# \8aç\95¶\8e\9a\91I\91ð\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
+sub genFaceSelection {
+ local ($face) = "\82©\82¨\95¶\8e\9a <select name=\"face\">";
+ $face .= "<option value=\"\">\82È\82µ\n";
+ foreach (@faces) {
+ $face .= "<option value=\"$_\">$_\n";
+ }
+ $face .= "</select>\n";
+ return $face;
+}
+
+###
+# \93ü\8eº\97p\83t\83H\81[\83\80\8fo\97Í
+sub printEntryForm {
+ # \83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[\82Ì\90¶\90¬
+ local($loglink) = '';
+ if ($CONF{'loglink'} == 1) {
+ $loglink = &genLogLinkString($IN{'room'});
+ } elsif ($CONF{'loglink'} == 2) {
+ $loglink = &genPullDown();
+ }
+
+ local($login) = &genLoginInput();
+ local($reload) = &genReloadTimeSelection();
+ local($lines) = &genLineNumSelection();
+ local($colors) = &genColorRadioBottun();
+
+ # \83w\83b\83_\81[\82ð\8fo\97Í
+ &printHeader();
+ local($kazari) = "<font color=\"#DB5673\">\81\96\81\96\81\96</font>";
+ print <<"EOM";
+<body>
+<form method="$CONF{'method'}" action="$CONF{'chatcgi'}"
+ target="form" name="entry">
+<input type=hidden name=mode value="login">
+[<a href="$CONF{'indexurl'}" target="_top">BACK</a>]
+ $CONF{'topdesc'} $loglink <br><br>
+<h1>$kazari $CONF{'title'} $kazari</h1>
+<hr>
+<table border="0" cellspacing="0" cellpadding="0" height="100">
+<tr align="right">
+<td>$login $reload $lines</td>
+<td width="100" align="center"><br>
+<input type="submit" value="\93ü\8eº"></td>
+<td align=center valign=top nowrap><br>
+$colors
+</td></tr></table></form>
+<SCRIPT LANGUAGE="JavaScript">
+<!--
+self.document.entry.name.focus();
+//-->
+</SCRIPT>
+</body></html>
+EOM
+ exit(0);
+}
+
+### \8aÖ\90\94\81F\8cy\97Ê\83V\83\93\83v\83\8b\94Å\83\8d\83O\83C\83\93\89æ\96Ê ###
+sub printEntryFormAndDat {
+ local($login) = &genLoginInput();
+ local($colors) = &genColorSelection();
+
+ # \83w\83b\83_\81[\82ð\8fo\97Í
+ &printHeader();
+
+ print <<"EOM";
+<body>
+<form method="$CONF{'method'}" action="$CONF{'chatcgi'}"
+ target="_top" name="entry">
+<input type="hidden" name="mode" value="login">
+<input type="hidden" name="weight" value="light">
+<input type="hidden" name="line" value="20">
+<input type="hidden" name="retime" value="0">
+[<a href="$CONF{'indexurl'}" target="_top">\96ß\82é</a>]
+[<a href="$CONF{'chatcgi'}?room=$IN{'room'}&weight=light&line=$CONF{'lightline'}">\83\8a\83\8d\81[\83h</a>]
+<h1>$CONF{'title'}</h1>
+<hr>
+$login
+$colors
+<input type="submit" name="login" value="\93ü\8eº">
+<hr>
+EOM
+
+ print &genMember();
+ local($datfile) = $CONF{'datdir'}."/".$IN{'room'}.".dat";
+ print &formatDat($datfile, $CONF{'lightline'}, 'light', $IN{'reverse'});
+
+ print $query->hr;
+
+ print &genCopyright();
+ print $query->end_html;
+ exit(0);
+}
+
+### \8aÖ\90\94\81F\8cy\97Ê\83V\83\93\83v\83\8b\94Å\83`\83\83\83b\83g\89æ\96Ê ###
+sub printChatFormAndDat {
+ local($chat) = &genChatInput();;
+ local($colors) = &genColorSelection();
+
+ # \83\8d\83O\8f\91\82«\8d\9e\82Ý\8f\88\97\9d
+ &writeDat($IN{'mode'});
+
+ # \83N\83b\83L\81[\82Ì\90Ý\92è
+ local($ck) = "name<>$IN{'name'}";
+ $ck .= "<>email<>$IN{'email'}";
+ $ck .= "<>color<>$IN{'color'}";
+ $ck .= "<>retime<>$IN{'retime'}";
+ $ck .= "<>line<>$IN{'line'}";
+ &setCookie($CONF{'cookiekey'}, $ck, $CONF{'expire'});
+
+ # \83w\83b\83_\81[\82ð\8fo\97Í
+ &printHeader();
+
+ print <<"EOM";
+<body>
+<br>
+<h1>$CONF{'title'}</h1>
+<hr>
+<form method="$CONF{'method'}" action="$CONF{'chatcgi'}"
+ target="_top" name="chat">
+<input type="hidden" name="line" value="$CONF{'lightline'}">
+<input type="hidden" name="weight" value="light">
+<input type="hidden" name="retime" value="0">
+$chat
+$colors
+</form>
+
+<form action="$CONF{'chatcgi'}" method="$CONF{'method'}" target="_top"
+ name="logout">
+<input type="submit" name="logout" value="\91Þ\8eº">
+<input type="hidden" name="mode" value="logout">
+<input type="hidden" name="name" value="$IN{'name'}">
+<input type="hidden" name="room" value="$IN{'room'}">
+<input type="hidden" name="weight" value="light">
+</form>
+<hr>
+EOM
+
+ print &genMember();
+ local($datfile) = $CONF{'datdir'}."/".$IN{'room'}.".dat";
+ print &formatDat($datfile, $IN{'line'}, 'light', $IN{'reverse'});
+
+ print $query->hr;
+ print &genCopyright();
+ print $query->end_html;
+ exit(0);
+}
+
+###
+# \94\8c¾\83t\83H\81[\83\80\8fo\97Í
+sub printChatForm {
+ # \83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[\82Ì\90¶\90¬
+ local($loglink) = '';
+ if ($CONF{'loglink'} == 1) {
+ $loglink = &genLogLinkString($IN{'room'});
+ } elsif ($CONF{'loglink'} == 2) {
+ $loglink = &genPullDown();
+ }
+
+ local($chat) = &genChatInput();
+ local($face) = &genFaceSelection();
+ local($colors) = &genColorSelection();
+ local($lines) = &genLineNumSelection();
+ local($reload) = &genReloadTimeSelection();
+
+ # \83\89\83\93\83L\83\93\83O\82Ì\90¶\90¬
+ if ($CONF{'ranking'}) {
+ local($ranking) = &genRanking();
+ }
+
+ # \83\8d\83O\8f\91\82«\8d\9e\82Ý\8f\88\97\9d
+ &writeDat('login');
+
+ # \83N\83b\83L\81[\82Ì\90Ý\92è
+ local($ck) = "name<>$IN{'name'}";
+ $ck .= "<>email<>$IN{'email'}";
+ $ck .= "<>color<>$IN{'color'}";
+ $ck .= "<>retime<>$IN{'retime'}";
+ $ck .= "<>line<>$IN{'line'}";
+ &setCookie($CONF{'cookiekey'}, $ck, $CONF{'expire'});
+
+ # \83w\83b\83_\8fo\97Í
+ &printHeader();
+ print <<"EOM";
+<body>
+<form name="send" method="$CONF{'method'}" action="$CONF{'chatcgi'}"
+ target="log" onSubmit="setTimeout("autoclear()",10)">
+<table border=0><tr><td colspan=3>
+<b><font color="#DB5673" size="2">\81\96\81\96\81\96</font>
+$CONF{'title'}
+<font color="#DB5673" size="2">\81\96\81\96\81\96</font></b>\81@
+<br> $CONF{'chatalart'} $loglink
+<br><br>$chat
+</td></tr>
+<tr><td>$face $colors $reload $lines</td></form>
+<td valign="top">
+<form action="$CONF{'chatcgi'}" method="$CONF{'method'}" target="form">
+<input type="submit" value="\91Þ\8eº\90é\8c¾">
+<input type="hidden" name="mode" value="logout">
+<input type="hidden" name="name" value="$IN{'name'}">
+<input type="hidden" name="room" value="$IN{'room'}">
+</td></form>
+<td>
+<form name="cmode">
+<input type="checkbox" name="autoclear" checked>
+\94\8c¾\8e©\93®\8fÁ\8b\8e</td></form></tr></table><br>
+[<a href="$CONF{'adminscript'}?mode=enter&retime=$IN{'retime'}&line=$IN{'line'}" target="log">\8aÇ\97\9d\97p</a>]
+$ranking
+</body></html>
+EOM
+ exit(0);
+}
+
+###
+# \8dÝ\8eº\8eÒ\8f\88\97\9d
+sub genMember {
+ local($mode) = $_[0];
+ local($memfile) = $CONF{'memdir'}.'/'.$IN{'room'}.'.dat';
+ local($memlock) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.memlock';
+
+ # \83\8d\83b\83N\82ð\82©\82¯\82é
+ if ($CONF{'lockmode'}) { &lock($memlock); }
+
+ # \83\81\83\93\83o\81[\88ê\97\97\8eæ\93¾
+ open(MEM, "<$memfile")
+ || &error("Open Error : memfile : $memfile");
+ local(@line) = <MEM>;
+ close(MEM);
+
+ # \95Ï\90\94\8f\89\8aú\89»
+ local(@new) = ();
+ local($member, $update, $even) = ("", 0, 0);
+ local($time0, $name0, $client0) = (0, '', '');
+ # \83g\83\8a\83b\83v\82Ì\8f\88\97\9d
+ local($tripped) = &getTrip($IN{'name'});
+ # \8c»\8dÝ\8e\9e\8d\8f\82ð\8eæ\93¾
+ local($nowtime) = time;
+ foreach (@line) {
+ ($time0, $name0, $client0) = split(/<>/);
+
+ # \88ê\92è\8e\9e\8aÔ\88È\8fã\94\8c¾\82Ì\82È\82¢\8eÒ\82Í\8dí\8f\9c
+ if ($nowtime - $CONF{'memexp'} > $time0) { next; }
+
+ # \83N\83\89\83C\83A\83\93\83gIP\82ª\93¯\88ê\82©\82Â\96¼\91O\82ª\88ê\8f\8f\82Å\82 \82ê\82Î\8dX\90V\8f\88\97\9d\82ð\82·\82é
+ elsif ($client0 eq $client && $name0 eq $tripped) {
+ # \91Þ\8eº\8eÒ\82Í\8dí\8f\9c
+ if ($mode eq 'logout') { next; }
+
+ # \8e\9e\8aÔ\82Æ\96¼\91O\82ð\8dX\90V\82µ\82Ä\92Ç\89Á
+ push (@new, "$nowtime<>$tripped<>$client<>\n");
+ $name0 = $tripped;
+ $update=1;
+ }
+ # \82»\82ê\88È\8aO\82Í\96â\93\9a\96³\97p\82Å\8dX\90V\97p\94z\97ñ @new \82É\92Ç\89Á
+ else { push(@new, $_); }
+
+ # \8eQ\89Á\8eÒ\95\\8e¦\97p\95¶\8e\9a\97ñ\82ð\8dì\90¬ (\8bô\90\94\8aï\90\94\82Å\83}\81[\83N\95Ï\8dX)
+ if (!$even) {
+ $member .= "$name0\81\9a"; $even=1;
+ }
+ else {
+ $member .= "$name0\81\99"; $even=0;
+ }
+ }
+
+ # \8dX\90V\8f\88\97\9d\88È\8aO\82Å\83\8d\83O\83A\83E\83g\82à\82µ\82Ä\82¢\82È\82¢\82È\82ç\82Î\90V\8bK\8eQ\89Á\8eÒ\82ð\92Ç\89Á
+ if (!$update && !$bye) {
+ if ($IN{'name'} ne $client) {
+ push(@new, "$nowtime<>$tripped<>$client<>\n");
+ if (!$even) {
+ $member .= "$tripped\81\9a";
+ }
+ else {
+ $member .= "$tripped\81\99";
+ }
+ }
+ }
+
+ # \83t\83@\83C\83\8b\82ð\8dX\90V\82·\82é
+ if ($IN{'mode'} || $IN{'retime'}) {
+ open(MEM,">$memfile")
+ || &error("Write Error : memfile : $memfile");
+ print MEM @new;
+ close(MEM);
+ }
+
+ # \83\8d\83b\83N\89ð\8f\9c
+ if ($CONF{'lockmode'}) { &unlock($memlock); }
+
+ # \8eQ\89Á\8eÒ\90\94\82ð\94F\8e¯
+ local($num) = 0;
+ $num = @new;
+ return "\8eQ\89Á\8eÒ($num)\81F".$member;
+}
+
+###
+# \91Þ\8eº\8f\88\97\9d
+sub printLogout {
+ &writeDat('logout');
+ local($member) = &genMember('logout');
+ local($tripped) = &getTrip($IN{'name'});
+ &printHeader();
+ print <<"EOM";
+<body>
+<center><BR><BR><h3>\82¨\94æ\82ê\97l\82Å\82µ\82½\81A$tripped \82³\82ñ\81B\82Ü\82½\82¨\89ï\82¢\82µ\82Ü\82µ\82å\82¤\81B</h3>
+<form action="$CONF{'indexurl'}" target="_top">
+<input type=submit value="\97£\92E"></form></center>
+</body></html>
+EOM
+ exit(0);
+}
+
+###
+# \83\8d\83O\95\\8e¦
+sub viewDat {
+ # \83\8a\83\8d\81[\83h\83w\83b\83_
+ local($extra) = '';
+ if ($IN{'retime'} != 0) {
+ local($ename) = &url_enc($IN{'name'});
+ local($script) = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=view&retime=$IN{'retime'}&line=$IN{'line'}&name=$ename";
+ $extra = "<meta http-equiv=\"refresh\"";
+ $extra .= " content=\"$IN{'retime'}; URL=$script\">\n";
+ }
+ &printHeader($extra);
+
+ ## \8eQ\89Á\8eÒ\95\\8e¦
+ local($member) = &genMember();
+ print "<body>\n";
+ print "<hr>";
+ print "<table width='100%'><tr><td>$member</td>\n";
+ print "<td align=right>\83\8a\83\8d\81[\83h\81F ";
+ if ($IN{'retime'} == 0) {
+ print "\8eè\93®\83\82\81[\83h";
+ } else { print "$IN{'retime'}\95b"; }
+ print " \8ds\90\94: $IN{'line'}\8ds</td></tr></table>\n";
+
+ local($datfile) = $CONF{'datdir'}."/".$IN{'room'}.".dat";
+ print &formatDat($datfile, $IN{'line'}, 'normal', $IN{'reverse'});
+
+ print $query->hr . "\n";
+
+ # \92\98\8dì\8c \82ð\95\\8e¦\81i\8dí\8f\9c\8bÖ\8e~\81j
+ print &genCopyright();
+ print $query->end_html . "\n";
+ exit(0);
+}
+
+# End of kenranlib
+1;
--- /dev/null
+/* \83\8a\83\93\83N */
+a { text-decoration:none; }
+a:hover { color:#FFCED9; }
+a:link { color:#EF8F9C; }
+a:alink { color:#ef7585; }
+a:vlink { color:#DB5673; }
+
+/* \96{\95¶ */
+body {
+ font-size: 13px;
+ background-color: #FFFFFF;
+ color: #565656;
+
+ scrollbar-face-color: #FFFFFF;
+ scrollbar-track-color: #FFFFFF;
+ scrollbar-arrow-color: #EF8F9C;
+ scrollbar-highlight-color: #FFFFFF;
+ scrollbar-shadow-color: #EF8F9C;
+ scrollbar-3dlight-color: #EF8F9C;
+ scrollbar-darkshadow-color: #FFFFFF;
+}
+
+/* \8c©\8fo\82µ */
+h1 {
+ font-size: 16px;
+ color: #222222;
+ text-align: center;
+ font-style: bold;
+}
+
+/* \8bæ\90Ø\82è\90ü */
+hr {
+ color: #EF8F9C;
+ background-color: #EF8F9C;
+ height: 1px; /* \90ü\82Ì\91¾\82³ */
+ border: 0px; /* \98g\82Ì\91¾\82³ */
+}
+
+/* \83e\81[\83u\83\8b */
+tr,td,th { font-size:13px; }
+
+/* \83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[ */
+menu {
+}
--- /dev/null
+// \83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[
+hideflag = true;
+function pullDown() {
+ if (hideflag) menu.style.visibility = "hidden";
+ else menu.style.visibility = "visible";
+ hideflag = !hideflag;
+}
+
+// \88È\89º\82ÌJavaScript\81i\94\8c¾\83R\83\81\83\93\83g\82Ì\8e©\93®\8fÁ\8b\8e\8b@\94\\81j\82Í
+// \82ä\82¢\82¿\82á\82Á\82Æ (http://www.cup.com/yui/) \82©\82ç\82Ì\88Ú\90A\81B
+function autoclear() {
+ if (self.document.send) {
+ if (self.document.cmode && self.document.cmode.autoclear) {
+ if (self.document.cmode.autoclear.checked) {
+ if (self.document.send.face) {
+ self.document.send.face.options[0].selected = true;
+ }
+ if (self.document.send.comment) {
+ self.document.send.comment.value = "";
+ self.document.send.comment.focus();
+ }
+ }
+ }
+ }
+}
--- /dev/null
+This folder contains lock file. Please don't delete this folder.
--- /dev/null
+This folder contains log file. Please don't delete this folder.
--- /dev/null
+This folder contains member file. Please don't delete this folder.
--- /dev/null
+This folder contains RP text file. Please don't delete this folder.
--- /dev/null
+body {
+ background-color: #F7F7FF;
+ font-size: 14px;
+ color: #606060;
+ letter-spacing:2px;
+}
+
+a {
+ color: #606060;
+ text-decoration: none;
+}
+
+a:hover {
+ text-decoration: underline;
+}
+
+img {
+ border:0px;
+}
+
+h1 {
+ background-color: #D0D8E6;
+ font-size: 20px;
+ padding: 4px;
+ border: 1px solid #C0C8D6;
+}
+h2 {
+ font-size: 16px;
+ font-weight: normal;
+ margin-left: 2em;
+ padding-left: 5px;
+ border-left: 3px solid #C0C8D6;
+ border-bottom:1px solid #C0C8D6;
+}
+
+table {
+ border: 1px solid #C0C8D6;
+}
+
+th {
+ background-color: #D0D8E6;
+}
+
+td {
+ border: 1px solid #C0C8D6;
+}
+
+span {
+ width: 90px;
+}
+
+form {
+ margin: 3px 0px 3px 0px;
+}
+
+table.sample {
+ border: 1px solid #C0C8D6;
+}
+
+td.sample {
+ border: 1px solid #C0C8D6;
+}
+
+.main{
+ margin: 0px 30px 30px 30px;
+}
+
+.sub {
+ margin-left: 6em;
+ letter-spacing: 1px;
+}
+
+.footer {
+ font-size: 12px;
+ letter-spacing: 1px;
+ text-align: right;
+}
+
+.menu{
+ display:inline;
+}
\ No newline at end of file
--- /dev/null
+###
+### Yet Anather Dice Chat: Library
+### $Id: yadchatlib.pl,v 1.6 2007/06/07 12:20:57 jyugoya Exp $
+### YADChat / 2007 © \8c\8b\8fé\97R\97\85\81\97\90¢\8aE\94E\8eÒ\8d\91 / BSD Lisence
+###
+
+### \95Û\97¯\92\86\95Ï\90\94 ###
+$rep_color = "000000";
+
+##### \8aÖ\90\94\81F\83G\83\89\81[\95\\8e¦ (\8b¤\92Ê) #####
+sub error {
+ local($errmsg) = $_[0];
+ local($lockfile) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.lock';
+ local($memlock) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.memlock';
+ local($rplock) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.rplock';
+
+ # \83\8d\83b\83N\83t\83@\83C\83\8b\82Ì\89ð\8f\9c
+ if ($CONF{'lockmode'}) {
+ &unlock($lockfile);
+ &unlock($memlock);
+ &unlock($rplock);
+ }
+
+ &printHeader();
+ print << "EOM";
+<body>
+<center><h3>ERROR !</h3>
+<font color='red'>$errmsg</font></center>
+</body></html>
+EOM
+ exit(0);
+}
+
+##### \8aÖ\90\94\81F\83G\83\89\81[\95\\8e¦ (&error()\82Æ\8fd\95¡) #####
+sub printError {
+ &printHeader();
+
+ print $query->h1($CONF{'title'});
+ print $query->p("ERORR: " . $_[0]);
+
+ if ($DEBUG) {
+ foreach $key (keys %IN) {
+ print $query->p($key . ": " . $IN{$key});
+ }
+ }
+ print $query->p("<a href=\"$CONF{'indexcgi'}\" target=\"_top\">[ \88ê\97\97\82Ö\96ß\82é ]</a>");
+
+ # \95\\8e¦\8fI\97¹
+ print $query->end_html;
+ exit(0);
+}
+
+##### \8aÖ\90\94\81F\83f\83o\83b\83O\95\\8e¦ #####
+sub printDebug {
+ print $query->h2("\83f\83o\83b\83O\8fî\95ñ");
+ print "<div class=\"main\">";
+ print $query->p($errmsg);
+ print "Input: ";
+ foreach $key (keys %IN) {
+ print $key . " = " . $IN{$key} . ", ";
+ }
+ print "<br/>Config: ";
+ foreach $key (keys %CONF) {
+ print $key . " = " . $CONF{$key} . ", ";
+ }
+ print "</div>";
+}
+
+##### \8aÖ\90\94\81F\92\8d\88Ó\8e\96\8d\80\95\\8e¦ #####
+sub printNotice {
+ print $query->h2("\92\8d\88Ó\8e\96\8d\80");
+ print<<EOM;
+<ul class="sub">
+<li>\83`\83\83\83b\83g\83\8b\81[\83\80\8dì\90¬\83v\83\8d\83O\83\89\83\80\82Å\82·\81B</li>
+<li>\83`\83\83\83b\83g\83\8b\81[\83\80\82Ì\8dì\90¬\82Í\92N\82Å\82à\82Å\82«\82Ü\82·\81B</li>
+<li>\83`\83\83\83b\83g\83\8b\81[\83\80\82Ì\8fI\97¹\82Í\8dì\90¬\8eÒ\82Æ\8aÇ\97\9d\8eÒ\82µ\82©\82Å\82«\82Ü\82¹\82ñ\81B</li>
+<li>\83`\83\83\83b\83g\83\8b\81[\83\80\82Ì\8dí\8f\9c\82Í\8aÇ\97\9d\8eÒ\82µ\82©\82Å\82«\82Ü\82¹\82ñ\81B</li>
+<li>\82½\82\82³\82ñ\82Ì\83`\83\83\83b\83g\83\8b\81[\83\80\82ð\93¯\8e\9e\97\98\97p\82·\82é\82Æ\95\89\89×\82ª\82©\82©\82è\82Ü\82·\82Ì\82Å\97Ç\8e¯\82Ì\94Í\88Í\82Å\82²\97\98\97p\82\82¾\82³\82¢\81B</li>
+<li>mihana\82³\82ñ\82Ì\83v\83\8d\83O\83\89\83\80\82ð\83\82\83f\83\8b\82É\83X\83N\83\89\83b\83`\82µ\81ABSD\83\89\83C\83Z\83\93\83X\89»\82µ\82Ä\82Ü\82·\81B</li>
+<li>\83`\83\83\83b\83g\83\8b\81[\83\80\82Í\8d\8b\89Ø\88ºà£\83`\83\83\83b\83g\81icomchat\8cÝ\8a·\95i\81j\82ð\95Ï\8dX\82µ\82½\82à\82Ì\82Å\82·\81B\92·\95¶\83\82\81[\83h\82Í\82 \82è\82Ü\82¹\82ñ\81B\83_\83C\83X\82Í2d6\82Ì\82æ\82¤\82É\93ü\97Í\82·\82é\82Æ\92u\82«\8a·\82í\82è\82Ü\82·\81B</li>
+</ul>
+EOM
+}
+
+##### \8aÖ\90\94\81F\95\94\89®\88ê\97\97\95\\8e¦ #####
+sub printRoomList {
+ print<<HEADER;
+<H2>\83`\83\83\83b\83g\83\8b\81[\83\80\88ê\97\97</H2>
+
+<table class="sub">
+<tr>
+<th align="center">\83\8b\81[\83\80\96¼</TD>
+<th align="center">\8ae\8eí\89{\97\97</TD>
+<th align="center">\83R\83\81\83\93\83g</TD>
+</tr>
+HEADER
+
+ # \88ê\97\97\95\\8e¦
+ local(@index) = &readIndex();
+ foreach $room (@index){
+ local($idx, $name, $comment, $state, $pass) = split(/<>/, $room, 5);
+ if ($state){
+ local($loglink) = &genLogLinkString($idx);
+ print <<ROW;
+<tr>
+<td align="left"><a href="$CONF{'chatcgi'}?room=$idx">$idx $name</a></td>
+<td align="left">
+[<a href="$CONF{'chatcgi'}?room=$idx&weight=light">\8cg\91Ñ\93ü\8cû</a>]
+$loglink
+</td><td align="left">$comment</td>
+</tr>
+ROW
+ }
+ }
+
+ print $query->end_table;
+
+ # \83\81\83j\83\85\81[\95\\8e¦
+ print<<MENU;
+<p class="sub">
+<a href="$CONF{'indexcgi'}?mode=make">\90V\8bK\83`\83\83\83b\83g\83\8b\81[\83\80\8dì\90¬</a>
+ | <a href="$CONF{'indexcgi'}?mode=log">\83\8d\83O\83t\83@\83C\83\8b\88ê\97\97</a>
+ | <a href="$CONF{'indexcgi'}?mode=admin">\8aÇ\97\9d\83\81\83j\83\85\81[</a>
+</p>
+MENU
+}
+
+##### \8aÖ\90\94\81F\95\94\89®\8dì\90¬\89æ\96Ê\95\\8e¦ #####
+sub printMakeRoom {
+ print $query->h2("\83`\83\83\83b\83g\83\8b\81[\83\80\8dì\90¬");
+ print<<EOM;
+<div class="main">
+<form action="$CONF{'indexcgi'}" method="post" class="main">
+<table>
+<tr><td>\83\8b\81[\83\80\96¼</td><td><input type="text" name="name" size="40"></td></tr>
+<tr><td>\83R\83\81\83\93\83g</td><td><input type="text" name="comment" size="40"></td></tr>
+<tr><td>\83p\83X\83\8f\81[\83h</td><td><input type="password" name="pass" size="8"></td></tr>
+<tr><td></td><td><input type="submit" name="make" value="\83`\83\83\83b\83g\83\8b\81[\83\80\82ð\8dì\90¬\82·\82é"></td></tr>
+</table>
+</form>
+</div>
+EOM
+}
+
+##### \8aÖ\90\94\81F\83\8d\83O\83t\83@\83C\83\8b\88ê\97\97\95\\8e¦ #####
+sub printLogList {
+ print $query->h2("\83\8d\83O\83t\83@\83C\83\8b\88ê\97\97");
+ print<<HEAD;
+<table class="sub">
+<tr>
+<th align="center">\83\8b\81[\83\80\96¼</TD>
+<th align="center">\83R\83\81\83\93\83g</TD>
+</TR>
+HEAD
+ # \88ê\97\97\95\\8e¦
+ local(@index) = &readIndex();
+ shift(@index);
+ foreach $room (@index){
+ local($idx, $name, $comment, $state, $pass) = split(/<>/, $room, 5);
+ if (!$state){
+ print<<ROW;
+<tr>
+<td align="left"><a href="$CONF{'logdir'}/$idx.html">$idx $name</a></td>
+<td align="left">$comment</td>
+</tr>
+ROW
+ }
+ }
+ print $query->end_table;
+}
+
+##### \8aÖ\90\94\81F\8aÇ\97\9d\83\81\83j\83\85\81[\95\\8e¦ #####
+sub printAdminMenu {
+ &printClose();
+ &printDelete();
+}
+
+##### \8aÖ\90\94\81F\8fI\97¹\83\81\83j\83\85\81[\95\\8e¦ #####
+sub printClose {
+ print $query->h2("\83`\83\83\83b\83g\83\8b\81[\83\80\82Ì\8fI\97¹");
+ print<<HEAD;
+<div class="main">
+<form action="$CONF{'indexcgi'}" method="post" class="main">
+<table>
+<tr>
+<td>\83`\83\83\83b\83g\83\8b\81[\83\80\91I\91ð</td>
+<td><select name="close">
+HEAD
+ # \83\8a\83X\83g\95\\8e¦
+ local(@index) = &readIndex();
+ shift(@index);
+ foreach $room (@index){
+ local($idx, $name, $comment, $state, $pass) = split(/<>/, $room, 5);
+ if ($state){
+ print <<OPTION;
+<option value="$idx">$idx $name</option>
+OPTION
+ }
+ }
+ print <<FOOT;
+</select></td>
+</tr>
+<tr>
+<td>\83p\83X\83\8f\81[\83h</td>
+<td><input type="password" name="pass" size="15"></td>
+</tr>
+<tr><td></td><td><input type="submit" name="admin" value="\8fI\97¹"></td></tr>
+</table>
+</form>
+</div>
+FOOT
+}
+
+##### \8aÖ\90\94\81F\8dí\8f\9c\83\81\83j\83\85\81[\95\\8e¦ #####
+sub printDelete {
+ print $query->h2("\83`\83\83\83b\83g\83\8b\81[\83\80\82Ì\8dí\8f\9c");
+ print <<HEAD;
+<div class="main">
+<form action="$CONF{'indexcgi'}" method="post" class="main">
+<table>
+<tr>
+<td>\83Q\81[\83\80\91I\91ð</td>
+<td><select name="del">
+HEAD
+
+ # \88ê\97\97\8dì\90¬
+ local(@index) = &readIndex();
+ shift(@index);
+ foreach $room (@index){
+ local($idx, $name, $comment, $state, $pass) = split(/<>/, $room, 5);
+ print <<ROW;
+<option value="$idx">$idx $name</option>
+ROW
+ }
+
+print <<FOOT;
+</select>
+</td></tr>
+<tr><td>\83p\83X\83\8f\81[\83h</td>
+<td><input type="password" name="pass" size="15"></td>
+</tr><tr><td></td><td><input type="submit" name="admin" value="\8dí\8f\9c"></td></tr>
+</table>
+</form>
+</div>
+FOOT
+}
+
+##### \8aÖ\90\94\81F\92\98\8dì\8c \95¶\8e\9a\97ñ\90¶\90¬ #####
+sub genCopyright() {
+ local($copyRight)=<<EOM;
+<p class="footer">
+YADChat / 2007 © \8c\8b\8fé\97R\97\85\81\97\90¢\8aE\94E\8eÒ\8d\91 / BSD Lisence
+</p>
+EOM
+ return $copyRight;
+}
+
+##### \8aÖ\90\94\81F\83\8d\83b\83N\8f\88\97\9d #####
+sub lock {
+ local($lockfile) = $_[0]; # \83\8d\83b\83N\83t\83@\83C\83\8b\82Í\88ø\90\94\82Å\8ew\92è
+ local($lockmode) = $CONF{'lockmode'};
+ local($retry) = $CONF{'retry'};
+ local($timeout) = $CONF{'timeout'};
+ local($errmsg) = "Lock ($lockfile) is busy";
+
+ # \88ê\92è\8e\9e\8aÔ\88È\8fã\8cÃ\82¢\83\8d\83b\83N\82Í\8dí\8f\9c\82·\82é
+ if (-e $lockfile) {
+ ($mtime) = (stat($lockfile))[9];
+ if ($mtime < time - $timeout) { &unlock($lockfile); }
+ }
+ # symlink\8aÖ\90\94\8e®\83\8d\83b\83N
+ if ($lockmode == 1) {
+ while (!symlink(".", $lockfile)) {
+ if (--$retry <= 0) { &error($errmsg); }
+ sleep(1);
+ }
+ # mkdir\8aÖ\90\94\8e®\83\8d\83b\83N
+ } elsif ($lockmode == 2) {
+ while (!mkdir($lockfile, 0755)) {
+ if (--$retry <= 0) { &error($errmsg); }
+ sleep(1);
+ }
+ }
+}
+
+##### \8aÖ\90\94\81F\83\8d\83b\83N\89ð\8f\9c #####
+sub unlock {
+ local($lockfile) = $_[0]; # \83\8d\83b\83N\83t\83@\83C\83\8b\82Í\88ø\90\94\82Å\8ew\92è
+ local($lockmode) = $CONF{'lockmode'};
+
+ # symlink\8c`\8e®
+ if ($lockmode == 1) {
+ unlink($lockfile);
+ }
+
+ # mkdir\95û\8e®
+ elsif ($lockmode == 2) {
+ rmdir($lockfile);
+ }
+
+ # flock\95û\8e®\81F\96¢\8eÀ\91\95
+ elsif ($lockmode == 3) {
+ }
+}
+
+##### \8aÖ\90\94\81F\83C\83\93\83f\83b\83N\83X\88ê\97\97\8eæ\93¾ #####
+sub readIndex {
+ open(INDEX, "<$CONF{'indexdat'}") || die "Can't open $CONF{'indexdat'}: $!";
+ flock(INDEX, LOCK_SH);
+ local (@list) = <INDEX>;
+ flock(INDEX, LOCK_NB);
+ close(INDEX);
+ @list;
+}
+
+##### \8aÖ\90\94\81F\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b\8dX\90V #####
+sub updateIndex {
+ local(@index) = @_;
+
+ open(INDEX, ">$CONF{'indexdat'}") || die "Can't open $CONF{'indexdat'}: $!";
+ flock(INDEX, LOCK_EX);
+ print INDEX @index;
+ flock(INDEX, LOCK_NB);
+ close(INDEX);
+}
+
+##### \8aÖ\90\94\81F\90V\8bK\95\94\89®\8dì\90¬ #####
+sub createNewRoom {
+ local($name, $comment) = @_;
+ local(@index) = &readIndex();
+
+ # \8dÅ\8fI\95\94\89®\94Ô\8d\86\82Ì\8eæ\93¾
+ local($roomidx) = shift(@index);
+ $roomidx++;
+
+ # \95\94\89®\83t\83@\83C\83\8b\82Ì\8dì\90¬
+ local($roomfile) = "$CONF{'datdir'}/$roomidx.dat";
+ open(NEW, ">$roomfile") || die "Can't open $roomfile: $!";
+ close(NEW);
+ chmod (0640, $roomfile);
+
+ # \83\81\83\93\83o\83t\83@\83C\83\8b\82Ì\8dì\90¬
+ local($memfile) = "$CONF{'memdir'}/$roomidx.dat";
+ open(NEW, ">$memfile") || die "Can't open $memfile: $!";
+ close(NEW);
+ chmod (0640, $memfile);
+
+ # \90V\8bK\95\94\89®\82Ì\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b\82Ö\82Ì\92Ç\89Á
+ $line = "$roomidx<>$name<>$comment<>1<>$IN{'pass'}\n";
+ unshift(@index, $line);
+
+ $roomidx .= "\n";
+ unshift(@index, $roomidx);
+
+ updateIndex(@index);
+}
+
+##### \8aÖ\90\94\81F\95\94\89®\8dí\8f\9c #####
+sub deleteRoom {
+ local($delidx) = @_;
+ local(@index) = &readIndex();
+
+ local($roomfile) = "$CONF{'datdir'}/$roomidx.dat";
+ local($memfile) = "$CONF{'memdir'}/$roomidx.dat";
+ local($logfile) = "$CONF{'logdir'}/$roomidx.html";
+
+ # \8dí\8f\9c
+ unlink($roomfile) if (-e $roomfile);
+ unlink($memfile) if (-e $memfile);
+ unlink($logfile) if (-e $logfile);
+
+ @index = grep(!/$delidx<>/, @index);
+ &updateIndex(@index);
+}
+
+##### \8aÖ\90\94\81F\95\94\89®\82ð\95Â\82¶\82é #####
+sub closeRoom {
+ local($pass, $close) = @_;
+ local(@index) = &readIndex();
+
+ foreach $line (@index){
+ if ($pass eq $CONF{'pass'}) {
+ # \8aÇ\97\9d\8eÒ\8c \8cÀ\82Å\82Ì\83N\83\8d\81[\83Y
+ if ($line =~ s/$close<>([^<>]+)<>([^<>]+)<>1<>(\S+)/$close<>$1<>$2<>0<>$3/) {
+ if ($DEBUG) {
+ print "using admin pass...\n";
+ }
+ &genLogfile($close, &getRoomTitle($close, $1));
+ &updateIndex(@index);
+ }
+ } else {
+ # \8dì\90¬\8eÒ\8c \8cÀ\82Å\82Ì\83N\83\8d\81[\83Y
+ if ($line =~ s/$close<>([^<>]+)<>([^<>]+)<>1<>$pass/$close<>$1<>$2<>0<>$pass/) {
+ if ($DEBUG) {
+ print "using creater's pass...\n";
+ }
+ &genLogfile($close, &getRoomTitle($close, $1));
+ &updateIndex(@index);
+ }
+ }
+ }
+}
+
+##### \8aÖ\90\94\81F\95\94\89®\83^\83C\83g\83\8b\82Ì\8eæ\93¾ #####
+sub getRoomTitle {
+ local($roomidx, $roomname) = @_;
+ if ($roomname eq "") {
+ local(@index) = &readIndex();
+ foreach $line (@index) {
+ if ($line =~ /$roomidx<>([^<>]+)<>([^<>]+)<>\d<>(\S+)/) {
+ $roomname = $1;
+ }
+ }
+ }
+ return "$CONF{'title'}\81F$roomidx $roomname";
+}
+
+##### \8aÖ\90\94\81F\83\8d\83O\89{\97\97\83\8a\83\93\83N\95¶\8e\9a\97ñ #####
+sub genLogLinkString {
+ local($room) = $_[0];
+ local($str) = "";
+ $str .= "[<a href=\"";
+ $str .= $CONF{'chatcgi'}."?room=$room&mode=view&retime=0&line=200";
+ $str .= "\" target=_blank>200\8ds\83\8d\83O</a>]";
+ $str .= " [<a href=\"";
+ $str .= $CONF{'chatcgi'}."?room=$room&mode=view&retime=0&line=500";
+ $str .= "\" target=_blank>500\8ds\83\8d\83O</a>]";
+ $str .= " [<a href=\"";
+ $str .= $CONF{'chatcgi'}."?room=$room&mode=view&retime=0&line=1000";
+ $str .= "\" target=_blank>1000\8ds\83\8d\83O</a>]";
+ if ($CONF{'rplog'}) {
+ $str .= " [<a href=\"";
+ $str .= "rp/$room.txt";
+ $str .= "\" target=_blank>RP\83\8d\83O</a>]";
+ }
+ return $str;
+}
+
+##### \8aÖ\90\94\81F\83f\81[\83^\82ð\8f\91\8e®\89» #####
+sub formatDat {
+ local($datfile) = $_[0];
+ local($lnum) = $_[1];
+ local($weight) = $_[2];
+ local($reverse) = $_[3];
+
+ # \83f\81[\83^\8eæ\93¾
+ open(DAT,"<$datfile")
+ || &printError("Open Error : datfile : $datfile: $!");
+ flock(DAT, LOCK_SH);
+ local(@lines) = <DAT>;
+ flock(DAT, LOCK_NB);
+ close(DAT);
+
+ # \94½\93]\82·\82é\8fê\8d\87\82Í\94½\93]
+ if ($reverse) {
+ @lines = reverse(@lines);
+ }
+
+ local($i, $ret) = (0, "");
+ foreach $line (@lines) {
+ #print "$i: $line\n";
+ $i++;
+ if ($lnum ne 'max' && $i > $lnum) { last; }
+ local($date,$name,$email,$comment,$color) = split(/<>/, $line);
+ $ret .= $query->hr;
+ if ($weight eq 'light') {
+ $ret .= "$name \81\84 $comment ";
+ $ret .= "($date)";
+ } else {
+ $ret .= "<font color=\"#$color\">$name \81\84 $comment</font> ";
+ $ret .= "<font color=\"#$rep_color\">($date)</font>";
+ }
+ $ret .= $query->br;
+ $ret .= "\n";
+ }
+
+ return $ret;
+}
+
+##### \8aÖ\90\94\81F\83\8d\83O\83t\83@\83C\83\8b\90¶\90¬ #####
+sub genLogfile {
+ local($close, $title) = @_;
+ local($datfile) = "$CONF{'datdir'}/$close.dat";
+ local($memfile) = "$CONF{'memdir'}/$close.dat";
+ local($logfile) = "$CONF{'logdir'}/$close.html";
+
+ if ($DEBUG) {
+ print "$datfile, $memfile, $logfile...\n";
+ }
+ # \83f\81[\83^\83t\83@\83C\83\8b\82ª\82È\82¢\8fê\8d\87\82Í\89½\82à\82¹\82¸\82É\96ß\82é
+ if (! -e $datfile) {
+ &printError("No such dat: $datfile");
+ return;
+ }
+
+ # \83\8d\83O\83t\83@\83C\83\8b\82É\8f\91\82«\8d\9e\82Ý\8aJ\8en
+ open(LOG, ">$logfile")
+ || &error("Can't open : logfile : $logfile: $!");
+ flock(LOG, LOCK_EX);
+
+ if ($DEBUG) {
+ print "writing $logfile...\n";
+ }
+ # \83w\83b\83_\95\94
+ print LOG $query->start_html(-lang => $CONF{'lang'},
+ -encoding => $CONF{'charset'},
+ -head => meta({-http_equiv => 'Content-Type',
+ -content => 'text/html'}),
+ -title=>$title,
+ -style=>{-src=>"../$CONF{'chatstyle'}"});
+
+ # \83^\83C\83g\83\8b
+ print LOG $query->h1($title);
+
+ if ($DEBUG) {
+ print "writing data...\n";
+ }
+ # \83f\81[\83^\95\94
+ print LOG &formatDat($datfile, 'max', 'normal', 'reverse');
+ if ($DEBUG) {
+ print "done...\n";
+ }
+
+ print LOG $query->hr ."\n";
+
+ # \83R\83s\81[\83\89\83C\83g\95\94
+ print LOG &genCopyright();
+
+ # HTML\8fI\82í\82è
+ print LOG $query->end_html;
+
+ if ($DEBUG) {
+ print "done...\n";
+ }
+ flock(LOG, LOCK_NB);
+ close (LOG);
+
+ if ($DEBUG) {
+ print "$delete files...\n";
+ }
+ # \83f\81[\83^\81\95\83\81\83\93\83o\83t\83@\83C\83\8b\8dí\8f\9c
+ unlink($datfile) if (-e $datfile);
+ unlink($memfile) if (-e $memfile);
+}
+
+### End of yadchatlib
+1;
OSDN Git Service
