kenranlib.pl

   1 ##### TADChat\94Å\8d\8b\89Ø\88ºà£\83`\83\83\83b\83g\83\89\83C\83u\83\89\83\8a
   2 ### Kenran Chat Lib / 2007 &copy; \8c\8b\8fé\97R\97\85\81\97\90¢\8aE\94E\8eÒ\8d\91 / BSD Lisence
   3 ### $Id: kenranlib.pl,v 1.7 2007/07/14 14:00:19 jyugoya Exp $
   4 ### \96{\91Ì\82©\82ç\95ª\97£\81Ayadchatlib.pl\82É\83}\81[\83W\92\86
   5
   6 # YADChat Lib \93Ç\82Ý\8d\9e\82Ý
   7 require './yadchatlib.pl';
   8
   9 # \95¶\8e\9a\83R\81[\83h\95Ï\8a·\83\89\83C\83u\83\89\83\8a\8eæ\8d\9e\82Ý
  10 require './jcode.pl';
  11
  12 ###
  13 ### \83\86\81[\83e\83B\83\8a\83e\83B
  14 ###
  15
  16 ##### \8aÖ\90\94\81F\93ú\95t\90¶\90¬ #####
  17 sub getDate {
  18     $ENV{'TZ'} = $CONF{'timezone'};
  19     local($times) = time;
  20     local($sec,$min,$hour,$mday,$mon) = localtime($times);
  21     return sprintf("%s/%s-%02d:%02d:%02d",$mon+1,$mday,$hour,$min,$sec);
  22 }
  23
  24 ##### \8aÖ\90\94\81F\83_\83C\83X #####
  25 sub dice {
  26     local($num, $type) = @_;
  27     srand;
  28     #"$num\8cÂ\82Ì$type\96Ê\91Ì";
  29     local($ret) = $num."d".$type.": ";
  30     for ($i=0; $i<$num; $i++) {
  31         $d = int(rand($type)) + 1;
  32         $sum += $d;
  33         $ret .= $d;
  34         if ($i < $num -1) { $ret .= " + " }
  35     }
  36     $ret .= " = $sum";
  37 }
  38
  39 ##### \8aÖ\90\94\81F\93ü\97Í\8f\88\97\9d #####
  40 sub checkInput {
  41     $IN{'room'} = $query->param('room');
  42     $IN{'name'} = $query->param('name');
  43     $IN{'weight'} = $query->param('weight');
  44     $IN{'reverse'} = $query->param('reverse');
  45     $IN{'comment'} = $query->param('comment');
  46     $IN{'mode'} = $query->param('mode');
  47     $IN{'face'} = $query->param('face');
  48     $IN{'email'} = $query->param('email');
  49     $IN{'color'} = $query->param('color');
  50     $IN{'retime'} = $query->param('retime');
  51     $IN{'line'} = $query->param('line');
  52
  53     foreach $key (keys %IN) {
  54         # \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ß)
  55         local($c) = &jcode::getcode(\$IN{$key});
  56         #print "code: $c\n";
  57         if ($c eq 1 || $c eq 2) {
  58             &jcode::convert(\$IN{$key}, 'euc');
  59         }
  60
  61         # \83^\83O\8f\88\97\9d (\83T\83j\83^\83C\83W\83\93\83O)
  62         $IN{$key} =~ s/&/&amp;/g;
  63         $IN{$key} =~ s/</&lt;/g;
  64         $IN{$key} =~ s/>/&gt;/g;
  65         $IN{$key} =~ s/"/&quot;/g; # "
  66         $IN{$key} =~ s/\r//g;
  67         $IN{$key} =~ s/\n//g;
  68
  69         # \95¶\8e\9a\83R\81[\83h\82ð\8f\88\97\9d\8cn\82É\8d\87\82í\82¹\82é
  70         local($code) = 'euc';
  71         if ($CONF{'charset'} eq 'Shift_JIS') {
  72             $code = 'sjis';
  73         } elsif ($CONF{'charset'} eq 'ISO-2202-JP') {
  74             $code = 'jis';
  75         }
  76         &jcode::convert(\$IN{$key}, $code);
  77     }
  78 }
  79
  80 ##### \8aÖ\90\94\81F\83g\83\8a\83b\83v\8eæ\93¾\8f\88\97\9d #####
  81 sub getTrip {
  82     local($name) = $_[0];
  83     local($tripped) = $name;
  84     # \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·
  85     if ($CONF{'usetrip'} && $name =~ /(.*)(#|\81\94)(.*)/){
  86         $trip = &genTrip($1, $3);
  87         $tripped = $1 . "\81\9f" . $trip;
  88     } else {
  89         $tripped =~ s/\81\9f/\81\9e/g;
  90     }
  91     return $tripped;
  92 }
  93
  94 ##### \8aÖ\90\94\81F\83g\83\8a\83b\83v\90¶\90¬ #####
  95 sub genTrip {
  96     local($name, $key) = @_;
  97     local($salt) = substr($key."H.", 1, 2);
  98     $salt =~ s/[^\.-z]/\./go;
  99     $salt =~ tr/:;<=>?@[\\]^_`/ABCDEFGabcdef/; #`
 100     return substr(crypt($key, $salt), -10);
 101 }
 102
 103 ##### \8aÖ\90\94\81F\83A\83N\83Z\83X\8b\91\94Û\8f\88\97\9d #####
 104 sub checkDeny {
 105     local($client) = $_[0];
 106     local($find)=0;
 107     open(DENY, "$CONF{'denyfile'}")
 108         || &error("Open Error : denyfile : $CONF{'denyfile'} : $!");
 109     while (<DENY>) {
 110         s/\n//g;
 111         next if (!$_);
 112         s/\*/\.\*/g;
 113         if ($client =~ /$_/i) { $find=1; last; }
 114     }
 115     close(DENY);
 116     if ($find) { &error($CONF{'denymsg'}); }
 117 }
 118
 119 ###
 120 # \94\8c¾\8f\9c\8b\8e\8f\88\97\9d
 121 sub clear {
 122     local($client, @lines) = @_;
 123     local(@temp) = ();
 124     local($match)=0;
 125     foreach (@lines) {
 126         local($cip) = (split(/<>/))[5];
 127         if ($client eq $cip) {
 128             $match=1;
 129         } else {
 130             push(@temp, $_);
 131         }
 132     }
 133     if ($match) {
 134         $IN{'comment'}="All Clear (^-^)v";
 135         return @temp;
 136     }
 137 }
 138
 139 ###
 140 #  \83\8d\83O\8f\91\82«\8d\9e\82Ý\8f\88\97\9d
 141 sub writeDat {
 142     # \83\82\81[\83h\91I\91ð
 143     local($mode) = $_[0];
 144     local($datfile) = $CONF{'datdir'}.'/'.$IN{'room'}.'.dat';
 145     local($lockfile) =  $CONF{'lockdir'}.'/'.$IN{'room'}.'.lock';
 146
 147     # \96¼\91O\82Ì\93ü\97Í\82ª\82È\82¯\82ê\82Î\83G\83\89\81[
 148     if ($IN{'name'} eq "") {
 149         &error("\8cä\8bL\96¼\8aè\82¢\82Ü\82·\81B");
 150     }
 151     # \83g\83\8a\83b\83v\8f\88\97\9d
 152     local($tripped) = &getTrip($IN{'name'});
 153
 154     $bye = 0; # \83O\83\8d\81[\83o\83\8b\95Ï\90\94
 155     local($name, $email, $color)= ("", "", "");
 156     # \93ü\8eº\83\82\81[\83h
 157     if ($mode eq 'login') {
 158         # \93ü\8eº\83\81\83b\83Z\81[\83W\90Ý\92è
 159         $IN{'comment'} = "$tripped $CONF{'in_msg'}";
 160         if ($CONF{'showip'}) {
 161             $IN{'comment'} .= " &lt;$client&gt;";
 162         }
 163         $email = "";
 164         $name  = $CONF{'navi'};
 165         $color = $CONF{'navicolor'};
 166     }
 167     # \91Þ\8eº\83\82\81[\83h
 168     elsif ($mode eq 'logout') {
 169         $IN{'comment'} = "$tripped $CONF{'out_msg'}";
 170         $email = "";
 171         $name  = $CONF{'navi'};
 172         $color = $CONF{'navicolor'};
 173         $bye=1;
 174     }
 175     # \92Ê\8fí\83\82\81[\83h
 176     else {
 177         # \93ü\97Í\82ª\82È\82¢\8fê\8d\87\82Í\82»\82Ì\82Ü\82Ü\95Ô\82é
 178         if ($IN{'comment'} eq "") { return; }
 179
 180         if ($IN{'email'} eq "") {
 181             $name = "<B>$CONF{'pointer'}</B>";
 182         }
 183         else {
 184             $name = "<B><a href=\"mailto:$IN{'email'}\">";
 185             $name .= "$CONF{'pointer'}</a></B>";
 186         }
 187         $name .= " $tripped ";
 188         $email = $IN{'email'};
 189         $color = $IN{'color'};
 190     }
 191
 192     # \83\8d\83O\83t\83@\83C\83\8b\82Ì\83\8d\83b\83N\8aJ\8en
 193     if ($CONF{'lockmode'}) { &lock($lockfile); }
 194
 195     # \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Ó)
 196     open(DAT, "<$datfile") || &error("Open Error : datfile : $datfile");
 197     local(@lines) = <DAT>;
 198     close(DAT);
 199
 200     # \94\8c¾\8f\9c\8b\8e\8f\88\97\9d (\83I\83v\83V\83\87\83\93)
 201     # \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
 202     if ($CONF{'clearlog'} && $IN{'comment'} eq $CONF{'clearcom'}) {
 203         @lines = &clear($client, @lines);
 204     }
 205
 206     # \8dÅ\91å\8bL\8e\96\90\94\82Ü\82Å\8dí\82é
 207     while ($CONF{'max'} <= @lines) {
 208         pop(@lines);
 209     }
 210
 211     # \8e\9e\8aÔ\82ð\8eæ\93¾
 212     local($date) = &getDate();
 213
 214     # RP\90Ø\82è\8fo\82µ\8b@\94\\82ªON\82È\82ç\82ÎRP\82Ì\82Ý\94²\82«\8fo\82µ
 215     if ($CONF{'rplog'} == 1) {
 216         &writeRPLog($date, $IN{'name'}, $IN{'comment'});
 217     }
 218
 219     # \83\8d\83O\82ð\83t\83H\81[\83}\83b\83g\82µ\82Ä\8dX\90V
 220     local($newline) = "$date<>$name<>$email<>";
 221     $newline .= "$IN{'comment'}<>$color<>$client<>\n";
 222     unshift (@lines, $newline);
 223     open(DAT, ">$datfile") || &error("Write Error : datfile : $datfile");
 224     print DAT @lines;
 225     close(DAT);
 226
 227     # \83\8d\83b\83N\89ð\8f\9c
 228     if ($CONF{'lockmode'}) { &unlock($lockfile); }
 229 }
 230
 231 ###
 232 #  RP\90Ø\82è\8fo\82µ\8b@\94\
 233 sub writeRPLog {
 234     local($date, $name, $comment) = @_;
 235     # RP\95Û\91¶\83t\83@\83C\83\8b
 236     local($txtfile) = $CONF{'rpdir'}.'/'.$IN{'room'}.'.txt';
 237     local($lockfile) =  $CONF{'lockdir'}.'/'.$IN{'room'}.'.rplock';
 238
 239     if ($comment =~ /\81u.+\81v/) {
 240         local($line) = "$name \81F$comment ($date)\n";
 241         # \83\8d\83O\83t\83@\83C\83\8b\82Ì\83\8d\83b\83N\8aJ\8en
 242         if ($CONF{'lockmode'}) { &lock($lockfile); }
 243         open(TXT, ">>$txtfile") || &error("Write Error : txtfile : $txtfile");
 244         print TXT $line;
 245         close(TXT);
 246         # \83\8d\83b\83N\89ð\8f\9c
 247         if ($CONF{'lockmode'}) { &unlock($lockfile); }
 248     }
 249 }
 250
 251 ###
 252 #  RP\83N\83\8a\83A\8b@\94\\81i\83o\83b\83N\83A\83b\83v\8b@\94\\82Â\82«\81j
 253 sub clearRPLog {
 254     local($date, $name, $comment) = @_;
 255     # RP\95Û\91¶\83t\83@\83C\83\8b
 256     local($txtfile) = $CONF{'rpdir'}.'/'.$IN{'room'}.'.txt';
 257     local($lockfile) =  $CONF{'lockdir'}.'/'.$IN{'room'}.'.rplock';
 258     # RP\83o\83b\83N\83A\83b\83v\90æ\83t\83@\83C\83\8b
 259     local($bakfile) = $CONF{'rpdir'}.'/'.$IN{'room'}.'-bak.txt';
 260
 261     # \83\8d\83O\83t\83@\83C\83\8b\82Ì\83\8d\83b\83N\8aJ\8en
 262     if ($CONF{'lockmode'}) { &lock($lockfile); }
 263     open(TXT, "<$txtfile") || &error("Read Error : txtfile : $txtfile");
 264     open(BAK, ">>$bakfile") || &error("Write Error : bakfile : $bakfile");
 265     while(<TXT>) {
 266         print BAK $_;
 267     }
 268     close(BAK);
 269     close(TXT);
 270     open(TXT, ">$txtfile") || &error("Write Error : txtfile : $txtfile");
 271     print TXT "old log is in $bakfile\n\n";
 272     close(TXT);
 273     # \83\8d\83b\83N\89ð\8f\9c
 274     if ($CONF{'lockmode'}) { &unlock($lockfile); }
 275 }
 276
 277 ###
 278 ### HTML\90¶\90¬\8aÖ\8cW
 279 ###
 280
 281 ###
 282 # \83w\83b\83_\81[\8fo\97Í\8f\88\97\9d (\8b¤\92Ê)
 283 sub printHeader {
 284     local($extra) = $_[0];
 285
 286     print "Content-type: $CONF{'content-type'}\n";
 287     # GZIP\88³\8fk\91Î\89\9e\83R\81[\83h (2006/02/10)
 288     if (${'HTTP_ACCEPT_ENCODING'} =~ /gzip/ && $gzip ne '') {
 289         if (${'HTTP_ACCEPT_ENCODING'} =~ /x-gzip/) {
 290             print "Content-encoding: x-gzip\n";
 291         } else {
 292             print "Content-encoding: gzip\n";
 293         }
 294         open (STDOUT, "|$gzip -1 -c"); # \88³\8fk\82Í\8dÅ\91¬(-1)\82Å
 295     }
 296     # GZIP\88³\8fk\91Î\89\9e\81A\82±\82±\82Ü\82Å
 297     print "\n"; # \83w\83b\83_\8fI\97¹
 298     print <<"EOM";
 299 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
 300 <html lang="$CONF{'lang'}">
 301 <head>
 302 <meta http-equiv="Content-type" content="$CONF{'content-type'}" />
 303 <meta http-equiv="Content-Language" content="$CONF{'lang'}" />
 304 <meta name='robots' content='noindex, nofollow' />
 305 <script type='text/javascript' src='$CONF{'javascript'}'></script>
 306 <link rel="stylesheet" type="text/css" href="$CONF{'chatstyle'}">
 307 <title>$CONF{'title'}</title>
 308 $extra
 309 </head>
 310 EOM
 311 }
 312
 313 ##### \8aÖ\90\94\81F\83\8d\83O\83t\83@\83C\83\8b\82Ö\82Ì\88Ú\93®\95\\8e¦ #####
 314 sub printGoToLog {
 315     &printHeader();
 316
 317     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·");
 318     print $query->p("<a href=\"$CONF{'logdir'}/$IN{'room'}.html\" target=\"_top\">[ \83\8d\83O\82ð\8c©\82é ]</a>");
 319
 320     # \95\\8e¦\8fI\97¹
 321     print $query->end_html;
 322     exit(0);
 323 }
 324
 325 ###
 326 # \83t\83\8c\81[\83\80\8fo\97Í\8f\88\97\9d
 327 sub printFrame {
 328     # \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ü
 329     if ($CK{'retime'} eq "") { $CK{'retime'} = $CONF{'retime'}; }
 330     if ($CK{'line'} eq "") { $CK{'line'} = $CONF{'line'}; }
 331
 332     $formsrc = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=form&retime=$CK{'retime'}&line=$CK{'line'}";
 333     $logsrc = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=view&retime=$CK{'retime'}&line=$CK{'line'}";
 334
 335     &printHeader();
 336     print <<"EOM";
 337 <frameset rows="177,*" border=0>
 338 <frame name="form" src="$formsrc">
 339 <frame name="log" src="$logsrc">
 340 <noframes>
 341 <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>
 342 </noframes>
 343 </frameset>
 344 </html>
 345 EOM
 346     exit(0);
 347 }
 348
 349 ###
 350 # \83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[\90¶\90¬
 351 sub genPullDown {
 352     local($script) = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=view&retime=0";
 353     local($pulldown) =<<"EOM";
 354 <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;">
 355 <a href="$script&line=500" target="_blank">\81@\82T\82O\82O</a><BR>
 356 <a href="$script&line=1000" target="_blank">\81@\82P\82O\82O\82O</a><BR>
 357 <a href="$script&line=1500" target="_blank">\81@\82P\82T\82O\82O</a><BR>
 358 <a href="$script&line=2000" target="_blank">\81@\82Q\82O\82O\82O</a><BR>
 359 </div>
 360 EOM
 361     return $pulldown;
 362 }
 363
 364 ###
 365 # \8dX\90V\8e\9e\8aÔ\91I\91ð\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
 366 sub genReloadTimeSelection {
 367     # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
 368     if ($IN{'retime'} ne "") {
 369         $CK{'retime'} = $IN{'retime'};
 370     }
 371     # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
 372     if ($CK{'retime'} eq "") {
 373         $CK{'retime'} = $CONF{'retime'};
 374     }
 375
 376     local($reload) = "\8dX\90V <select name=retime>\n";
 377     foreach (@reload) {
 378         if ($CK{'retime'} == $_) {
 379             $reload .= "<option value=\"$_\" selected>$_\95b\n";
 380         } else {
 381             $reload .= "<option value=\"$_\">$_\95b\n";
 382         }
 383     }
 384     $reload .= "</select>\n";
 385     return $reload;
 386 }
 387
 388 ###
 389 # \93ü\8eº\8fî\95ñ\93ü\97Í\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
 390 sub genLoginInput {
 391     local($login) =<<"EOM";
 392 <b>NAME</b> <input type="text" name="name" size="25" value="$CK{'name'}"><br>
 393 <b>EMail</b> <input type="text" name="email" size="25" value="$CK{'email'}"><br>
 394 <input type="hidden" name="room" value="$IN{'room'}">
 395 EOM
 396     return $login;
 397 }
 398
 399 ###
 400 # \83`\83\83\83b\83g\8fî\95ñ\93ü\97Í\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
 401 sub genChatInput {
 402     # \83g\83\8a\83b\83v\96¼\82Ì\8f\88\97\9d
 403     local($tripped) = &getTrip($IN{'name'});
 404     local($chat) = << "EOM";
 405 <input type="hidden" name="mode" value="chat">
 406 <input type="hidden" name="room" value="$IN{'room'}">
 407 <input type="hidden" name="name" value="$IN{'name'}">
 408 <input type="hidden" name="email" value="$IN{'email'}">
 409 <b>NAME</b>\81F\81@<font color="$IN{'color'}">$tripped</font>
 410 <input type="submit" value="\94\8c¾\81^\83\8a\83\8d\81[\83h">
 411 <input type="reset" value="\83N\83\8a\83A"><br>
 412 <b>\94\8c¾</b>\81@\81F\81@<input type="text" size="85" name="comment"><br>
 413 EOM
 414     return $chat;
 415 }
 416
 417 ###
 418 # \8ds\90\94\91I\91ð\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
 419 sub genLineNumSelection {
 420     # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
 421     if ($IN{'line'} ne "") {
 422         $CK{'line'} = $IN{'line'};
 423     }
 424     # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
 425     if ($CK{'line'} eq "") {
 426         $CK{'line'} = $CONF{'line'};
 427     }
 428
 429     local($lines) = "\8ds\90\94 <select name=line>\n";
 430     foreach (@line) {
 431         if ($CK{'line'} == $_) {
 432             $lines .= "<option value=\"$_\" selected>$_\8ds\n";
 433         } else {
 434             $lines .= "<option value=\"$_\">$_\8ds\n";
 435         }
 436     }
 437     $lines .= "</select><br>\n";
 438     return $lines;
 439 }
 440
 441 ###
 442 # \95¶\8e\9a\90F\91I\91ð(\83\89\83W\83I\83{\83^\83\93)\82Ì\8fo\97Í\8f\88\97\9d
 443 sub genColorRadioBottun {
 444     # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
 445     if ($IN{'color'} ne "") {
 446         $CK{'color'} = $IN{'color'};
 447     }
 448     # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
 449     if ($CK{'color'} eq "") {
 450         $CK{'color'} = $CONF{'color'};
 451     }
 452
 453     local($colors) = "<B>\95¶\8e\9a\90F\91I\91ð</B><BR><BR>\n";
 454
 455     local($half) = int (@COLORS / 2); # \94¼\95ª\82É\8a\84\82é
 456     local($i=0);
 457     foreach (@COLORS) {
 458         $i++;
 459         if ($CK{'color'} eq $_) {
 460             $colors .= "<input type=radio name=color value=\"$_\" checked>";
 461         } else {
 462             $colors .= "<input type=radio name=color value=\"$_\">";
 463         }
 464         $colors .= "<font color=\"$_\"><B>**</B></font>\n";
 465         if ($i == $half) { $colors .= "<br>\n"; }
 466     }
 467     return $colors;
 468 }
 469
 470 ###
 471 # \95¶\8e\9a\90F\91I\91ð(\83Z\83\8c\83N\83g\83\81\83j\83\85\81[)\82Ì\8fo\97Í\8f\88\97\9d
 472 sub genColorSelection {
 473     # \93ü\97Í\82É\82æ\82é\90Ý\92è\82ª\82 \82ê\82Î\82»\82¿\82ç\82ð\97D\90æ
 474     if ($IN{'color'} ne "") {
 475         $CK{'color'} = $IN{'color'};
 476     }
 477     # \8bó\82È\82ç\82Î\8f\89\8aú\92l\82É\90Ý\92è
 478     if ($CK{'color'} eq "") {
 479         $CK{'color'} = $CONF{'color'};
 480     }
 481
 482     local($colors) = "\95¶\8e\9a\90F <select name=color>\n";
 483     for ($i = 0; $i < scalar(@COLORS); $i++) {
 484         if ($IN{'color'} eq $COLORS[$i]) {
 485             $colors .= "<option value=\"$COLORS[$i]\" selected>$IROIRO[$i]\n";
 486         } else {
 487             $colors .= "<option value=\"$COLORS[$i]\">$IROIRO[$i]\n";
 488         }
 489     }
 490     $colors .= "</select>\n";
 491 }
 492
 493 ###
 494 # \8aç\95¶\8e\9a\91I\91ð\95\94\82Ì\95¶\8e\9a\97ñ\90¶\90¬
 495 sub genFaceSelection {
 496     local ($face) = "\82©\82¨\95¶\8e\9a <select name=\"face\">";
 497     $face .= "<option value=\"\">\82È\82µ\n";
 498     foreach (@faces) {
 499         $face .= "<option value=\"$_\">$_\n";
 500     }
 501     $face .= "</select>\n";
 502     return $face;
 503 }
 504
 505 ###
 506 #  \93ü\8eº\97p\83t\83H\81[\83\80\8fo\97Í
 507 sub printEntryForm {
 508     # \83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[\82Ì\90¶\90¬
 509     local($loglink) = '';
 510     if ($CONF{'loglink'} == 1) {
 511         $loglink = &genLogLinkString($IN{'room'});
 512     } elsif ($CONF{'loglink'} == 2) {
 513         $loglink = &genPullDown();
 514     }
 515
 516     local($login) = &genLoginInput();
 517     local($reload) = &genReloadTimeSelection();
 518     local($lines) = &genLineNumSelection();
 519     local($colors) = &genColorRadioBottun();
 520
 521     # \83w\83b\83_\81[\82ð\8fo\97Í
 522     &printHeader();
 523     local($kazari) = "<font color=\"#DB5673\">\81\96\81\96\81\96</font>";
 524     print <<"EOM";
 525 <body>
 526 <form method="$CONF{'method'}" action="$CONF{'chatcgi'}"
 527  target="form" name="entry">
 528 <input type=hidden name=mode value="login">
 529 [<a href="$CONF{'indexurl'}" target="_top">BACK</a>]
 530  $CONF{'topdesc'} $loglink <br><br>
 531 <h1>$kazari $CONF{'title'} $kazari</h1>
 532 <hr>
 533 <table border="0" cellspacing="0" cellpadding="0" height="100">
 534 <tr align="right">
 535 <td>$login $reload $lines</td>
 536 <td width="100" align="center"><br>
 537 <input type="submit" value="\93ü\8eº"></td>
 538 <td align=center valign=top nowrap><br>
 539 $colors
 540 </td></tr></table></form>
 541 <SCRIPT LANGUAGE="JavaScript">
 542 <!--
 543 self.document.entry.name.focus();
 544 //-->
 545 </SCRIPT>
 546 </body></html>
 547 EOM
 548     exit(0);
 549 }
 550
 551 ### \8aÖ\90\94\81F\8cy\97Ê\83V\83\93\83v\83\8b\94Å\83\8d\83O\83C\83\93\89æ\96Ê ###
 552 sub printEntryFormAndDat {
 553     local($login) = &genLoginInput();
 554     local($colors) = &genColorSelection();
 555
 556     # \83w\83b\83_\81[\82ð\8fo\97Í
 557     &printHeader();
 558
 559     print <<"EOM";
 560 <body>
 561 <form method="$CONF{'method'}" action="$CONF{'chatcgi'}"
 562  target="_top" name="entry">
 563 <input type="hidden" name="mode" value="login">
 564 <input type="hidden" name="weight" value="light">
 565 <input type="hidden" name="line" value="20">
 566 <input type="hidden" name="retime" value="0">
 567 [<a href="$CONF{'indexurl'}" target="_top">\96ß\82é</a>]
 568 [<a href="$CONF{'chatcgi'}?room=$IN{'room'}&weight=light&line=$CONF{'lightline'}">\83\8a\83\8d\81[\83h</a>]
 569 <h1>$CONF{'title'}</h1>
 570 <hr>
 571 $login
 572 $colors
 573 <input type="submit" name="login" value="\93ü\8eº">
 574 <hr>
 575 EOM
 576
 577     print &genMember();
 578     local($datfile) = $CONF{'datdir'}."/".$IN{'room'}.".dat";
 579     print &formatDat($datfile, $CONF{'lightline'}, 'light', $IN{'reverse'});
 580
 581     print $query->hr;
 582
 583     print &genCopyright();
 584     print $query->end_html;
 585     exit(0);
 586 }
 587
 588 ### \8aÖ\90\94\81F\8cy\97Ê\83V\83\93\83v\83\8b\94Å\83`\83\83\83b\83g\89æ\96Ê ###
 589 sub printChatFormAndDat {
 590     local($chat) = &genChatInput();;
 591     local($colors) = &genColorSelection();
 592
 593     # \83\8d\83O\8f\91\82«\8d\9e\82Ý\8f\88\97\9d
 594     &writeDat($IN{'mode'});
 595
 596     # \83N\83b\83L\81[\82Ì\90Ý\92è
 597     local($ck) = "name<>$IN{'name'}";
 598     $ck .= "<>email<>$IN{'email'}";
 599     $ck .= "<>color<>$IN{'color'}";
 600     $ck .= "<>retime<>$IN{'retime'}";
 601     $ck .= "<>line<>$IN{'line'}";
 602     &setCookie($CONF{'cookiekey'}, $ck, $CONF{'expire'});
 603
 604     # \83w\83b\83_\81[\82ð\8fo\97Í
 605     &printHeader();
 606
 607     print <<"EOM";
 608 <body>
 609 <br>
 610 <h1>$CONF{'title'}</h1>
 611 <hr>
 612 <form method="$CONF{'method'}" action="$CONF{'chatcgi'}"
 613  target="_top" name="chat">
 614 <input type="hidden" name="line" value="$CONF{'lightline'}">
 615 <input type="hidden" name="weight" value="light">
 616 <input type="hidden" name="retime" value="0">
 617 $chat
 618 $colors
 619 </form>
 620
 621 <form action="$CONF{'chatcgi'}" method="$CONF{'method'}" target="_top"
 622  name="logout">
 623 <input type="submit" name="logout" value="\91Þ\8eº">
 624 <input type="hidden" name="mode" value="logout">
 625 <input type="hidden" name="name" value="$IN{'name'}">
 626 <input type="hidden" name="room" value="$IN{'room'}">
 627 <input type="hidden" name="weight" value="light">
 628 </form>
 629 <hr>
 630 EOM
 631
 632     print &genMember();
 633     local($datfile) = $CONF{'datdir'}."/".$IN{'room'}.".dat";
 634     print &formatDat($datfile, $IN{'line'}, 'light', $IN{'reverse'});
 635
 636     print $query->hr;
 637     print &genCopyright();
 638     print $query->end_html;
 639     exit(0);
 640 }
 641
 642 ###
 643 # \94\8c¾\83t\83H\81[\83\80\8fo\97Í
 644 sub printChatForm {
 645     # \83v\83\8b\83_\83E\83\93\83\81\83j\83\85\81[\82Ì\90¶\90¬
 646     local($loglink) = '';
 647     if ($CONF{'loglink'} == 1) {
 648         $loglink = &genLogLinkString($IN{'room'});
 649     } elsif ($CONF{'loglink'} == 2) {
 650         $loglink = &genPullDown();
 651     }
 652
 653     local($chat) = &genChatInput();
 654     local($face) = &genFaceSelection();
 655     local($colors) = &genColorSelection();
 656     local($lines) = &genLineNumSelection();
 657     local($reload) = &genReloadTimeSelection();
 658
 659     # \83\89\83\93\83L\83\93\83O\82Ì\90¶\90¬
 660     if ($CONF{'ranking'}) {
 661         local($ranking) = &genRanking();
 662     }
 663
 664     # \83\8d\83O\8f\91\82«\8d\9e\82Ý\8f\88\97\9d
 665     &writeDat('login');
 666
 667     # \83N\83b\83L\81[\82Ì\90Ý\92è
 668     local($ck) = "name<>$IN{'name'}";
 669     $ck .= "<>email<>$IN{'email'}";
 670     $ck .= "<>color<>$IN{'color'}";
 671     $ck .= "<>retime<>$IN{'retime'}";
 672     $ck .= "<>line<>$IN{'line'}";
 673     &setCookie($CONF{'cookiekey'}, $ck, $CONF{'expire'});
 674
 675     # \83w\83b\83_\8fo\97Í
 676     &printHeader();
 677     print <<"EOM";
 678 <body>
 679 <form name="send" method="$CONF{'method'}" action="$CONF{'chatcgi'}"
 680  target="log" onSubmit="setTimeout(&quot;autoclear()&quot;,10)">
 681 <table border=0><tr><td colspan=3>
 682 <b><font color="#DB5673" size="2">\81\96\81\96\81\96</font>
 683 $CONF{'title'}
 684 <font color="#DB5673" size="2">\81\96\81\96\81\96</font></b>\81@
 685 <br> $CONF{'chatalart'} $loglink
 686 <br><br>$chat
 687 </td></tr>
 688 <tr><td>$face $colors $reload $lines</td></form>
 689 <td valign="top">
 690 <form action="$CONF{'chatcgi'}" method="$CONF{'method'}" target="form">
 691 <input type="submit" value="\91Þ\8eº\90é\8c¾">
 692 <input type="hidden" name="mode" value="logout">
 693 <input type="hidden" name="name" value="$IN{'name'}">
 694 <input type="hidden" name="room" value="$IN{'room'}">
 695 </td></form>
 696 <td>
 697 <form name="cmode">
 698 <input type="checkbox" name="autoclear" checked>
 699 \94\8c¾\8e©\93®\8fÁ\8b\8e</td></form></tr></table><br>
 700 [<a href="$CONF{'adminscript'}?mode=enter&retime=$IN{'retime'}&line=$IN{'line'}" target="log">\8aÇ\97\9d\97p</a>]
 701 $ranking
 702 </body></html>
 703 EOM
 704     exit(0);
 705 }
 706
 707 ###
 708 #  \8dÝ\8eº\8eÒ\8f\88\97\9d
 709 sub genMember {
 710     local($mode) = $_[0];
 711     local($memfile) = $CONF{'memdir'}.'/'.$IN{'room'}.'.dat';
 712     local($memlock) = $CONF{'lockdir'}.'/'.$IN{'room'}.'.memlock';
 713
 714     # \83\8d\83b\83N\82ð\82©\82¯\82é
 715     if ($CONF{'lockmode'}) { &lock($memlock); }
 716
 717     # \83\81\83\93\83o\81[\88ê\97\97\8eæ\93¾
 718     open(MEM, "<$memfile")
 719         || &error("Open Error : memfile : $memfile");
 720     local(@line) = <MEM>;
 721     close(MEM);
 722
 723     # \95Ï\90\94\8f\89\8aú\89»
 724     local(@new) = ();
 725     local($member, $update, $even) = ("", 0, 0);
 726     local($time0, $name0, $client0) = (0, '', '');
 727     # \83g\83\8a\83b\83v\82Ì\8f\88\97\9d
 728     local($tripped) = &getTrip($IN{'name'});
 729     # \8c»\8dÝ\8e\9e\8d\8f\82ð\8eæ\93¾
 730     local($nowtime) = time;
 731     foreach (@line) {
 732         ($time0, $name0, $client0) = split(/<>/);
 733
 734         # \88ê\92è\8e\9e\8aÔ\88È\8fã\94\8c¾\82Ì\82È\82¢\8eÒ\82Í\8dí\8f\9c
 735         if ($nowtime - $CONF{'memexp'} > $time0) { next; }
 736
 737         # \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é
 738         elsif ($client0 eq $client && $name0 eq $tripped) {
 739             # \91Þ\8eº\8eÒ\82Í\8dí\8f\9c
 740             if ($mode eq 'logout') { next; }
 741
 742             # \8e\9e\8aÔ\82Æ\96¼\91O\82ð\8dX\90V\82µ\82Ä\92Ç\89Á
 743             push (@new, "$nowtime<>$tripped<>$client<>\n");
 744             $name0 = $tripped;
 745             $update=1;
 746         }
 747         # \82»\82ê\88È\8aO\82Í\96â\93\9a\96³\97p\82Å\8dX\90V\97p\94z\97ñ @new \82É\92Ç\89Á
 748         else { push(@new, $_); }
 749
 750         # \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)
 751         if (!$even) {
 752             $member .= "$name0\81\9a"; $even=1;
 753         }
 754         else {
 755             $member .= "$name0\81\99"; $even=0;
 756         }
 757     }
 758
 759     # \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Á
 760     if (!$update && !$bye) {
 761         if ($IN{'name'} ne $client) {
 762             push(@new, "$nowtime<>$tripped<>$client<>\n");
 763             if (!$even) {
 764                 $member .= "$tripped\81\9a";
 765             }
 766             else {
 767                 $member .= "$tripped\81\99";
 768             }
 769         }
 770     }
 771
 772     # \83t\83@\83C\83\8b\82ð\8dX\90V\82·\82é
 773     if ($IN{'mode'} || $IN{'retime'}) {
 774         open(MEM,">$memfile")
 775             || &error("Write Error : memfile : $memfile");
 776         print MEM @new;
 777         close(MEM);
 778     }
 779
 780     # \83\8d\83b\83N\89ð\8f\9c
 781     if ($CONF{'lockmode'}) { &unlock($memlock); }
 782
 783     # \8eQ\89Á\8eÒ\90\94\82ð\94F\8e¯
 784     local($num) = 0;
 785     $num = @new;
 786     return "\8eQ\89Á\8eÒ($num)\81F".$member;
 787 }
 788
 789 ###
 790 #  \91Þ\8eº\8f\88\97\9d
 791 sub printLogout {
 792     &writeDat('logout');
 793     local($member) = &genMember('logout');
 794     local($tripped) = &getTrip($IN{'name'});
 795     &printHeader();
 796     print <<"EOM";
 797 <body>
 798 <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>
 799 <form action="$CONF{'indexurl'}" target="_top">
 800 <input type=submit value="\97£\92E"></form></center>
 801 </body></html>
 802 EOM
 803     exit(0);
 804 }
 805
 806 ###
 807 #  \83\8d\83O\95\\8e¦
 808 sub viewDat {
 809     # \83\8a\83\8d\81[\83h\83w\83b\83_
 810     local($extra) = '';
 811     if ($IN{'retime'} != 0) {
 812         local($ename) = &url_enc($IN{'name'});
 813         local($script) = "$CONF{'chatcgi'}?room=$IN{'room'}&mode=view&retime=$IN{'retime'}&line=$IN{'line'}&name=$ename";
 814         $extra = "<meta http-equiv=\"refresh\"";
 815         $extra .= " content=\"$IN{'retime'}; URL=$script\">\n";
 816     }
 817     &printHeader($extra);
 818
 819     ## \8eQ\89Á\8eÒ\95\\8e¦
 820     local($member) = &genMember();
 821     print "<body>\n";
 822     print "<hr>";
 823     print "<table width='100%'><tr><td>$member</td>\n";
 824     print "<td align=right>\83\8a\83\8d\81[\83h\81F ";
 825     if ($IN{'retime'} == 0) {
 826         print "\8eè\93®\83\82\81[\83h";
 827     } else { print "$IN{'retime'}\95b"; }
 828     print " \8ds\90\94: $IN{'line'}\8ds</td></tr></table>\n";
 829
 830     local($datfile) = $CONF{'datdir'}."/".$IN{'room'}.".dat";
 831     print &formatDat($datfile, $IN{'line'}, 'normal', $IN{'reverse'});
 832
 833     print $query->hr . "\n";
 834
 835     # \92\98\8dì\8c \82ð\95\\8e¦\81i\8dí\8f\9c\8bÖ\8e~\81j
 836     print &genCopyright();
 837     print $query->end_html . "\n";
 838     exit(0);
 839 }
 840
 841 # End of kenranlib
 842 1;