Форум PHP

Ребят помогите, пожалуйста, переписать perl daemon’a на php...
Perl вообще не знаю… скрипт маленький на 80 строчек... БУДУ ОЧЕНЬ БЛАГОДАРЕН!
Скрипт: http://slil.ru/23800981

Вы лучше прикрепляйте файл прямо здесь, такая возможность есть. Программисты народ ленивый, и они зачастую со slil.ru не будут качать... потому что лень...

Ок, хорошо! Вот для ленивых программистов =)

#!/usr/bin/perl use POSIX (); use Socket; my $DaemonPort = 1024; my $work = 1; $|=1; my $sock_name = sockaddr_in($DaemonPort, INADDR_ANY)            or die "Couldn't convert into an Internet address: $!\n"; socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'))        or die "Couldn't create socket: $!\n"; setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1)                    or die "setsockopt() failed: $!\n"; bind(SERVER, $sock_name)                                        or die "Couldn't bind to port $port: $!\n"; listen(SERVER, SOMAXCONN); $SIG{PIPE} = 'IGNORE'; _log("Server started...");     my $rem_addr = accept(CLIENT,SERVER);     next unless (defined $rem_addr);          my($port,$iaddr) = sockaddr_in($rem_addr);     $IP = inet_ntoa($iaddr);     _log("Connection from $IP:$port");     my ($byte, $line);     while ($work and sysread(CLIENT, $byte, 1) == 1) {         if (ord($byte) == 0) { goCommand($line) }         else { $line .= $byte }     }     sleep(3);    #-- Замрем на 3 секунды     _log("Die connection.");     close CLIENT; close(SERVER); _log("Server shutdown"); die; #-- Выводит на экран тестовую информацию sub _log {   my ($s) = @_;     print "".(localtime(time))."\t$s\n"; } #-- Обработка поступившей от клиента команды sub goCommand {   my ($line) = @_;     if (index($line, "<LOGIN")==0) {    #-- Залогинивание         if ($line=~/NAME=\"([^\"]+)\"/) {             _log("LOGIN: $1");             sendAnswer("<ERROR TEXT=\"Такой логин занят, выберите другой\"/>");        #-- Говорим, что такой логин занят (test)         }     }     $work = 0; } #-- Отсылает ответ клиенту. Проблема в том, что русские буквы надо кодировать в utf и в конце ставим нуль символ sub sendAnswer {   my ($s) = @_;     print CLIENT utf($s).chr(0); } sub utf {   my $s = shift;     $s=~s/([А-Яа-яЪЬЁъьё])/win2utf($1)/eg;     return $s; } sub win2utf {    my $s = shift;     if ( (ord($s)>=192) and (ord($s)<=239)) { return chr(208).chr(ord($s)-48) }     if ( (ord($s)>=240) and (ord($s)<=255)) { return chr(209).chr(ord($s)-112) }     if ($s=="Ё") { return chr(208).chr(149) }     if ($s=="ё") { return chr(208).chr(181) }     if ($s=="Ъ") { return chr(208).chr(172) }     if ($s=="Ь") { return chr(208).chr(170) }     if ($s=="ъ") { return chr(208).chr(140) }     if ($s=="ь") { return chr(208).chr(138) }     return $s; }

По моему, этот демон просто эмулирует работу... Вы объясните, что должен делать этот скрипт. И что вы хотите реализовать и на каком языке переписать (наверное на PHP?).

Да, Вы правы… на php… Я Perl не знаю… вот и хочу на php понять, что да как…Вообще это XMLsocket server на Perl’e… вот полный код демона

#!/usr/bin/perl use POSIX; use Errno; use IO::Socket; use IO::Select; use Tie::RefHash (); my $DaemonPort = 5190;            #-- Порт, по которому происходит подключение my $min_login_length = 3;        #-- Минимальная длина имени my $shutdown = 0; tie %logins, 'Tie::RefHash';    #-- $logins{$client} = login tie %in_buf, 'Tie::RefHash'; my (%out_buf, $TIME); close STDIN; close STDERR; fork && exit; $|=1; open(LOG_FILE, ">> chat.log"); _log("Server started..."); my $server = IO::Socket::INET->new(LocalPort => $DaemonPort, Listen => 10 ) or die "Can't make server socket: $@n"; my $select = IO::Select->new($server); while (! $shutdown) {     #-- Текущее время     my ($sec,$min,$hour) = localtime(time);     $TIME = sprintf("%02d:%02d", $hour,$min);     #-- Принимаем информацию от клиентов, если такая имеется.     foreach my $client ($select->can_read(0.1)) {         if($client == $server) { #-- Это подключение нового клиента.             $client = $server->accept();             $client->autoflush(1);             $select->add($client);         } else {    #-- Пришли данные от клиента.             my $data = '';             my $rv   = $client->recv($data, POSIX::BUFSIZ, 0);    #-- Читаем данные             unless (defined($rv) && length $data) {        #-- Произошла ошибка при чтении, надо его принудительно отключить                 disconnect($client);                 next;             }             while (($_=index($data, chr(0))) >= 0) {    #-- Разбиваем полученную информацию по символу chr(0)                 push(@{$in_buf{$client}}, substr($data, 0, $_, ''));    #-- И сохраняем в хэше %in_buf                 substr($data, 0, 1, '');             }         }     }     #-- Обрабатываем всю полученную информацию от клиентов     foreach my $client (keys %in_buf) {         foreach my $cmd (@{$in_buf{$client}}) {             my ($out, $no_utf)=goCommand($client, $cmd);    #-- Функция обработки команд             if ($out) {        #-- Есть что сказать в ответ                 if ($no_utf) { $out_buf{$client} .= $out }    #-- Вывод информации с кодированием в utf                 else { $out_buf{$client} .= utf($out) }        #-- Вывод информации без кодирования utf             }         }     }     %in_buf = ();     #-- Отсылаем клиентам все накопившиеся данные     foreach my $client ($select->can_write(0.1)) {    #-- Кто готов принять информацию?         next unless exists $out_buf{$client};        #-- Для тебя ничего нет         my $rv = $client->send("".$out_buf{$client}.chr(0), 0);    #-- Отправляем с завершающим символом chr(0)         unless (defined $rv) {    #-- какая-то транная ошибка             _log("I was told I could write, but I can't.");             next;         }         if ($rv == length($out_buf{$client})+1 or Errno::EINPROGRESS == $! or Errno::EWOULDBLOCK ) {    #-- Удалим тот кусок данных, что клиент удачно получил             substr($out_buf{$client}, 0, $rv) = '';             delete $out_buf{$client} unless length($out_buf{$client});         } else { #-- Ошибка с передачей данных. Клиент отключился? удалить...             disconnect($client);             next;         }     } } $server->close(); close LOG_FILE; _log("Server shutdown"); exit; #-- Выводит на экран тестовую информацию sub _log {   my ($s) = @_;     print LOG_FILE "".(localtime(time))."\t$s\n"; } #-- Отключает клиента sub disconnect {    my $client = shift;     _log("disconnect: $logins{$client}");     my $login = $logins{$client};     #-- Очищаем входящие и исходящие данные по этому клиенту     delete $in_buf{$client};     delete $out_buf{$client};     delete $logins{$client};     #-- удаляем и закрываем коннект     $select->remove($client);     close $client;     #-- посылаем всем остальным уведомление об отключении юзера     if (length($login)>=$min_login_length) {         SendAll("<DEL>$login</DEL>");     } #    $shutdown = 1; } #-- Отсылает сообщение _всем_ подключенным и авторизованным юзерам sub SendAll {   my ($mes) = @_;     foreach my $client (keys %logins) {         $out_buf{$client} .= $mes     } } #-- Отсылает сообщение только указанному юзеру, если таковой имеется sub SendTo {   my ($mes, $name) = @_;     foreach my $client (keys %logins) {         next unless ($logins{$client} eq $name);         $out_buf{$client} .= $mes;         last;     } } #-- Обработка поступившей от клиента команды sub goCommand {   my ($client, $line) = @_; _log("goCommand: $line");     if (index($line, "<LOGIN")==0) {    #-- Залогинивание         if ($line=~/NAME=\"([^\"]+)\"/) {             my $login = $1;             #-- Проверка имени             if ($_ = CheckLogin($login)) { return "<ERROR TEXT=\"$_\"/>" }    #-- Какая-то ошибка в имени, сообщаем об этом             #-- Проверим, нет ли кого с таким именем.             foreach my $client (keys %logins) {                 if (mylc($logins{$client}) eq mylc($login)) {    #-- Такой логин уже занят                     return "<ERROR TEXT=\"Такой логин занят, выберите другой\"/>";                 }             }             #-- Кажется, все в полном порядке. Подключаем...             _log("LOGIN: $login");             SendAll("<ADD>$login</ADD>");             $logins{$client} = $login;             return ("<OK /><LIST>".join(',', values %logins)."</LIST>",1);         }      } elsif (index($line, "<T")==0 and length($logins{$client})>=$min_login_length) {    #-- Добавление сообщения в чат, только для авторизованных         if ($line =~ /(<T[^>]*>)([^<]+<\/T>)/) {             my ($start, $txt) = ($1, "$TIME \[$logins{$client}\] $2");             if (index($txt, 'private [')>0) {    #-- Текст содержит приватные сообщения, значит он отправляется не всем                 while ($txt=~/private \[([^\]]+)\]/g) {    #-- Получаем имена, кому отправлять приватное сообщение                     SendTo("$start$txt", $1) unless ($1 eq $logins{$client});                 }                 $out_buf{$client} .= "$start$txt";    #-- И показать сообщение самому себе             } else {    #-- Текст не содержит приватных сообщений, отсылаем всем в чате без исключения                 SendAll("$start$txt");             }         }     }     return ""; } #-- Проверяет правильность написания имени sub CheckLogin {   my ($login) = shift;     if (length($login)<$min_login_length) {         return "Длина имени не может быть меньше $min_login_length символов";     }     if ($login=~/([;,&<>\"\'\`\#\?\[\]\t\n\(\)\=])/) {    #-- Использование в логине недопустимых символов         return "Недопустимый символ в имени";     }     if ($login=~/^ / or $login=~/ $/) { return "Имя не может начинаться или заканчиваться пробелом"; }     if ($login=~/  /) { return "Имя не может содержать два пробела подряд"; }     if ($login=~/ /) { return "Имя не может содержать пробел вида Alt+0160"; }     return '';    #-- Все OK } #-- Перекодировка русских букв в utf (только так их поймет флешка) sub utf {   my $s = shift;     $s=~s/([А-Яа-яЪЬЁъьё])/win2utf($1)/eg;     return $s; } sub win2utf {    my $s = shift;     my $c208 = chr(208);     my $c209 = chr(209);     if ( (ord($s)>=192) and (ord($s)<=239)) { return $c208.chr(ord($s)-48) }     if ( (ord($s)>=240) and (ord($s)<=255)) { return $c209.chr(ord($s)-112) }     if ($s=="Ё") { return $c208.chr(149) }     if ($s=="ё") { return $c208.chr(181) }     if ($s=="Ъ") { return $c208.chr(172) }     if ($s=="Ь") { return $c208.chr(170) }     if ($s=="ъ") { return $c208.chr(140) }     if ($s=="ь") { return $c208.chr(138) }     return $s; } #== В нижний регистр sub mylc { my $s = shift;   $s =~ tr/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮЁQWERTYUIOPASDFGHJKLZXCVBNM/йцукенгшщзхъфывапролджэячсмитьбюёqwertyuiopasdfghjklzxcvbnm/;   return $s; }

cheops, ты же батя, помоги плз)))