Чат-бот для DC-сервера DBhub на языке Perl (Помогите дописать (готов на 95%))

Модератор: Модераторы разделов

KDimanB
Сообщения: 143
ОС: Debian (squeeze), Slax LiveCD

Чат-бот для DC-сервера DBhub на языке Perl

Сообщение KDimanB »

В общем решил я себе поставить DirectConnect-сервер. Из трёх серверов (DB, Yin, Ptokax) встал только один - DBhub. В общем посмотрел я на его сайте, а плагинов не так и много предлагается самими разработчиками - всего 6 штук =/

Ну в общем захотел я ICQ-бота в чат себе. Решил написать. Perl первый раз в глаза вижу. Программировать вообще немного умею, поэтому что-то более менее как-то по разным посмотрел и что-то написал и даже практически доделал. Встрял на "чтении файлов" - так и не понял как оно осуществляется в итоге.

Суть в чем, я хотел бота, который бы мог отвечать стандартными фразами, лежащими у него в памяти, но при этом уметь пополнять свою базу. Отвечать желательно рандомно, если есть выбор.
Объясняю на пальцах, как это у меня выглядит. Есть база в файле (без пробелов около разделителей, но я вставлю для удобства чтения):

Код: Выделить всё

Пиво .-. Наливай!
Привет .-. И тебе не хворать
Елка .-. Новогодняя ёлка то?
Пиво .-. Пиво я люблю! :)
Пока .-. Удачи!
Привет .-. Как дела?


Вот. И мы пишем боту "Rubik: Привет, товарисч бот!"
А он значит видит слово Привет и видит что оно у него в базе есть, и даже 2 строки таких. Так вот он должен ответить либо "И тебе не хворать", либо "Как дела?". Т.е. рандомно. Хотя мне уже пофиг - хотя бы первый попавшийся ответ выдавался бы :(
Наполнять базу он умеет. Читать я в принципе тоже научился по строке. но когда начинаю считанную строку обрабатывать - всё перестает работать.

Короче говоря, итоговый код вот. Осталось сделать сверку приходящих сообщений и писать одну из фраз в базе:

Код: Выделить всё

#!/usr/bin/perl

# Rubik-bot

# Моя первая Perl-программа. В этом языке практически не разбираюсь.
# Копипастил из кодов и инета. Так что извините за корявость написания кода  =)
# Дополнять, копировать и т.д. никому конечно не воспрещается.
# Просто не забывайте указывать меня в авторах  ^_^
#
# My first Perl-program. My English is bad, but i hope you unerstand me =)
# Code is free-for-all. You can do with it what you want.
# But don't forget write my nick in comments  ^_^
#
# TrenAr
#

### Rubik settings ###
my $bot = "Rubik"; #name of your bot
my $uhomedir = `echo ~`;
chop $uhomedir;
my $path = "$uhomedir/.dbhub/scripts/";

# Если в чате новое сообщение
# If a new message in a chat
sub data_arrival() {
my ($user, $data) = @_;

# Ищем - есть ли в чате упоминание ника бота
# Search Bot name in chat
$find = index ($data,$bot);
$findadd = index ($data,"$bot:");

# Если нашли упоминание его ника
# If find his name
if ($find > (-1)) {

# Берем то что написано после его ника, и обработка ":"
# Take the message after bot nick, without ":" if this need
$msg = substr($data,$find + length($bot)+1,length($data) - $find - length($bot));
if ($findadd > (-1)) {$msg = substr($data,$find + length($bot)+2,length($data)- $find - length($bot));}

# Ищем вероятные "определения", т.е " - "
# Find " - "
$st = " - ";
$target = index ($msg,$st);

# Здесь 1 как "защита от "пустых строк"
# Когда находим - разбиваем предложение на 2 части
# 1 it's defence
# When find $st - devine string to two string
if ($target > (1)) {
$part1 = substr($msg,0,$target);
$part2 = substr($msg,$target+length($st),length($msg) - $target - length($st) -1);

# Добавляем строки в файл
# Add strings in file
open MSSG, ">>$path/Rubik-database";
print MSSG "$part1.-.$part2\n";
close MSSG;
odch::data_to_all("<$bot> Ясно |");

} else {

# Проверяем на наличие слов в фразе msg - в нашей базе
# Если есть совпадения - пишем 2 часть фразы.
# Если совпадений на одной слово несколько - пишем первое, а лучше рандомно.
#
# Look at our database and message. If it have equal phrases - $msg = $part1
# (msg - message to our bot; part1 one of words in base)
# then write in chat first phrase which true.
# Or Random - it will be more interesting.

***************************** Вот здесь должна быть обработка базы (чтение) *****************************

# Else End
}

# "If for Rubik" End
}
# DataArrival_End
}

sub main() {
odch::register_script_name($bot);
}


Что я делал:

Значит если туда вставить вот эту штуку:

Код: Выделить всё

open MSSG, "<$path/Rubik-database";
while (<MSSG>) {
read MSSG, $str, 1024;
odch::data_to_all("<$bot> $str |");
}
close MSSG;

Бот выведет содержимое всего файла КРОМЕ 1 строки почему-то.

Ну да ладно, а если начать обработку - не работает вообще ничего :(
Вот если написать даже такой код - обрабатывает только одну строку (вторую, первую он же пропускает):

Код: Выделить всё

open MSSG, "<$path/Rubik-database";
while (<MSSG>) {
read MSSG, $str, 1024;

$search1 = index ($str,".-.");
if ($search1 > (-1)) {
$otvet1 = substr($str,0,$search1);
odch::data_to_all("<$bot> $otvet1 |");

}
#while End
}
close MSSG;


А вот этот даже в принципе работает, если бы не одно но. Я не знаю как считать именно строку - он считывает по 1024 символа, а если их не указывать - не запускается вообще. А строки конечно разной длины :(

Код: Выделить всё

open MSSG, "<$path/Rubik-database";
while (<MSSG>) {
read MSSG, $str, 1024;

$search1 = index ($str,".-.");
if ($search1 > (-1)) {
$otvet1 = substr($str,0,$search1);
$search2 = index ($msg,$otvet1);
if ($search2 > (-1)) {
$otvet2 = substr($str,$search1 + 3,length($str) - $search1 - 3);
$search3 = index ($otvet2,"\n");
$otvet3 = substr($otvet2,0,$search3);
odch::data_to_all("<$bot> $otvet3 |");
}
}

#while End
}
close MSSG;


В общем суть в том, как заставить Perl считывать построчно, а не по 1024-символа.
Спасибо сказали:
KDimanB
Сообщения: 143
ОС: Debian (squeeze), Slax LiveCD

Re: Чат-бот для DC-сервера DBhub на языке Perl

Сообщение KDimanB »

Во! Сделал! ^_^
Теперь читает и записывает фиксированное кол-во символов - по другому не знаю как.
Еще бы как бота по-русски назвать бы, а то неудобно в чате постоянно переключать раскладку =/
Итого выглядит так:

Код: Выделить всё

#!/usr/bin/perl

# Rubik-bot

# Моя первая Perl-программа. В этом языке практически не разбираюсь.
# Копипастил из кодов и инета. Так что извините за корявость написания кода  =)
# Дополнять, копировать и т.д. никому не воспрещается.
# Просто не забывайте указывать меня в авторах  ^_^
#
# My first Perl-program. My English is bad, but i hope you unerstand me =)
# Code is free-for-all. You can do with it what you want.
# But don't forget write my nick in comments  ^_^
#
# TrenAr
#

### Rubik settings ###
my $bot = "Rubik"; #name of your bot
my $uhomedir = `echo ~`;
chop $uhomedir;
my $path = "$uhomedir/.dbhub/scripts/";

# Если в чате новое сообщение
# If a new message in a chat
sub data_arrival() {
my ($user, $data) = @_;

# Ищем - есть ли в чате упоминание ника бота
# Search Bot name in chat
$find = index ($data,$bot);
$findadd = index ($data,"$bot:");

# Если нашли упоминание его ника
# If find his name
if ($find > (-1)) {

# Берем то что написано после его ника, и обработка ":"
# Take the message after bot nick, without ":" if this need
$msg = substr($data,$find + length($bot)+1,length($data) - $find - length($bot));
if ($findadd > (-1)) {$msg = substr($data,$find + length($bot)+2,length($data)- $find - length($bot));}

# Ищем вероятные "определения", т.е " - "
# Find " - "
$st = " - ";
$target = index ($msg,$st);

# Здесь 1 как "защита от "пустых строк"
# Когда находим - разбиваем предложение на 2 части
# 1 it's defence
# When find $st - devine string to two string
if ($target > (1)) {
$part1 = substr($msg,0,$target);
$part2 = substr($msg,$target+length($st),length($msg) - $target - length($st) -1);

# Добавляем строки в файл
# Add strings in file
open MSSG, ">>$path/Rubik-database";
print MSSG "$part1.-.$part2";
for ($index = 0; $index <= 128 - length($part1) - length($part2) - 3; $index++)
{print MSSG "*";}
print MSSG "\n";
close MSSG;
odch::data_to_all("<$bot> Ясно |");

} else {

# Проверяем на наличие слов в фразе msg - в нашей базе
# Если есть совпадения - пишем 2 часть фразы.
# Если совпадений на одной слово несколько - пишем первое, а лучше рандомно.
#
# Look at our database and message. If it have equal phrases - $msg = $part1
# (msg - message to our bot; part1 one of words in base)
# then write in chat first phrase which true.
# Or Random - it will be more interesting.

open MSSG, "<$path/Rubik-database";
while (<MSSG>) {
read MSSG, $str, 128;

$search1 = index ($str,".-.");
if ($search1 > (-1)) {
$otvet1 = substr($str,0,$search1);
$search2 = index ($msg,$otvet1);
if ($search2 > (-1)) {
$otvet2 = substr($str,$search1 + 3,length($str) - $search1 - 3);
$search3 = index ($otvet2,"**");
$otvet3 = substr($otvet2,0,$search3);
odch::data_to_all("<$bot> $user $otvet3 |");
}
}

#while End
}
close MSSG;

}

# "If for Rubik" End
}
# DataArrival_End
}

sub main() {
odch::register_script_name($bot);
}
Спасибо сказали: