From c619e475608b47078dc2fead84105449bbda8298 Mon Sep 17 00:00:00 2001 From: Sergei Fedosov Date: Mon, 8 Feb 2021 18:01:03 +0300 Subject: [PATCH] Another bits of refactoring, code-style fixes, etc --- .gitignore | 3 +++ .perlcriticrc | 10 +++++----- README.md | 2 +- bin/fortune_seed.pl | 12 ++++++------ bin/friday_seed.pl | 9 ++++----- bin/train_lat.pl | 9 ++++----- confcheck.pl | 12 ++++++------ cpanfile | 1 + lib/archeologist.pm | 18 +++++++++--------- lib/botlib.pm | 10 +++++----- lib/conf.pm | 3 +-- lib/fisher.pm | 2 +- lib/fortune.pm | 14 +++++++------- lib/friday.pm | 14 +++++++------- lib/jabberbot.pm | 21 ++++++++++----------- lib/karma.pm | 17 +++++------------ lib/kitty.pm | 3 +-- lib/lat.pm | 5 ++--- lib/util.pm | 3 +-- lib/weather.pm | 7 +++---- 20 files changed, 82 insertions(+), 93 deletions(-) diff --git a/.gitignore b/.gitignore index e486a3e..6dd8346 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,6 @@ data/lat/** TODO *.pid *.log +_Deparsed_XSubs.pm +.idea/** +.vstags \ No newline at end of file diff --git a/.perlcriticrc b/.perlcriticrc index eb42350..d7e31fa 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -35,7 +35,7 @@ verbose = 8 [-ControlStructures::ProhibitPostfixControls] # In short lines we can afford ourselves to use postfix controls -# but ofcorse we should avoid such constructions in long lines. +# but of course we should avoid such constructions in long lines. [-Subroutines::ProhibitSubroutinePrototypes] # Contrary to Perl::Critic we consider prototypes as useful, even if @@ -52,7 +52,7 @@ verbose = 8 [-ValuesAndExpressions::ProhibitEmptyQuotes] # cause we consider following correct and useful: my $var = ''; -# the recomended use of q{} looks too complex: my $var = q{}; +# the recommended use of q{} looks too complex: my $var = q{}; [-ValuesAndExpressions::ProhibitNoisyQuotes] # Other people, other opinions: "," is better readable than qw(,) @@ -64,14 +64,14 @@ verbose = 8 [-NamingConventions::Capitalization] # duh... -# Noone care, really +# Noone cares, really [-ControlStructures::ProhibitUnlessBlocks] # They should not be too complex - only one condition should be checked, # that's all [-Miscellanea::ProhibitTies] -# Just allow it. It's very handy stuff and extremely simple and safe enugh to use. +# Just allow it. It's very handy stuff and extremely simple and safe enough to use. [-ValuesAndExpressions::RequireNumberSeparators] # Not really @@ -97,4 +97,4 @@ lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT # used only in botlib.pm, in this particular case it makes more clean code [-ControlStructures::ProhibitDeepNests] -# jabber bot lib habe very nested structures that a bit fiddle to navigate :( +# jabber bot lib have very nested structures that a bit fiddle to navigate :( diff --git a/README.md b/README.md index e0e3fa1..54891f5 100644 --- a/README.md +++ b/README.md @@ -19,7 +19,7 @@ You'll need "Development Tools" or similar group of packages, perl, perl-devel, perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make. -After installng required dependencies it is possible to run: +After installing required dependencies it is possible to run: ```bash bash bootstrap.sh diff --git a/bin/fortune_seed.pl b/bin/fortune_seed.pl index 35a8e99..9c0c556 100644 --- a/bin/fortune_seed.pl +++ b/bin/fortune_seed.pl @@ -4,16 +4,16 @@ use 5.018; use strict; use warnings; use utf8; -use open qw(:std :utf8); -use English qw( -no_match_vars ); -use vars qw/$VERSION/; -$VERSION = '1.0'; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); + +use version; our $VERSION = qw (1.0); my $workdir; # before we run, change working dir BEGIN { - use Cwd qw(chdir abs_path); + use Cwd qw (chdir abs_path); my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); if ($#CWD > 1) { $#CWD = $#CWD - 2; } $workdir = join '/', @CWD; @@ -21,7 +21,7 @@ BEGIN { } use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); -use fortune qw(seed fortune); +use fortune qw (seed); seed (); diff --git a/bin/friday_seed.pl b/bin/friday_seed.pl index 5c6acfe..b333248 100644 --- a/bin/friday_seed.pl +++ b/bin/friday_seed.pl @@ -4,10 +4,9 @@ use 5.018; use strict; use warnings; use utf8; -use open qw(:std :utf8); -use English qw( -no_match_vars ); -use vars qw/$VERSION/; -$VERSION = '1.0'; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use version; our $VERSION = qw (1.0); my $workdir; @@ -21,7 +20,7 @@ BEGIN { } use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); -use friday qw(seed); +use friday qw (seed); seed (); diff --git a/bin/train_lat.pl b/bin/train_lat.pl index b08e7d5..1d6f8de 100644 --- a/bin/train_lat.pl +++ b/bin/train_lat.pl @@ -4,10 +4,9 @@ use 5.018; use strict; use warnings; use utf8; -use open qw(:std :utf8); -use English qw( -no_match_vars ); -use vars qw/$VERSION/; -$VERSION = '1.0'; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use version; our $VERSION = qw (1.0); my $workdir; @@ -21,7 +20,7 @@ BEGIN { } use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); -use lat qw(train); +use lat qw (train); train (); exit 0; diff --git a/confcheck.pl b/confcheck.pl index 34bfdfd..c2adc42 100755 --- a/confcheck.pl +++ b/confcheck.pl @@ -4,16 +4,16 @@ use 5.018; use strict; use warnings; use utf8; -use open qw(:std :utf8); -use English qw( -no_match_vars ); -use lib qw(./lib ./vendor_perl ./vendor_perl/lib/perl5); +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use lib qw (./lib ./vendor_perl ./vendor_perl/lib/perl5); use JSON::PP; -use version; our $VERSION = qv(1.0); +use version; our $VERSION = qw (1.0); my $c = 'data/config.json'; -open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n"; ## no critic (InputOutput::RequireBriefOpen) -my $len = (stat ($c)) [7]; +open (my $C, '<', $c) || die "No conf at $c: $OS_ERROR\n"; ## no critic (InputOutput::RequireBriefOpen) +my $len = (stat $c) [7]; my $json; my $readlen = read ($C, $json, $len); diff --git a/cpanfile b/cpanfile index b5ffe92..501bb1b 100644 --- a/cpanfile +++ b/cpanfile @@ -18,6 +18,7 @@ requires 'local::lib'; requires 'Log::Any'; requires 'Log::Any::Adapter'; requires 'Log::Any::For::Std'; +requires 'Math::Random::Secure'; # Bundled Net::Jabber::Bot deps # requires 'Net::Jabber::Bot'; diff --git a/lib/archeologist.pm b/lib/archeologist.pm index d03c49c..2848625 100644 --- a/lib/archeologist.pm +++ b/lib/archeologist.pm @@ -6,11 +6,11 @@ use warnings; use utf8; use open qw (:std :utf8); use English qw ( -no_match_vars ); +use Math::Random::Secure qw (irand); -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (dig); -$VERSION = '1.0'; sub dig { my $name = shift; @@ -100,21 +100,21 @@ sub dig { 'на просторах Украины', ); - my $find_probability = int (rand 100); - my $success_probability = int (rand 100); - my $artifact_age = int (rand 15000); + my $find_probability = irand 100; + my $success_probability = irand 100; + my $artifact_age = irand 15000; if ($find_probability <= 20) { - return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[int (rand ($#location + 1))], $name; + return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[irand ($#location + 1)], $name; } - my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[int (rand ($#location + 1))]; + my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)]; $phrase .= "Вам кажется что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n"; if ($success_probability <= 25) { - $phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[int (rand ($#artifact + 1))], $artifact_age; + $phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[irand ($#artifact + 1)], $artifact_age; } else { - $phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[int (rand ($#artifact + 1))], $artifact_age; + $phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[irand ($#artifact + 1)], $artifact_age; $phrase .= sprintf 'Извини %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name; } diff --git a/lib/botlib.pm b/lib/botlib.pm index 35bea46..3276e23 100644 --- a/lib/botlib.pm +++ b/lib/botlib.pm @@ -7,6 +7,7 @@ use utf8; use open qw (:std :utf8); use English qw ( -no_match_vars ); use Carp qw (carp); +use Math::Random::Secure qw (irand); use archeologist qw (dig); use conf qw (loadConf); use fisher qw (fish); @@ -18,10 +19,9 @@ use lat qw (latAnswer); use util qw (trim utf2sha1); use weather qw (weather); -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw(import); our @EXPORT_OK = qw(command randomCommonPhrase realjid); -$VERSION = '1.0'; my $c = loadConf (); @@ -39,7 +39,7 @@ sub randomCommonPhrase () { 'А как ты думаешь?', ); - return $myphrase[int (rand ($#myphrase + 1))]; + return $myphrase[irand ($#myphrase + 1)]; } sub command { @@ -233,7 +233,7 @@ EOL return $reply; } -# in this particular case real jid is really hidden :) and i hope that i found where it is seaking. +# in this particular case real jid is really hidden :) and i hope that i found where it is hiding. sub realjid { my %hash = @_; my $bot = $hash{'bot_object'}; @@ -299,7 +299,7 @@ sub realjid { 'name' => (split (/\//, $myjid))[1], ); } else { - # looks like it is correct real jid, assume that conference server and main server are woking on different domains + # looks like it is correct real jid, assume that conference server and main server reside on different domains # at least i hope that this assumption correct %result = ( 'fulljid' => $myjid, diff --git a/lib/conf.pm b/lib/conf.pm index eccb3a2..df580ed 100644 --- a/lib/conf.pm +++ b/lib/conf.pm @@ -9,10 +9,9 @@ use open qw(:std :utf8); use English qw( -no_match_vars ); use JSON::XS; -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw(import); our @EXPORT_OK = qw(loadConf); -$VERSION = '1.0'; sub loadConf { my $c = 'data/config.json'; diff --git a/lib/fisher.pm b/lib/fisher.pm index 69d5627..1cdbfb8 100644 --- a/lib/fisher.pm +++ b/lib/fisher.pm @@ -32,7 +32,7 @@ sub fish { 'плотву', 'зубатку', 'солнечную рыбу', - 'cтарую шину', + 'старую шину', 'скользкую корягу', 'лампу джина', 'любовное послание в бутылке', diff --git a/lib/fortune.pm b/lib/fortune.pm index e900fd3..1f3ef4c 100644 --- a/lib/fortune.pm +++ b/lib/fortune.pm @@ -1,5 +1,5 @@ package fortune; -# Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter. +# Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimiters. use 5.018; use strict; @@ -9,14 +9,14 @@ use open qw (:std :utf8); use English qw ( -no_match_vars ); use Carp qw (croak carp); use SQLite_File; +use Math::Random::Secure qw (irand); use MIME::Base64; use File::Path qw (make_path); use conf qw (loadConf); -use vars qw/$VERSION/; -use Exporter qw(import); -our @EXPORT_OK = qw(seed fortune); -$VERSION = '1.0'; +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (seed fortune); my $c = loadConf (); my $dir = $c->{fortune}->{dir}; @@ -36,7 +36,7 @@ sub seed () { tie my @fortune, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR\n"; opendir (my $srcdirhandle, $srcdir) || croak "Unable to open $srcdir: $OS_ERROR"; - while (my $fortunefile = readdir ($srcdirhandle)) { + while (my $fortunefile = readdir $srcdirhandle) { my $srcfile = sprintf '%s/%s', $srcdir, $fortunefile; unless (-f $srcfile) { @@ -73,7 +73,7 @@ sub fortune () { return ''; }; - my $phrase = $array[int (rand ($#array - 1))]; + my $phrase = $array[irand ($#array - 1)]; # decode? utf8::decode $phrase; untie @array; diff --git a/lib/friday.pm b/lib/friday.pm index e7da8bf..a6c9de4 100644 --- a/lib/friday.pm +++ b/lib/friday.pm @@ -9,13 +9,13 @@ use open qw (:std :utf8); use English qw ( -no_match_vars ); use Carp qw (carp croak); use File::Path qw (make_path); +use Math::Random::Secure qw (irand); use SQLite_File; use conf qw (loadConf); -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (seed friday); -$VERSION = '1.0'; my $c = loadConf (); my $dir = $c->{friday}->{dir}; @@ -46,9 +46,9 @@ sub seed () { next; } - chomp(); - my ($phrase, $days) = split(/ \|\| /); - my @daylist = split(//, $days); + chomp (); + my ($phrase, $days) = split (/ \|\| /); + my @daylist = split (//, $days); foreach my $day (@daylist) { unless (defined $day) { @@ -59,7 +59,7 @@ sub seed () { next ; } - if (defined $phrase && ($phrase ne '') && ($phrase !~ m/^\s+$/xmsg)) { + if (defined ($phrase) && ($phrase ne '') && ($phrase !~ m/^\s+$/xmsg)) { push @{$friday->[$day - 1]}, $phrase; } } @@ -84,7 +84,7 @@ sub friday () { return ''; }; - my $phrase = $array[int (rand ($#array - 1))]; + my $phrase = $array[irand ($#array - 1)]; # decode? utf8::decode $phrase; untie @array; diff --git a/lib/jabberbot.pm b/lib/jabberbot.pm index 4d6f3f7..f9f83a5 100644 --- a/lib/jabberbot.pm +++ b/lib/jabberbot.pm @@ -1,5 +1,5 @@ # note http://www.gentoo.ru/node/21449 -# необходимо закомменировать строку $response{authzid} = $authzid; +# необходимо закомментировать строку $response{authzid} = $authzid; # в vendor_perl/5.24.3/Authen/SASL/Perl/DIGEST_MD5.pm package jabberbot; @@ -18,9 +18,8 @@ use conf qw (loadConf); use karma qw (karmaSet); use util qw (trim utf2sha1); +use version; our $VERSION = qw (1.0); use Exporter qw (import); -use vars qw/$VERSION/; -$VERSION = '1.0'; our @EXPORT_OK = qw (run_jabberbot); my $c = loadConf (); @@ -49,7 +48,7 @@ sub __new_bot_message { my $text = $hash{body}; - my %jid = realjid (%hash); + my %jid = realjid %hash; my $chattername = $jid{'name'}; my $chatid; @@ -64,7 +63,7 @@ sub __new_bot_message { my $reply; # lazy init chat-bot brains - unless (defined ($hailo->{$chatid})) { + unless (defined $hailo->{$chatid}) { my $braindir = $c->{jabberbot}->{braindir}; my $brainname = sprintf '%s/%s.sqlite', $braindir, $chatid; @@ -88,17 +87,17 @@ sub __new_bot_message { } # parse messages - my $qname = quotemeta ($bot->{'alias'}); + my $qname = quotemeta $bot->{'alias'}; if ($text =~ /^$qname\,?\s*$/) { $reply = 'Чего тебе?'; } elsif (($text =~ /^$qname[\,|\:]? (.+)/) && ($hash{'type'} eq 'groupchat')) { $reply = $hailo->{$chatid}->learn_reply ($1); } elsif (substr ($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) { - $reply = command (%hash); - # karma agjustment + $reply = command %hash; + # karma adjustment } elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') { - my @arr = split(/\n/, $text); + my @arr = split /\n/, $text; if ($#arr < 1) { $reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); @@ -138,7 +137,7 @@ sub __new_bot_message { sub run_jabberbot { my %conflist = (); $conflist{$c->{jabberbot}->{aleesa}->{room}} = []; - my $qname = quotemeta ($c->{jabberbot}->{aleesa}->{mucname}); + my $qname = quotemeta $c->{jabberbot}->{aleesa}->{mucname}; my $bot = Net::Jabber::Bot->new ( server => $c->{jabberbot}->{aleesa}->{host}, @@ -149,7 +148,7 @@ sub run_jabberbot { username => $c->{jabberbot}->{aleesa}->{authname}, # threre is some nasty bug in module, so we have to set from_full explicitly from_full => sprintf ( - "%s@%s/%s", + '%s@%s/%s', $c->{jabberbot}->{aleesa}->{room}, $c->{jabberbot}->{aleesa}->{confsrv}, $c->{jabberbot}->{aleesa}->{authname} diff --git a/lib/karma.pm b/lib/karma.pm index 06b83ed..6f23ee0 100644 --- a/lib/karma.pm +++ b/lib/karma.pm @@ -10,12 +10,11 @@ use Carp qw (carp); use DB_File; use File::Path qw (make_path); use conf qw (loadConf); -use util qw (utf2sha1); +use util qw (utf2sha1 trim); -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (karmaSet karmaGet); -$VERSION = '1.0'; my $c = loadConf (); my $karmadir = $c->{karma}->{dir}; @@ -26,16 +25,13 @@ sub karmaSet (@) { my $chatid = shift; my $phrase = shift; my $action = shift; + $phrase = trim $phrase; my $score = 0; # sha1* does not understand utf8, so explicitly construct string cost of decimal numbers only my $karmafile = utf2sha1 $chatid; $karmafile =~ s/\//-/xmsg; $karmafile = sprintf '%s/%s.db', $karmadir, $karmafile; - if (($phrase eq '') || ($phrase =~ /^ +$/)) { - $phrase = ''; - } - unless (-d $karmadir) { make_path ($karmadir) or do { carp "Unable to create $karmadir: $OS_ERROR"; @@ -45,7 +41,7 @@ sub karmaSet (@) { # init hash, store phrase and score tie my %karma, 'DB_File', $karmafile || do { - carp "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR"; + carp "[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR"; return sprintf 'Карма %s составляет 0', $phrase; }; @@ -91,14 +87,11 @@ sub karmaSet (@) { sub karmaGet (@) { my $chatid = shift; my $phrase = shift; + $phrase = trim $phrase; my $karmafile = utf2sha1 $chatid; $karmafile =~ s/\//-/xmsg; $karmafile = sprintf '%s/%s.db', $karmadir, $karmafile; - if (($phrase eq '') || ($phrase =~ /^ +$/)) { - $phrase = ''; - } - unless (-d $karmadir) { make_path ($karmadir) or do { carp "Unable to create $karmadir: $OS_ERROR"; diff --git a/lib/kitty.pm b/lib/kitty.pm index 0c22f9a..995a89b 100644 --- a/lib/kitty.pm +++ b/lib/kitty.pm @@ -10,10 +10,9 @@ use Carp qw (carp); use JSON::XS; use HTTP::Tiny; -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (kitty); -$VERSION = '1.0'; sub kitty { my $r; diff --git a/lib/lat.pm b/lib/lat.pm index 7f7e417..fece0f3 100644 --- a/lib/lat.pm +++ b/lib/lat.pm @@ -13,10 +13,9 @@ use File::Path qw (make_path); use Hailo; use conf qw (loadConf); -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (train latAnswer); -$VERSION = '1.0'; my $c = loadConf (); my $brain = $c->{lat}->{brain}; @@ -40,7 +39,7 @@ sub train () { $lat->train ($srcfile); my ($tokens, $expressions) = ($lat->stats ())[0,1]; - printf "Total tokens: %s\nTotal expressins: %s\n", $tokens, $expressions; + printf "Total tokens: %s\nTotal expressions: %s\n", $tokens, $expressions; $lat->save (); return; } diff --git a/lib/util.pm b/lib/util.pm index 476219c..47fe003 100644 --- a/lib/util.pm +++ b/lib/util.pm @@ -13,10 +13,9 @@ use MIME::Base64; use Text::Fuzzy qw (distance_edits); use URI::URL; -use vars qw /$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (trim urlencode fmatch utf2b64 utf2sha1); -$VERSION = '1.0'; sub trim { my $str = shift; diff --git a/lib/weather.pm b/lib/weather.pm index 0969556..b4b3a9e 100644 --- a/lib/weather.pm +++ b/lib/weather.pm @@ -15,10 +15,9 @@ use JSON::XS; use conf qw (loadConf); use util qw (trim urlencode); -use vars qw/$VERSION/; +use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (weather); -$VERSION = '1.0'; my $c = loadConf (); @@ -98,7 +97,7 @@ sub __weather { }; # lookup cache - if (defined ($cachetime{$id}) && ($now - $cachetime{$id}) < 10800) { + if (defined ($cachetime{$id}) && (($now - $cachetime{$id}) < 10800)) { $fc = decode_json ($cachedata{$id}); } else { my $r; @@ -141,7 +140,7 @@ sub __weather { untie %cachetime; untie %cachedata; - # TODO: check all of this for existance + # TODO: check all of this for existence $w->{'name'} = $fc->{name}; $w->{'state'} = $fc->{state}; $w->{'country'} = $fc->{sys}->{country};