Another bits of refactoring, code-style fixes, etc

.gitignore

@@ -10,3 +10,6 @@ data/lat/**
 TODO
 *.pid
 *.log
+_Deparsed_XSubs.pm
+.idea/**
+.vstags

.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 :(

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

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 ();
 

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 ();
 

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;

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);
 

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';

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;
 	}
 

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,

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';

lib/fisher.pm

@@ -32,7 +32,7 @@ sub fish {
 		'плотву',
 		'зубатку',
 		'солнечную рыбу',
-		'cтарую шину',
+		'старую шину',
 		'скользкую корягу',
 		'лампу джина',
 		'любовное послание в бутылке',

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;

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;

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}

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";

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;

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;
 }

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;

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};