eleksir/aleesa-jabber-bot
1
Fork 0
Code Activity

Dee-Jay files around, rename subs according perlcritic convertions, update .gitignore

Browse Source
This commit is contained in:
eleksir
2021-03-27 13:14:58 +03:00
parent cf88be06db
commit 91888e1c24
26 changed files with 142 additions and 148 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@@ -5,6 +5,7 @@ data/*.sqlite
data/cache/** data/cache/**
data/fortune/** data/fortune/**
data/friday/** data/friday/**
data/image/**
data/karma/** data/karma/**
data/lat/** data/lat/**
TODO TODO

8
bin/aleesa-jabber-bot
View File

@@ -31,8 +31,8 @@ use File::Path qw (make_path);
use File::Basename qw (basename dirname); use File::Basename qw (basename dirname);
use Log::Any::Adapter; use Log::Any::Adapter;
use Log::Any::For::Std; use Log::Any::For::Std;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use jabberbot qw (run_jabberbot); use JabberBot qw (RunJabberBot);
sub daemonize (); sub daemonize ();
sub __fork (); sub __fork ();
@@ -42,7 +42,7 @@ local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $UID; my $runAsUid = $UID;
my $piddir = '/var/run/' . basename (abs_path $PROGRAM_NAME); my $piddir = '/var/run/' . basename (abs_path $PROGRAM_NAME);
my $C = loadConf (); my $C = LoadConf ();
my $logfile; my $logfile;
if (defined $C->{'log'}) { if (defined $C->{'log'}) {
@@ -114,7 +114,7 @@ local $SIG{TERM} = \&__signal_handler;
# set correct proctitle # set correct proctitle
$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars) $PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars)
run_jabberbot (); RunJabberBot ();
if (-f $pidfile) { if (-f $pidfile) {
unlink $pidfile; unlink $pidfile;

4
bin/flickr_init.pl
View File

@@ -20,9 +20,9 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use flickr qw (flickr_init); use BotLib::Image::Flickr qw (FlickrInit);
if (flickr_init ()) { if (FlickrInit ()) {
exit 0; exit 0;
} else { } else {
exit 1; exit 1;

4
bin/fortune_seed.pl
View File

@@ -21,8 +21,8 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use fortune qw (seed); use BotLib::Fortune qw (Seed);
seed (); Seed ();
exit 0; exit 0;

4
bin/friday_seed.pl
View File

@@ -20,8 +20,8 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use friday qw (seed); use BotLib::Friday qw (Seed);
seed (); Seed ();
exit 0; exit 0;

4
bin/train_lat.pl
View File

@@ -20,7 +20,7 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use lat qw (train); use Lat qw (Train);
train (); Train ();
exit 0; exit 0;

1
cpanfile
View File

@@ -14,6 +14,7 @@ requires 'IO::Socket::SSL';
requires 'POSIX'; requires 'POSIX';
requires 'Text::Fuzzy'; requires 'Text::Fuzzy';
requires 'URI::URL'; requires 'URI::URL';
requires 'URI::Encode::XS';
requires 'local::lib'; requires 'local::lib';
requires 'Log::Any'; requires 'Log::Any';
requires 'Log::Any::Adapter'; requires 'Log::Any::Adapter';

82
lib/botlib.pm → lib/BotLib.pm
View File

@@ -1,6 +1,4 @@
package botlib; package BotLib;
# TODO: исправить #/bin/bash и #/bin/env
# TODO: добавить сов и кроликов flickr и imgur
use 5.018; use 5.018;
use strict; use strict;
@@ -10,30 +8,30 @@ use open qw (:std :utf8);
use English qw ( -no_match_vars ); use English qw ( -no_match_vars );
use Carp qw (carp); use Carp qw (carp);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use archeologist qw (dig); use BotLib::Archeologist qw (Dig);
use buni qw (buni); use BotLib::Buni qw (Buni);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use drink qw (drink); use BotLib::Drink qw (Drink);
use fisher qw (fish); use BotLib::Fisher qw (Fish);
use fortune qw (fortune); use BotLib::Fortune qw (Fortune);
use fox qw (fox); use BotLib::Fox qw (Fox);
use friday qw (friday); use BotLib::Friday qw (Friday);
use image wq (rabbit owl); use BotLib::Image qw (Rabbit Owl);
use karma qw (karmaGet); use BotLib::Karma qw (KarmaGet);
use kitty qw (kitty); use BotLib::Kitty qw (Kitty);
use lat qw (latAnswer); use BotLib::Lat qw (Lat);
use monkeyuser qw (monkeyuser); use BotLib::Monkeyuser qw (Monkeyuser);
use util qw (trim utf2sha1); use BotLib::Util qw (trim utf2sha1);
use weather qw (weather); use BotLib::Weather qw (Weather);
use xkcd qw (xkcd); use BotLib::Xkcd qw (Xkcd);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw(import); use Exporter qw (import);
our @EXPORT_OK = qw(command randomCommonPhrase realjid); our @EXPORT_OK = qw (Command RandomCommonPhrase RealJID);
my $c = loadConf (); my $c = LoadConf ();
sub randomCommonPhrase () { sub RandomCommonPhrase () {
my @myphrase = ( my @myphrase = (
'Так, блядь...', 'Так, блядь...',
'*Закатывает рукава* И ради этого ты меня позвал?', '*Закатывает рукава* И ради этого ты меня позвал?',
@@ -50,11 +48,11 @@ sub randomCommonPhrase () {
return $myphrase[irand ($#myphrase + 1)]; return $myphrase[irand ($#myphrase + 1)];
} }
sub command { sub Command {
my %hash = @_; my %hash = @_;
my $bot = $hash{bot_object}; my $bot = $hash{bot_object};
my $text = $hash{body}; my $text = $hash{body};
my %jid = realjid (%hash); my %jid = RealJID (%hash);
my $chattername = $jid{'name'}; my $chattername = $jid{'name'};
my $chatid; my $chatid;
@@ -180,7 +178,7 @@ sub command {
$reply = '/me наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, ' . $bot->{'alias'} . ' размешивает оплавившийся кубик в абсенте и подносит стопку ' . $target . '.'; $reply = '/me наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, ' . $bot->{'alias'} . ' размешивает оплавившийся кубик в абсенте и подносит стопку ' . $target . '.';
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') { } elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
my $city = substr $text, 2; my $city = substr $text, 2;
$reply = weather ($city) =~ tr/\n/ /r; $reply = Weather ($city) =~ tr/\n/ /r;
} elsif (substr ($text, 1) eq 'version' || substr ($text, 1) eq 'ver') { } elsif (substr ($text, 1) eq 'version' || substr ($text, 1) eq 'ver') {
$reply = 'Версия нуль.чего-то_там.чего-то_там'; $reply = 'Версия нуль.чего-то_там.чего-то_там';
} elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') { } elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') {
@@ -214,27 +212,27 @@ ${csign}xkcd - комикс-стрип с xkcb.ru
EOL EOL
} elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') { } elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') {
$reply = latAnswer (); $reply = Lat ();
} elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') { } elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') {
$reply = kitty (); $reply = Kitty ();
} elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') { } elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') {
$reply = fox (); $reply = Fox ();
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') { } elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
$reply = dig ($chattername); $reply = Dig ($chattername);
} elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fisher' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка') { } elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fisher' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка') {
$reply = fish ($chattername); $reply = Fish ($chattername);
} elsif (substr ($text, 1) eq 'buni') { } elsif (substr ($text, 1) eq 'buni') {
$reply = buni (); $reply = Buni ();
} elsif (substr ($text, 1) eq 'xkcd') { } elsif (substr ($text, 1) eq 'xkcd') {
$reply = xkcd (); $reply = Xkcd ();
} elsif (substr ($text, 1) eq 'monkeyuser') { } elsif (substr ($text, 1) eq 'monkeyuser') {
$reply = monkeyuser (); $reply = Monkeyuser ();
} elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') { } elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') {
$reply = drink (); $reply = Drink ();
} elsif (substr ($text, 1) eq 'bunny' || substr ($text, 1) eq 'rabbit' || substr ($text, 1) eq 'кролик') { } elsif (substr ($text, 1) eq 'bunny' || substr ($text, 1) eq 'rabbit' || substr ($text, 1) eq 'кролик') {
$reply = rabbit (); $reply = Rabbit ();
} elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') { } elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') {
$reply = owl (); $reply = Owl ();
} elsif ((length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) || substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма') { } elsif ((length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) || substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма') {
my $mytext = ''; my $mytext = '';
@@ -246,11 +244,11 @@ EOL
$mytext = ''; $mytext = '';
} }
$reply = karmaGet ($chatid, $mytext); $reply = KarmaGet ($chatid, $mytext);
} elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') { } elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') {
$reply = friday (); $reply = Friday ();
} elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') { } elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') {
my $phrase = fortune (); my $phrase = Fortune ();
# workaround Net::Jabber::Bot outgoing message ![:print:] replacement # workaround Net::Jabber::Bot outgoing message ![:print:] replacement
$phrase =~ s/\s\s+\-\-/\n \-\-/xmsg; $phrase =~ s/\s\s+\-\-/\n \-\-/xmsg;
$reply = $phrase; $reply = $phrase;
@@ -269,15 +267,13 @@ EOL
$reply = ':)'; $reply = ':)';
} elsif (substr ($text, 1) eq '=)' || substr ($text, 1) eq ':)' || substr ($text, 1) eq '(:') { } elsif (substr ($text, 1) eq '=)' || substr ($text, 1) eq ':)' || substr ($text, 1) eq '(:') {
$reply = ':D'; $reply = ':D';
} elsif (substr ($text, 1, 11) eq '#/bin/bash' || substr ($text, 1, 9) eq '#/bin/sh' || substr ($text, 1, 14) eq '#/usr/bin/env') {
$reply = 'Кажется, вы ошиблись окном, это не паста.';
} }
return $reply; return $reply;
} }
# in this particular case real jid is really hidden :) and i hope that i found where it is hiding. # in this particular case real jid is really hidden :) and i hope that i found where it is hiding.
sub realjid { sub RealJID {
my %hash = @_; my %hash = @_;
my $bot = $hash{'bot_object'}; my $bot = $hash{'bot_object'};
my $myjid = $hash{'from_full'}; # in case of real jid myjid is name@server/resource in case of "groupchat" jid it is group@conf_server/name my $myjid = $hash{'from_full'}; # in case of real jid myjid is name@server/resource in case of "groupchat" jid it is group@conf_server/name

6
lib/archeologist.pm → lib/BotLib/Archeologist.pm
View File

@@ -1,4 +1,4 @@
package archeologist; package BotLib::Archeologist;
use 5.018; use 5.018;
use strict; use strict;
@@ -10,9 +10,9 @@ use Math::Random::Secure qw (irand);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (dig); our @EXPORT_OK = qw (Dig);
sub dig { sub Dig {
my $name = shift; my $name = shift;
my @artifact = ( my @artifact = (

6
lib/buni.pm → lib/BotLib/Buni.pm
View File

@@ -1,4 +1,4 @@
package buni; package BotLib::Buni;
use 5.018; use 5.018;
use strict; use strict;
@@ -12,9 +12,9 @@ use HTML::TokeParser;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (buni); our @EXPORT_OK = qw (Buni);
sub buni { sub Buni {
my $r; my $r;
my $ret = 'Нету Buni'; my $ret = 'Нету Buni';

6
lib/conf.pm → lib/BotLib/Conf.pm
View File

@@ -1,4 +1,4 @@
package conf; package BotLib::Conf;
# loads config # loads config
use 5.018; use 5.018;
@@ -11,9 +11,9 @@ use JSON::XS;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw(import); use Exporter qw(import);
our @EXPORT_OK = qw(loadConf); our @EXPORT_OK = qw(LoadConf);
sub loadConf { sub LoadConf {
my $c = 'data/config.json'; my $c = 'data/config.json';
open my $CH, '<', $c or die "[FATA] No conf at $c: $OS_ERROR\n"; open my $CH, '<', $c or die "[FATA] No conf at $c: $OS_ERROR\n";
my $len = (stat $c) [7]; my $len = (stat $c) [7];

6
lib/drink.pm → lib/BotLib/Drink.pm
View File

@@ -1,4 +1,4 @@
package drink; package BotLib::Drink;
use 5.018; use 5.018;
use strict; use strict;
@@ -13,11 +13,11 @@ use HTML::TokeParser;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (drink drink2); our @EXPORT_OK = qw (Drink Drink2);
my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr); my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr);
sub drink { sub Drink {
my $r; my $r;
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.'; my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
my ($dayNum, $monthNum) = (localtime ())[3, 4]; my ($dayNum, $monthNum) = (localtime ())[3, 4];

6
lib/fisher.pm → lib/BotLib/Fisher.pm
View File

@@ -1,4 +1,4 @@
package fisher; package BotLib::Fisher;
use 5.018; use 5.018;
use strict; use strict;
@@ -10,10 +10,10 @@ use Math::Random::Secure qw (irand);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (fish); our @EXPORT_OK = qw (Fish);
sub fish { sub Fish {
my $name = shift; my $name = shift;
my @artifact = ( my @artifact = (

12
lib/fortune.pm → lib/BotLib/Fortune.pm
View File

@@ -1,4 +1,4 @@
package fortune; package BotLib::Fortune;
# Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimiters. # Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimiters.
use 5.018; use 5.018;
@@ -12,17 +12,17 @@ use SQLite_File;
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use MIME::Base64; use MIME::Base64;
use File::Path qw (make_path); use File::Path qw (make_path);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (seed fortune); our @EXPORT_OK = qw (Seed Fortune);
my $c = loadConf (); my $c = LoadConf ();
my $dir = $c->{fortune}->{dir}; my $dir = $c->{fortune}->{dir};
my $srcdir = $c->{fortune}->{srcdir}; my $srcdir = $c->{fortune}->{srcdir};
sub seed () { sub Seed () {
unless (-d $dir) { unless (-d $dir) {
make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; make_path ($dir) || croak "Unable to create $dir: $OS_ERROR";
} }
@@ -65,7 +65,7 @@ sub seed () {
} }
# just return answer # just return answer
sub fortune () { sub Fortune () {
my $backingfile = sprintf '%s/fortune.sqlite', $dir; my $backingfile = sprintf '%s/fortune.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do { tie my @array, 'SQLite_File', $backingfile || do {

8
lib/fox.pm → lib/BotLib/Fox.pm
View File

@@ -1,4 +1,4 @@
package fox; package BotLib::Fox;
use 5.018; use 5.018;
use strict; use strict;
@@ -12,10 +12,10 @@ use HTTP::Tiny;
use vars qw/$VERSION/; use vars qw/$VERSION/;
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (fox); our @EXPORT_OK = qw (Fox);
$VERSION = '1.0'; $VERSION = '1.0';
sub fox { sub Fox {
my $r; my $r;
my $ret = 'Нету лисичек, все разбежались.'; my $ret = 'Нету лисичек, все разбежались.';
@@ -36,7 +36,7 @@ sub fox {
}; };
unless (defined $jfox) { unless (defined $jfox) {
cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR"; carp "[ERROR] Unable to decode JSON: $EVAL_ERROR";
} else { } else {
if ($jfox->{image}) { if ($jfox->{image}) {
$jfox->{image} =~ s/\\//xmsg; $jfox->{image} =~ s/\\//xmsg;

12
lib/friday.pm → lib/BotLib/Friday.pm
View File

@@ -1,4 +1,4 @@
package friday; package BotLib::Friday;
# for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt # for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt
use 5.018; use 5.018;
@@ -11,18 +11,18 @@ use Carp qw (carp croak);
use File::Path qw (make_path); use File::Path qw (make_path);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use SQLite_File; use SQLite_File;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (seed friday); our @EXPORT_OK = qw (Seed Friday);
my $c = loadConf (); my $c = LoadConf ();
my $dir = $c->{friday}->{dir}; my $dir = $c->{friday}->{dir};
my $srcfile = $c->{friday}->{src}; my $srcfile = $c->{friday}->{src};
my @dow = qw (monday tuesday wednesday thursday friday saturday sunday); my @dow = qw (monday tuesday wednesday thursday friday saturday sunday);
sub seed () { sub Seed () {
unless (-d $dir) { unless (-d $dir) {
make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; make_path ($dir) || croak "Unable to create $dir: $OS_ERROR";
} }
@@ -75,7 +75,7 @@ sub seed () {
} }
# just return answer # just return answer
sub friday () { sub Friday () {
my $today = (localtime (time))[6] - 1; my $today = (localtime (time))[6] - 1;
my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today]; my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today];

18
lib/image.pm → lib/BotLib/Image.pm
View File

@@ -1,23 +1,19 @@
package image; package BotLib::Image;
use 5.018; use 5.018;
use strict; use strict;
use warnings; use warnings;
use utf8; use utf8;
use open qw (:std :utf8); use open qw (:std :utf8);
use flickr qw (flickr_by_tags); use BotLib::Image::Flickr qw (FlickrByTags);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (rabbit owl); our @EXPORT_OK = qw (Rabbit Owl);
my $c = loadConf (); sub Rabbit {
my $dir = $c->{image}->{dir};
sub rabbit {
# rabbit, but bunny # rabbit, but bunny
my $url = flickr_by_tags ('animal,bunny'); my $url = FlickrByTags ('animal,bunny');
if (defined $url) { if (defined $url) {
return $url; return $url;
@@ -26,8 +22,8 @@ sub rabbit {
} }
} }
sub owl { sub Owl {
my $url = flickr_by_tags ('bird,owl'); my $url = FlickrByTags ('bird,owl');
if (defined $url) { if (defined $url) {
return $url; return $url;

18
lib/flickr.pm → lib/BotLib/Image/Flickr.pm
View File

@@ -1,4 +1,4 @@
package flickr; package BotLib::Image::Flickr;
use 5.018; use 5.018;
use strict; use strict;
@@ -16,16 +16,16 @@ use MIME::Base64;
use SQLite_File; use SQLite_File;
use URI::Encode::XS qw (uri_encode); use URI::Encode::XS qw (uri_encode);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use util qw (urlencode); use BotLib::Util qw (urlencode);
use Data::Dumper; use Data::Dumper;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (flickr_init flickr_by_tags flickr_by_text flickr_test_login); our @EXPORT_OK = qw (FlickrInit FlickrByTags FlickrByText FlickrTestLogin);
my $c = loadConf (); my $c = LoadConf ();
my $dir = $c->{image}->{dir}; my $dir = $c->{image}->{dir};
my $flickr_consumer_key = $c->{image}->{flickr}->{consumer_key}; my $flickr_consumer_key = $c->{image}->{flickr}->{consumer_key};
@@ -464,7 +464,7 @@ sub flickrSearchByTags {
} }
} }
sub flickr_init { sub FlickrInit {
my $backingfile = sprintf '%s/secrets.sqlite', $dir; my $backingfile = sprintf '%s/secrets.sqlite', $dir;
unless (-d $dir) { unless (-d $dir) {
@@ -527,7 +527,7 @@ sub flickr_init {
return 0; return 0;
} }
sub flickr_test_login { sub FlickrTestLogin {
my $text = shift; my $text = shift;
my $backingfile = sprintf '%s/secrets.sqlite', $dir; my $backingfile = sprintf '%s/secrets.sqlite', $dir;
@@ -554,7 +554,7 @@ sub flickr_test_login {
} }
} }
sub flickr_by_tags { sub FlickrByTags {
my $text = shift; my $text = shift;
my $backingfile = sprintf '%s/secrets.sqlite', $dir; my $backingfile = sprintf '%s/secrets.sqlite', $dir;
@@ -595,7 +595,7 @@ sub flickr_by_tags {
} }
} }
sub flickr_by_text { sub FlickrByText {
my $text = shift; my $text = shift;
my $backingfile = sprintf '%s/secrets.sqlite', $dir; my $backingfile = sprintf '%s/secrets.sqlite', $dir;

14
lib/karma.pm → lib/BotLib/Karma.pm
View File

@@ -1,4 +1,4 @@
package karma; package BotLib::Karma;
use 5.018; use 5.018;
use strict; use strict;
@@ -9,19 +9,19 @@ use English qw ( -no_match_vars );
use Carp qw (carp); use Carp qw (carp);
use DB_File; use DB_File;
use File::Path qw (make_path); use File::Path qw (make_path);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use util qw (utf2sha1 trim); use BotLib::Util qw (utf2sha1 trim);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (karmaSet karmaGet); our @EXPORT_OK = qw (KarmaSet KarmaGet);
my $c = loadConf (); my $c = LoadConf ();
my $karmadir = $c->{karma}->{dir}; my $karmadir = $c->{karma}->{dir};
my $max = 5; my $max = 5;
# swallow phrase and return answer # swallow phrase and return answer
sub karmaSet (@) { sub KarmaSet (@) {
my $chatid = shift; my $chatid = shift;
my $phrase = shift; my $phrase = shift;
my $action = shift; my $action = shift;
@@ -84,7 +84,7 @@ sub karmaSet (@) {
} }
# just return answer # just return answer
sub karmaGet (@) { sub KarmaGet (@) {
my $chatid = shift; my $chatid = shift;
my $phrase = shift; my $phrase = shift;
$phrase = trim $phrase; $phrase = trim $phrase;

6
lib/kitty.pm → lib/BotLib/Kitty.pm
View File

@@ -1,4 +1,4 @@
package kitty; package BotLib::Kitty;
use 5.018; use 5.018;
use strict; use strict;
@@ -12,9 +12,9 @@ use HTTP::Tiny;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (kitty); our @EXPORT_OK = qw (Kitty);
sub kitty { sub Kitty {
my $r; my $r;
my $ret = 'Нету кошечек, все разбежались.'; my $ret = 'Нету кошечек, все разбежались.';

12
lib/lat.pm → lib/BotLib/Lat.pm
View File

@@ -1,4 +1,4 @@
package lat; package BotLib::Lat;
# famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений # famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений
use 5.018; use 5.018;
@@ -11,17 +11,17 @@ use Carp qw (carp);
use File::Basename qw (dirname); use File::Basename qw (dirname);
use File::Path qw (make_path); use File::Path qw (make_path);
use Hailo; use Hailo;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (train latAnswer); our @EXPORT_OK = qw (Train Lat);
my $c = loadConf (); my $c = LoadConf ();
my $brain = $c->{lat}->{brain}; my $brain = $c->{lat}->{brain};
my $srcfile = $c->{lat}->{src}; my $srcfile = $c->{lat}->{src};
sub train () { sub Train () {
my $braindir = dirname $brain; my $braindir = dirname $brain;
unless (-d $braindir) { unless (-d $braindir) {
@@ -45,7 +45,7 @@ sub train () {
} }
# just return answer # just return answer
sub latAnswer () { sub Lat () {
my $braindir = dirname $brain; my $braindir = dirname $brain;
unless (-d $braindir) { unless (-d $braindir) {

6
lib/monkeyuser.pm → lib/BotLib/Monkeyuser.pm
View File

@@ -1,4 +1,4 @@
package monkeyuser; package BotLib::Monkeyuser;
use 5.018; use 5.018;
use strict; use strict;
@@ -13,9 +13,9 @@ use Math::Random::Secure qw (irand);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (monkeyuser); our @EXPORT_OK = qw (Monkeyuser);
sub monkeyuser { sub Monkeyuser {
my $r; my $r;
my $ret = 'Нету Monkey User-ов, они все спрятались.'; my $ret = 'Нету Monkey User-ов, они все спрятались.';
my @link; my @link;

2
lib/util.pm → lib/BotLib/Util.pm
View File

@@ -1,4 +1,4 @@
package util; package BotLib::Util;
use 5.018; use 5.018;
use strict; use strict;

12
lib/weather.pm → lib/BotLib/Weather.pm
View File

@@ -1,4 +1,4 @@
package weather; package BotLib::Weather;
use 5.018; use 5.018;
use strict; use strict;
@@ -12,16 +12,16 @@ use Digest::MD5 qw (md5_base64);
use File::Path qw (make_path); use File::Path qw (make_path);
use HTTP::Tiny; use HTTP::Tiny;
use JSON::XS; use JSON::XS;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use util qw (trim urlencode); use BotLib::Util qw (trim urlencode);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (weather); our @EXPORT_OK = qw (Weather);
my $c = loadConf (); my $c = LoadConf ();
sub weather { sub Weather {
my $city = shift; my $city = shift;
$city = trim $city; $city = trim $city;

6
lib/xkcd.pm → lib/BotLib/Xkcd.pm
View File

@@ -1,4 +1,4 @@
package xkcd; package BotLib::Xkcd;
use 5.018; use 5.018;
use strict; use strict;
@@ -9,9 +9,9 @@ use HTTP::Tiny;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (xkcd); our @EXPORT_OK = qw (Xkcd);
sub xkcd { sub Xkcd {
my $http = HTTP::Tiny->new (timeout => 5, max_redirect => 0); my $http = HTTP::Tiny->new (timeout => 5, max_redirect => 0);
my $r = $http->get ('https://xkcd.ru/random/'); my $r = $http->get ('https://xkcd.ru/random/');

26
lib/jabberbot.pm → lib/JabberBot.pm
View File

@@ -1,7 +1,7 @@
# note http://www.gentoo.ru/node/21449 # note http://www.gentoo.ru/node/21449
# необходимо закомментировать строку $response{authzid} = $authzid; # необходимо закомментировать строку $response{authzid} = $authzid;
# в vendor_perl/5.24.3/Authen/SASL/Perl/DIGEST_MD5.pm # в vendor_perl/5.24.3/Authen/SASL/Perl/DIGEST_MD5.pm
package jabberbot; package JabberBot;
use 5.018; use 5.018;
use strict; use strict;
@@ -13,16 +13,16 @@ use Carp qw(carp);
use File::Path qw (make_path); use File::Path qw (make_path);
use Hailo; use Hailo;
use Net::Jabber::Bot; use Net::Jabber::Bot;
use botlib qw (command randomCommonPhrase realjid); use BotLib qw (Command RandomCommonPhrase RealJID);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use karma qw (karmaSet); use BotLib::Karma qw (KarmaSet);
use util qw (trim utf2sha1); use BotLib::Util qw (trim utf2sha1);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (run_jabberbot); our @EXPORT_OK = qw (RunJabberBot);
my $c = loadConf (); my $c = LoadConf ();
my $hailo; my $hailo;
my $imonline = 0; my $imonline = 0;
@@ -47,8 +47,7 @@ sub __new_bot_message {
} }
my $text = $hash{body}; my $text = $hash{body};
my %jid = RealJID (%hash);
my %jid = realjid %hash;
my $chattername = $jid{'name'}; my $chattername = $jid{'name'};
my $chatid; my $chatid;
@@ -93,14 +92,12 @@ sub __new_bot_message {
$reply = 'Чего тебе?'; $reply = 'Чего тебе?';
} elsif (($text =~ /^$qname[\,|\:]? (.+)/) && ($hash{'type'} eq 'groupchat')) { } elsif (($text =~ /^$qname[\,|\:]? (.+)/) && ($hash{'type'} eq 'groupchat')) {
$reply = $hailo->{$chatid}->learn_reply ($1); $reply = $hailo->{$chatid}->learn_reply ($1);
} elsif (substr ($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
$reply = command %hash;
# karma adjustment # karma adjustment
} elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') { } elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') {
my @arr = split /\n/, $text; my @arr = split /\n/, $text;
if ($#arr < 1) { if ($#arr < 1) {
$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); $reply = KarmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
} else { } else {
# just message in chat # just message in chat
# in groupchat we answer only to phrases that mention us # in groupchat we answer only to phrases that mention us
@@ -111,6 +108,8 @@ sub __new_bot_message {
$reply = $hailo->{$chatid}->learn_reply ($text); $reply = $hailo->{$chatid}->learn_reply ($text);
} }
} }
} elsif (substr ($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
$reply = Command (%hash);
# just message in chat # just message in chat
} else { } else {
# in groupchat we answer only to phrases that mention us # in groupchat we answer only to phrases that mention us
@@ -134,7 +133,7 @@ sub __new_bot_message {
} }
sub run_jabberbot { sub RunJabberBot {
my %conflist = (); my %conflist = ();
$conflist{$c->{jabberbot}->{aleesa}->{room}} = []; $conflist{$c->{jabberbot}->{aleesa}->{room}} = [];
my $qname = quotemeta $c->{jabberbot}->{aleesa}->{mucname}; my $qname = quotemeta $c->{jabberbot}->{aleesa}->{mucname};
@@ -173,6 +172,7 @@ sub run_jabberbot {
return; return;
} }
1; 1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: # vim: set ft=perl noet ai ts=4 sw=4 sts=4: