Просмотр файла chat/c.pl

#!/usr/bin/perl

do "wc.cfg";
do "wc.lib";

&get_data;

for $pair (@pairs) {
   ($name, $value) = split(/=/, $pair);

$FORM_W{$name} = $value;
$FORM{$name} = $value;

#unicode (urlencoded) -> Win
$FORM_W{$name} =~ tr/+/ /;
$FORM_W{$name}=&uu2wu($FORM_W{$name});
$FORM_W{$name} =~ s/%(..)/pack("C", hex($1))/eg;
$FORM_W{$name} =~ s/</&lt;/g;
$FORM_W{$name} =~ s/>/&gt;/g;
$FORM_W{$name} =~ s/\012/ /g;
$FORM_W{$name} =~ s/\015/ /g;

#unicode (urlencoded) -> unicode
$FORM{$name}=&uu2u($FORM{$name});
$FORM{$name} =~ s/\$/\$\$/g;
$FORM{$name} =~ s/</&lt;/g;
$FORM{$name} =~ s/>/&gt;/g;
$FORM{$name} =~ s/\012/ /g;
$FORM{$name} =~ s/\015/ /g;
}


if (!(exists $FORM{n})){&welcome}

#Проверка корректности имени
if (($FORM{n} =~ /[^a-zA-Z01-9]/) || ($FORM{n} =~ /\.\./) || ($FORM{n} eq ".htaccess") || ($FORM{n} eq "")){
&sm("&#x0412;&#x0432;&#x0435;&#x0434;&#x0438;&#x0442;&#x0435; &#x0438;&#x043C;&#x044F;");
exit;
}

#Создание ссылок из конструкции: http://адрес
$urls = '(http|ftp)';
$ltrs = '\w';
$gunk = '/#~:.?+=&%@!\-';
$punc = '.:?\-';
$any  = "${ltrs}${gunk}${punc}";
$FORM_W{m} =~ s{\b($urls:[$any] +?)(?=[$punc]*[^$any]|$)}{<a href="$1" target="_blank">$1</a>}igox;
$FORM{m} =~ s{\b($urls:[$any] +?)(?=[$punc]*[^$any]|$)}{<a href="$1">$1</a>}igox;

#Установка значений по умолчанию (если они не заданы)
if ((!(exists $FORM{l})) || ($FORM{l} eq "") || ($FORM{l} == 0)){$FORM{l}=15}
if ((!(exists $FORM{r})) || ($FORM{r} eq "") || ($FORM{r} == 0)){$FORM{r}=300}

#Сообщаем, что вошли в чат
if ((!(exists $FORM{d})) && (!(exists $FORM{a}))){&say("&gt;","<b>$FORM{n}</b>","ENTER","<b>$FORM_W{n}</b> вошел в чат");&main;}



# =============================================================================
#                               Вызов необходимой функции
# =============================================================================

if ($FORM{d} eq "s"){&say($FORM{n},$FORM{m},$FORM_W{n},$FORM_W{m})}
if ($FORM{d} eq "c"){open (C, ">$chatdata");close (C);&main;}
if ($FORM{d} eq "e"){&say(" &lt;&lt;&lt;","<b>$FORM{n}</b>","LEAVE","<b>$FORM_W{n}</b> вышел из чата");&leave;}
if ($FORM{d} eq "d"){&dump}
&main;

# =============================================================================
#                               Вывод чата
# =============================================================================

sub main{
if (!(exists $FORM{a})){$FORM{a}=0}
$rnd=int(rand(9));
if ($FORM{a} == $rnd){$rnd++}
&footer;
print "<card title=\"gabir.com.ru\" id=\"m\" ontimer=\"$wapchatcgiurl?n=$FORM{n}&amp;l=$FORM{l}&amp;r=$FORM{r}&amp;a=$rnd\">\n<timer value=\"$FORM{r}\"/>";
print<<__M__;
<do  name="a1" type="accept"  label="&#x0421;&#x043A;&#x0430;&#x0437;&#x0430;&#x0442;&#x044C;">
<go href="#s"/>
</do>
<do name="a2" type="options"  label="&#x041E;&#x0431;&#x043D;&#x043E;&#x0432;&#x0438;&#x0442;&#x044C;">
<go href="$wapchatcgiurl?n=$FORM{n}&amp;l=$FORM{l}&amp;r=$FORM{r}&amp;a=$rnd"/>
</do>
<do name="a3" type="options" label="&#x0412;&#x044B;&#x0445;&#x043E;&#x0434;">
<go href="$wapchatcgiurl?n=$FORM{n}&amp;d=e"/>
</do>
<p>
<small>
__M__
open (R,"$chatdata");
@lines=<R>;
close (R);
for ($i = 0; $i < $FORM{l}; $i++){
chomp $lines[$i];
if ($lines[$i] ne ""){
($name,$date,$mes,$wname,$wdate,$wmes)=split("-=SpLiTsTrInG=-",$lines[$i]);
print "<b>$name</b><i>($date)</i>: $mes<br/>";
	}
}
print<<__MM__;
</small>
</p>
</card>
<card title="gabir.com.ru" id="s" newcontext="true">
<do type="accept" label="&#x0421;&#x043A;&#x0430;&#x0437;&#x0430;&#x0442;&#x044C;">
<go href="$wapchatcgiurl" method="post">
<postfield name="n" value="$FORM{n}"/>
<postfield name="l" value="$FORM{l}"/>
<postfield name="r" value="$FORM{r}"/>
<postfield name="m" value="\$(e)"/>
<postfield name="d" value="s"/>
</go>
</do>
<p>
<input name="e"/>
</p>
</card>
</wml>
__MM__
exit;
}

# =============================================================================
#                               Добавление сообщения
# =============================================================================


sub say{

if ($_[1] ne ""){
($date,$fulldate)=&get_date;
open (O,"$chatdata");
@lines=<O>;
close (O);
open (S,">$chatdata");
print S "$_[0]-=SpLiTsTrInG=-$date-=SpLiTsTrInG=-$_[1]-=SpLiTsTrInG=-$_[2]-=SpLiTsTrInG=-$fulldate-=SpLiTsTrInG=-$_[3]\n";
for ($i = 0; $i < 30; $i++){
print S $lines[$i];
}
close (S);
	}
}

# =============================================================================
#                               LEAVE
# =============================================================================

sub leave{
&footer;
print "<card title=\"gabir.com.ru\"><p align=\"center\"><a href=\"http://gabir.com.ru/index.php\">&#x041D;&#x0430; &#x0433;&#x043B;&#x0430;&#x0432;&#x043D;&#x0443;&#x044E;</a></p></card></wml>";
exit;
}

# =============================================================================
#                               Очистка
# =============================================================================


sub dump{
open (R,"$wchatdata");
@dump=<R>;
close (R);
open (D,">>$dumpfile");
chmod (0666,"$dumpfile");
($date,$fulldate)=&get_date;
print D "$fulldate\n\n@dump\n\n\n";
&footer;
print "<card><p align=\"center\"><br/><br/>Dump done</p></card></wml>";
&cls;
exit;
}

# =============================================================================
#                           Запрос имени, если не указано
# =============================================================================

sub welcome{
&footer;
print<<__WEL__;
<card title="gabir.com.ru" >
<do type="accept" label="&#x0412;&#x0445;&#x043E;&#x0434;">
<go href="$wapchatcgiurl?n=\$(x)&amp;l=\$(y)&amp;r=\$(z)0"/>
</do>
<p align="center">
&#x0418;&#x043C;&#x044F;:<br/>
<input name="x" maxlength="10"/><br/>
&#x0421;&#x043E;&#x043E;&#x0431;&#x0449;&#x0435;&#x043D;&#x0438;&#x0439;:<br/>
<input name="y" format="*N"  maxlength="2" value="10"/><br/>
Refresh (sec.)<br/>
<input name="z" format="*N"  maxlength="2" value="30"/>
</p>
</card>
</wml>
__WEL__
exit;
}