Use more critic! Also for vendored libs too

lib/Authen/SASL.pm

@@ -1,14 +1,19 @@
+## no critic (Variables::ProhibitPunctuationVars)
 # Copyright (c) 2004-2006 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package Authen::SASL;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
-use vars qw($VERSION @Plugins);
+use warnings;
-use Carp;
+use utf8;
 
-$VERSION = "2.16";
+use vars qw($VERSION @Plugins); ## no critic (Variables::ProhibitPackageVars)
+use Carp qw (croak);
+
+$VERSION = '2.16';
 
 @Plugins = qw(
 	Authen::SASL::XS
@@ -21,9 +26,10 @@ sub import {
   shift;
   return unless @_;
 
-  local $SIG{__DIE__};
+  local $SIG{__DIE__}; ## no critic (Variables::RequireInitializationForLocalVars)
-  @Plugins = grep { /^[:\w]+$/ and eval "require $_" } map { /::/ ? $_ : "Authen::SASL::$_" } @_
+  @Plugins = grep { /^[:\w]+$/ and eval "require $_" } map { /::/ ? $_ : "Authen::SASL::$_" } @_ ## no critic (BuiltinFunctions::ProhibitStringyEval)
-    or croak "no valid Authen::SASL plugins found";
+    or croak 'no valid Authen::SASL plugins found';
+  return;
 }
 
 
@@ -44,13 +50,13 @@ sub new {
   $self->callback(pass => $opt{password}) if exists $opt{password};
   $self->callback(pass => $opt{response}) if exists $opt{response};
 
-  $self;
+  return $self;
 }
 
 
 sub mechanism {
   my $self = shift;
-  @_ ? $self->{mechanism} = shift
+  return @_ ? $self->{mechanism} = shift
      : $self->{mechanism};
 }
 
@@ -62,7 +68,7 @@ sub callback {
   my %new = @_;
   @{$self->{callback}}{keys %new} = values %new;
 
-  $self->{callback};
+  return $self->{callback};
 }
 
 # The list of packages should not really be hardcoded here
@@ -73,7 +79,7 @@ sub client_new { # $self, $service, $host, $secflags
 
   my $err;
   foreach my $pkg (@Plugins) {
-    if (eval "require $pkg" and $pkg->can("client_new")) {
+    if (eval "require $pkg" and $pkg->can('client_new')) { ## no critic (BuiltinFunctions::ProhibitStringyEval)
       if ($self->{conn} = eval { $pkg->client_new($self, @_) }) {
         return $self->{conn};
       }
@@ -81,7 +87,7 @@ sub client_new { # $self, $service, $host, $secflags
     }
   }
 
-  croak $err || "Cannot find a SASL Connection library";
+  croak $err || 'Cannot find a SASL Connection library';
 }
 
 sub server_new { # $self, $service, $host, $secflags
@@ -89,19 +95,19 @@ sub server_new { # $self, $service, $host, $secflags
 
   my $err;
   foreach my $pkg (@Plugins) {
-    if (eval "require $pkg" and $pkg->can("server_new")) {
+    if (eval "require $pkg" and $pkg->can('server_new')) { ## no critic (BuiltinFunctions::ProhibitStringyEval)
       if ($self->{conn} = eval { $pkg->server_new($self, @_) } ) {
         return $self->{conn};
       }
-      $err = $@;
+      $err = $@; ## no critic (Variables::ProhibitPunctuationVars)
     }
   }
-  croak $err || "Cannot find a SASL Connection library for server-side authentication";
+  croak $err || 'Cannot find a SASL Connection library for server-side authentication';
 }
 
 sub error {
   my $self = shift;
-  $self->{conn} && $self->{conn}->error;
+  return $self->{conn} && $self->{conn}->error;
 }
 
 # Compat.
@@ -109,22 +115,22 @@ sub user {
   my $self = shift;
   my $user = $self->{callback}{user};
   $self->{callback}{user} = shift if @_;
-  $user;
+  return $user;
 }
 
 sub challenge {
   my $self = shift;
-  $self->{conn}->client_step(@_);
+  return $self->{conn}->client_step(@_);
 }
 
 sub initial {
   my $self = shift;
-  $self->client_new($self)->client_start;
+  return $self->client_new($self)->client_start;
 }
 
 sub name {
   my $self = shift;
-  $self->{conn} ? $self->{conn}->mechanism : ($self->{mechanism} =~ /(\S+)/)[0];
+  return $self->{conn} ? $self->{conn}->mechanism : ($self->{mechanism} =~ /(\S+)/)[0];
 }
 
 1;

lib/Authen/SASL/CRAM_MD5.pm

@@ -4,14 +4,20 @@
 
 package Authen::SASL::CRAM_MD5;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
+use warnings;
 use strict;
+use utf8;
+
 use vars qw($VERSION);
 
-$VERSION = "2.14";
+$VERSION = '2.14';
+
+use Authen::SASL ();
 
 sub new {
   shift;
-  Authen::SASL->new(@_, mechanism => 'CRAM-MD5');
+  return Authen::SASL->new(@_, mechanism => 'CRAM-MD5');
 }
 
 1;

lib/Authen/SASL/EXTERNAL.pm

@@ -4,14 +4,19 @@
 
 package Authen::SASL::EXTERNAL;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
+
 use vars qw($VERSION);
 
-$VERSION = "2.14";
+$VERSION = '2.14';
 
+use Authen::SASL ();
 sub new {
   shift;
-  Authen::SASL->new(@_, mechanism => 'EXTERNAL');
+  return Authen::SASL->new(@_, mechanism => 'EXTERNAL');
 }
 
 1;

lib/Authen/SASL/Perl/ANONYMOUS.pm

@@ -1,33 +1,38 @@
+## no critic (ClassHierarchies::ProhibitExplicitISA, Documentation::RequirePODUseEncodingUTF8, Documentation::RequirePodSections)
 # Copyright (c) 2002 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package Authen::SASL::Perl::ANONYMOUS;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
+
 use vars qw($VERSION @ISA);
 
-$VERSION = "2.14";
+$VERSION = '2.14';
 @ISA	 = qw(Authen::SASL::Perl);
 
 my %secflags = (
 	noplaintext => 1,
 );
 
-sub _order { 0 }
+sub _order { return 0 }
 sub _secflags {
   shift;
-  grep { $secflags{$_} } @_;
+  return grep { $secflags{$_} } @_;
 }
 
-sub mechanism { 'ANONYMOUS' }
+sub mechanism { return 'ANONYMOUS' }
 
 sub client_start {
-  shift->_call('authname')
+  return shift->_call('authname');
 }
 
 sub client_step {
-  shift->_call('authname')
+  return shift->_call('authname');
 }
 
 1;

lib/Authen/SASL/Perl/CRAM_MD5.pm

@@ -1,14 +1,19 @@
+## no critic (ClassHierarchies::ProhibitExplicitISA, Documentation::RequirePodSections, Documentation::RequirePODUseEncodingUTF8)
 # Copyright (c) 2002 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package Authen::SASL::Perl::CRAM_MD5;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
+
 use vars qw($VERSION @ISA);
 use Digest::HMAC_MD5 qw(hmac_md5_hex);
 
-$VERSION = "2.14";
+$VERSION = '2.14';
 @ISA	 = qw(Authen::SASL::Perl);
 
 my %secflags = (
@@ -16,16 +21,16 @@ my %secflags = (
 	noanonymous => 1,
 );
 
-sub _order { 2 }
+sub _order { return 2 }
 sub _secflags {
   shift;
-  scalar grep { $secflags{$_} } @_;
+  return scalar grep { $secflags{$_} } @_;
 }
 
-sub mechanism { 'CRAM-MD5' }
+sub mechanism { return 'CRAM-MD5' }
 
 sub client_start {
-  '';
+  return '';
 }
 
 sub client_step {
@@ -35,7 +40,7 @@ sub client_step {
     defined($v) ? $v : ''
   } qw(user pass);
 
-  $user . " " . hmac_md5_hex($string,$pass);
+  return $user . ' ' . hmac_md5_hex($string,$pass);
 }
 
 1;

lib/Authen/SASL/Perl/DIGEST_MD5.pm

@@ -1,3 +1,4 @@
+## no critic (Documentation::RequirePodSections, Documentation::RequirePODUseEncodingUTF8)
 # Copyright (c) 2003-2009 Graham Barr, Djamel Boudjerda, Paul Connolly, Julian
 # Onions, Nexor and Yann Kerherve.
 # All rights reserved. This program is free software; you can redistribute
@@ -7,15 +8,20 @@
 
 package Authen::SASL::Perl::DIGEST_MD5;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
+
 use vars qw($VERSION @ISA $CNONCE $NONCE);
 use Digest::MD5 qw(md5_hex md5);
 use Digest::HMAC_MD5 qw(hmac_md5);
+use Crypt::RC4 ();
 
 # TODO: complete qop support in server, should be configurable
 
-$VERSION = "2.14";
+$VERSION = '2.14';
-@ISA = qw(Authen::SASL::Perl);
+@ISA = qw(Authen::SASL::Perl); ## no critic (ClassHierarchies::ProhibitExplicitISA)
 
 my %secflags = (
   noplaintext => 1,
@@ -56,7 +62,7 @@ my @ourciphers = (
         sub { goto &Crypt::RC4::RC4; };
       *Crypt::RC4::keysize   =  sub {128};
       *Crypt::RC4::blocksize =  sub {1};
-    }
+    },
   },
   {
     name  => '3des',
@@ -99,7 +105,7 @@ my @ourciphers = (
         sub { goto &Crypt::RC4::RC4; };
       *Crypt::RC4::keysize   =  sub {56};
       *Crypt::RC4::blocksize =  sub {1};
-    }
+    },
   },
   {
     name  => 'rc4-40',
@@ -114,27 +120,27 @@ my @ourciphers = (
         sub { goto &Crypt::RC4::RC4; };
       *Crypt::RC4::keysize   =  sub {40};
       *Crypt::RC4::blocksize =  sub {1};
-    }
+    },
   },
 );
 
 ## The system we are on, might not be able to crypt the stream
 our $NO_CRYPT_AVAILABLE = 1;
 for (@ourciphers) {
-    eval "require $_->{pkg}";
+    eval "require $_->{pkg}"; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-    unless ($@) {
+    unless ($@) { ## no critic (Variables::ProhibitPunctuationVars)
         $NO_CRYPT_AVAILABLE = 0;
         last;
     }
 }
 
-sub _order { 3 }
+sub _order { return 3 }
 sub _secflags {
   shift;
-  scalar grep { $secflags{$_} } @_;
+  return scalar grep { $secflags{$_} } @_;
 }
 
-sub mechanism { 'DIGEST-MD5' }
+sub mechanism { return 'DIGEST-MD5' }
 
 sub _init {
   my ($pkg, $self) = @_;
@@ -146,14 +152,14 @@ sub _init {
   $self->property('maxbuf',      0xFFFFFF);         # maximum supported by GSSAPI mech
   $self->property('externalssf', 0);
 
-  $self;
+  return $self;
 }
 
 sub _init_server {
   my $server  = shift;
   my $options = shift || {};
-  if (!ref $options or ref $options ne 'HASH') {
+  if (!ref $options || ref $options ne 'HASH') {
-    warn "options for DIGEST_MD5 should be a hashref";
+    warn 'options for DIGEST_MD5 should be a hashref'; ## no critic (ErrorHandling::RequireCarping)
     $options = {};
   }
 
@@ -167,7 +173,7 @@ sub _init_server {
                              or $options->{no_confidentiality}
                              or $NO_CRYPT_AVAILABLE;
 
-  $server->{supported_qop} = { map { $_ => 1 } @qop };
+  return $server->{supported_qop} = { map { $_ => 1 } @qop };
 }
 
 sub init_sec_layer {
@@ -181,6 +187,7 @@ sub init_sec_layer {
   # reset properties for new session
   $self->property(maxout => undef);
   $self->property(ssf    => undef);
+  return;
 }
 
 # no initial value passed to the server
@@ -191,7 +198,7 @@ sub client_start {
   $self->{error}     = undef;
   $self->{state}     = 0;
   $self->init_sec_layer;
-  '';
+  return '';
 }
 
 sub server_start {
@@ -201,7 +208,7 @@ sub server_start {
 
   $self->{need_step} = 1;
   $self->{error}     = undef;
-  $self->{nonce}     = md5_hex($NONCE || join (":", $$, time, rand));
+  $self->{nonce}     = md5_hex($NONCE || join (':', $$, time, rand)); ## no critic (Variables::ProhibitPunctuationVars)
 
   $self->init_sec_layer;
 
@@ -243,9 +250,9 @@ sub client_step {   # $self, $server_sasl_credentials
 
   if ($self->{state} == 1) {
     # check server's `rspauth' response
-    return $self->set_error("Server did not send rspauth in step 2")
+    return $self->set_error('Server did not send rspauth in step 2')
       unless ($sparams{rspauth});
-    return $self->set_error("Invalid rspauth in step 2")
+    return $self->set_error('Invalid rspauth in step 2')
       unless ($self->{rspauth} eq $sparams{rspauth});
 
     # all is well
@@ -255,15 +262,15 @@ sub client_step {   # $self, $server_sasl_credentials
 
   # check required fields in server challenge
   if (my @missing = grep { !exists $sparams{$_} } @server_required) {
-    return $self->set_error("Server did not provide required field(s): @missing")
+    return $self->set_error("Server did not provide required field(s): @missing");
   }
 
   my %response = (
     nonce        => $sparams{'nonce'},
-    cnonce       => md5_hex($CNONCE || join (":", $$, time, rand)),
+    cnonce       => md5_hex($CNONCE || join (':', $$, time, rand)), ## no critic (Variables::ProhibitPunctuationVars)
     'digest-uri' => $self->service . '/' . $self->host,
     # calc how often the server nonce has been seen; server expects "00000001"
-    nc           => sprintf("%08d",     ++$self->{nonce_counts}{$sparams{'nonce'}}),
+    nc           => sprintf('%08d',     ++$self->{nonce_counts}{$sparams{'nonce'}}),
     charset      => $sparams{'charset'},
   );
 
@@ -273,7 +280,7 @@ sub client_step {   # $self, $server_sasl_credentials
   # let caller-provided fields override defaults: authorization ID, service name, realm
 
   my $s_realm = $sparams{realm} || [];
-  my $realm = $self->_call('realm', @$s_realm);
+  my $realm = $self->_call('realm', @{$s_realm});
   unless (defined $realm) {
     # If the user does not pick a realm, use the first from the server
     $realm = $s_realm->[0];
@@ -293,12 +300,12 @@ sub client_step {   # $self, $server_sasl_credentials
   }
 
   my $user = $self->_call('user');
-  return $self->set_error("Username is required")
+  return $self->set_error('Username is required')
     unless defined $user;
   $response{username} = $user;
 
   my $password = $self->_call('pass');
-  return $self->set_error("Password is required")
+  return $self->set_error('Password is required')
     unless defined $password;
 
   $self->property('maxout', $sparams{maxbuf} || 65536);
@@ -313,7 +320,7 @@ sub client_step {   # $self, $server_sasl_credentials
   $self->{rspauth}    = $rspauth;
 
   # finally, return our response token
-  return _response(\%response, "is_client");
+  return _response(\%response, 'is_client');
 }
 
 sub _compute_digests_and_set_keys {
@@ -326,18 +333,18 @@ sub _compute_digests_and_set_keys {
   }
 
   my $realm = $params->{realm};
-  $realm = "" unless defined $realm;
+  $realm = '' unless defined $realm;
 
-  my $A1 = join (":",
+  my $A1 = join (':',
-    md5(join (":", $params->{username}, $realm, $password)),
+    md5(join (':', $params->{username}, $realm, $password)),
-    @$params{defined($params->{authzid})
+    @{$params{defined($params->{authzid})
       ? qw(nonce cnonce authzid)
       : qw(nonce cnonce)
-    }
+    }},
   );
 
   # pre-compute MD5(A1) and HEX(MD5(A1)); these are used multiple times below
-  my $hdA1 = unpack("H*", (my $dA1 = md5($A1)) );
+  my $hdA1 = unpack('H*', (my $dA1 = md5($A1)) );
 
   # derive keys for layer encryption / integrity
   $self->{kic} = md5($dA1,
@@ -365,21 +372,21 @@ sub _compute_digests_and_set_keys {
     $self->{ivs} = $cipher->{iv}->($self->{kcs});
   }
 
-  my $A2 = "AUTHENTICATE:" . $params->{'digest-uri'};
+  my $A2 = 'AUTHENTICATE:' . $params->{'digest-uri'};
-  $A2 .= ":00000000000000000000000000000000" if ($params->{qop} ne 'auth');
+  $A2 .= ':00000000000000000000000000000000' if ($params->{qop} ne 'auth');
 
   my $response = md5_hex(
-    join (":", $hdA1, @$params{qw(nonce nc cnonce qop)}, md5_hex($A2))
+    join (':', $hdA1, @{$params{qw(nonce nc cnonce qop)}}, md5_hex($A2)),
   );
 
   # calculate server `rspauth' response, so we can check in step 2
   # the only difference here is in the A2 string which from which
   # `AUTHENTICATE' is omitted in the calculation of `rspauth'
-  $A2 = ":" . $params->{'digest-uri'};
+  $A2 = ':' . $params->{'digest-uri'};
-  $A2 .= ":00000000000000000000000000000000" if ($params->{qop} ne 'auth');
+  $A2 .= ':00000000000000000000000000000000' if ($params->{qop} ne 'auth');
 
   my $rspauth = md5_hex(
-    join (":", $hdA1, @$params{qw(nonce nc cnonce qop)}, md5_hex($A2))
+    join (':', $hdA1, @{$params{qw(nonce nc cnonce qop)}}, md5_hex($A2)),
   );
 
   return ($response, $rspauth);
@@ -408,7 +415,7 @@ sub server_step {
     return $cb->();
   }
 
-  my $qop = $cparams{'qop'} || "auth";
+  my $qop = $cparams{'qop'} || 'auth';
   unless ($self->is_qop_supported($qop)) {
     $self->set_error("Client qop not supported (qop = '$qop')");
     return $cb->();
@@ -416,13 +423,13 @@ sub server_step {
 
   my $username = $cparams{'username'};
   unless ($username) {
-    $self->set_error("Client didn't provide a username");
+    $self->set_error('Client didn\'t provide a username');
     return $cb->();
   }
 
   # "The authzid MUST NOT be an empty string."
   if (exists $cparams{authzid} && $cparams{authzid} eq '') {
-      $self->set_error("authzid cannot be empty");
+      $self->set_error('authzid cannot be empty');
       return $cb->();
   }
   my $authzid = $cparams{authzid};
@@ -431,15 +438,15 @@ sub server_step {
   # This will detect accidental connection to the incorrect server, as well as
   # some redirection attacks"
   my $digest_uri = $cparams{'digest-uri'};
-  my ($cservice, $chost, $cservname) = split '/', $digest_uri, 3;
+  my ($cservice, $chost, $cservname) = split /\//, $digest_uri, 3;
   if ($cservice ne $self->service or $chost ne $self->host) {
       # XXX deal with serv_name
-      $self->set_error("Incorrect digest-uri");
+      $self->set_error('Incorrect digest-uri');
       return $cb->();
   }
 
   unless (defined $self->callback('getsecret')) {
-    $self->set_error("a getsecret callback MUST be defined");
+    $self->set_error('a getsecret callback MUST be defined');
     $cb->();
     return;
   }
@@ -452,7 +459,7 @@ sub server_step {
 
     ## configure the security layer
     $self->_server_layer($qop)
-        or return $self->set_error("Cannot negociate the security layer");
+        or return $self->set_error('Cannot negociate the security layer');
 
     my ($expected, $rspauth)
         = $self->_compute_digests_and_set_keys($password, $self->{client_params});
@@ -471,7 +478,7 @@ sub server_step {
     return _response(\%response);
   };
 
-  $self->callback('getsecret')->(
+  return $self->callback('getsecret')->(
     $self,
     { user => $username, realm => $realm, authzid => $authzid },
     sub { $cb->( $response_check->( shift ) ) },
@@ -489,7 +496,7 @@ sub _response {
   my $is_client = shift;
 
   my @out;
-  for my $k (sort keys %$response) {
+  for my $k (sort keys %{$response}) {
     my $is_array = ref $response->{$k} && ref $response->{$k} eq 'ARRAY';
     my @values = $is_array ? @{$response->{$k}} : ($response->{$k});
     # Per spec, one way of doing it: multiple k=v
@@ -497,7 +504,7 @@ sub _response {
     # other way: comma separated list
     push @out, [$k, join (',', @values)];
   }
-  return join (",", map { _qdval($_->[0], $_->[1], $is_client) } @out);
+  return join (',', map { _qdval($_->[0], $_->[1], $is_client) } @out);
 }
 
 sub _parse_challenge {
@@ -506,13 +513,13 @@ sub _parse_challenge {
   my $type          = shift;
   my $params        = shift;
 
-  while($$challenge_ref =~
+  while(${$challenge_ref} =~
-           s/^(?:\s*,)*\s*            # remaining or crap
+           s{^(?:\s*,)*\s*            # remaining or crap
              ([\w-]+)                 # key, eg: qop
              =
              ("([^\\"]+|\\.)*"|[^,]+) # value, eg: auth-conf or "NoNcE"
              \s*(?:,\s*)*             # remaining
-           //x) {
+           }{}x) {
 
     my ($k, $v) = ($1,$2);
     if ($v =~ /^"(.*)"$/s) {
@@ -520,7 +527,7 @@ sub _parse_challenge {
     }
     if (exists $multi{$type}{$k}) {
       my $aref = $params->{$k} ||= [];
-      push @$aref, $v;
+      push @{$aref}, $v;
     }
     elsif (defined $params->{$k}) {
       return $self->set_error("Bad challenge: '$$challenge_ref'");
@@ -529,7 +536,7 @@ sub _parse_challenge {
       $params->{$k} = $v;
     }
   }
-  return length $$challenge_ref ? 0 : 1;
+  return length ${$challenge_ref} ? 0 : 1;
 }
 
 sub _qdval {
@@ -585,9 +592,9 @@ sub _client_layer {
   # qop in server challenge is optional: if not there "auth" is assumed
   my $smask = 0;
   map {
-    m/^auth$/      and $smask |= 1;
+    m/^auth$/      and $smask |= 1; ## no critic (RegularExpressions::ProhibitFixedStringMatches)
-    m/^auth-int$/  and $smask |= 2;
+    m/^auth-int$/  and $smask |= 2; ## no critic (RegularExpressions::ProhibitFixedStringMatches)
-    m/^auth-conf$/ and $smask |= 4;
+    m/^auth-conf$/ and $smask |= 4; ## no critic (RegularExpressions::ProhibitFixedStringMatches)
   } split(/,/, $sparams->{qop}||'auth'); # XXX I think we might have a bug here bc. of LWS
 
   # construct our qop mask
@@ -639,13 +646,13 @@ sub _select_cipher {
   # compose a subset of candidate ciphers based on ssf and peer list
   my @a = map {
     my $c = $_;
-    (grep { $c->{name} eq $_ } @$ciphers and
+    (grep { $c->{name} eq $_ } @{$ciphers} and
       $c->{ssf} >= $minssf and $c->{ssf} <= $maxssf) ? $_ : ()
   } @ourciphers;
 
   # from these, select the first one we can create an instance of
   for (@a) {
-    next unless eval "require $_->{pkg}";
+    next unless eval {require $_->{pkg}};
     $self->{cipher} = $_;
     return 1;
   }
@@ -718,14 +725,14 @@ sub _crypt {  # input: op(decrypting=1/encrypting=0)), buffer
 
   if ($bs <= 1) {
     # stream cipher
-    return $d ? $self->{khs}->decrypt($_[0]) : $self->{khc}->encrypt($_[0])
+    return $d ? $self->{khs}->decrypt($_[0]) : $self->{khc}->encrypt($_[0]);
   }
 
   # the remainder of this sub is for block ciphers
 
   # get current IV
   my $piv = \$self->{$d ? 'ivs' : 'ivc'};
-  my $iv = $$piv;
+  my $iv = ${$piv};
 
   my $result = join '', map {
     my $x = $d
@@ -736,7 +743,7 @@ sub _crypt {  # input: op(decrypting=1/encrypting=0)), buffer
   } unpack("a$bs "x(int(length($_[0])/$bs)), $_[0]);
 
   # store current IV
-  $$piv = $iv;
+  ${$piv} = $iv;
   return $result;
 }
 

lib/Authen/SASL/Perl/EXTERNAL.pm

@@ -1,3 +1,4 @@
+## no critic (ClassHierarchies::ProhibitExplicitISA, Documentation::RequirePodSections, Documentation::RequirePODUseEncodingUTF8)
 # Copyright (c) 1998-2002 Graham Barr <gbarr@pobox.com> and 2001 Chris Ridd
 # <chris.ridd@isode.com>.  All rights reserved.  This program
 # is free software; you can redistribute it and/or modify it under the
@@ -5,10 +6,14 @@
 
 package Authen::SASL::Perl::EXTERNAL;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
+
 use vars qw($VERSION @ISA);
 
-$VERSION = "2.14";
+$VERSION = '2.14';
 @ISA	 = qw(Authen::SASL::Perl);
 
 my %secflags = (
@@ -17,18 +22,18 @@ my %secflags = (
 	noanonymous  => 1,
 );
 
-sub _order { 2 }
+sub _order { return 2 }
 sub _secflags {
   shift;
-  grep { $secflags{$_} } @_;
+  return grep { $secflags{$_} } @_;
 }
 
-sub mechanism { 'EXTERNAL' }
+sub mechanism { return 'EXTERNAL' }
 
 sub client_start {
   my $self = shift;
   my $v = $self->_call('user');
-  defined($v) ? $v : ''
+  return defined($v) ? $v : '';
 }
 
 #sub client_step {

lib/Authen/SASL/Perl/GSSAPI.pm

@@ -1,15 +1,21 @@
+## no critic (ClassHierarchies::ProhibitExplicitISA, Documentation::RequirePodSections, Documentation::RequirePODUseEncodingUTF8)
 # Copyright (c) 2006 Simon Wilkinson
 # All rights reserved. This program is free software; you can redistribute
 # it and/or modify it under the same terms as Perl itself.
 
 package Authen::SASL::Perl::GSSAPI;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
 
 use vars qw($VERSION @ISA);
-use GSSAPI;
+use GSSAPI ();
+use GSSAPI::Name ();
+use GSSAPI::Context ();
 
-$VERSION= "0.05";
+$VERSION= '0.05';
 @ISA = qw(Authen::SASL::Perl);
 
 my %secflags = (
@@ -17,13 +23,13 @@ my %secflags = (
   noanonymous => 1,
 );
 
-sub _order { 4 }
+sub _order { return 4 }
 sub _secflags {
   shift;
-  scalar grep { $secflags{$_} } @_;
+  return scalar grep { $secflags{$_} } @_;
 }
 
-sub mechanism { 'GSSAPI' }
+sub mechanism { return 'GSSAPI' }
 
 sub _init {
   my ($pkg, $self) = @_;
@@ -38,7 +44,7 @@ sub _init {
   # layer selection mask in the client reply, we default to
   # compatibility with that bug
   $self->property('COMPAT_CYRUSLIB_REPLY_MASK_BUG', 1);
-  $self;
+  return $self;
 }
 
 sub client_start {

lib/Authen/SASL/Perl/LOGIN.pm

@@ -1,31 +1,36 @@
+## no critic (ClassHierarchies::ProhibitExplicitISA, Documentation::RequirePODUseEncodingUTF8, Documentation::RequirePodSections)
 # Copyright (c) 2002 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package Authen::SASL::Perl::LOGIN;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
+
 use vars qw($VERSION @ISA);
 
-$VERSION = "2.14";
+$VERSION = '2.14';
 @ISA	 = qw(Authen::SASL::Perl);
 
 my %secflags = (
 	noanonymous => 1,
 );
 
-sub _order { 1 }
+sub _order { return 1 }
 sub _secflags {
   shift;
-  scalar grep { $secflags{$_} } @_;
+  return scalar grep { $secflags{$_} } @_;
 }
 
-sub mechanism { 'LOGIN' }
+sub mechanism { return 'LOGIN' }
 
 sub client_start {
   my $self = shift;
   $self->{stage} = 0;
-  '';
+  return '';
 }
 
 sub client_step {
@@ -47,7 +52,7 @@ sub client_step {
       return;
   }
   else {
-      return $self->set_error("Invalid sequence");
+      return $self->set_error('Invalid sequence');
   }
 }
 
@@ -73,24 +78,24 @@ sub server_step {
 
   if ($stage == 1) {
     unless (defined $response) {
-        $self->set_error("Invalid sequence (empty username)");
+        $self->set_error('Invalid sequence (empty username)');
         return $user_cb->();
     }
     $self->{answer}{user} = $response;
-    return $user_cb->("Password:");
+    return $user_cb->('Password:');
   }
   elsif ($stage == 2) {
     unless (defined $response) {
-        $self->set_error("Invalid sequence (empty pass)");
+        $self->set_error('Invalid sequence (empty pass)');
         return $user_cb->();
     }
     $self->{answer}{pass} = $response;
   }
   else {
-    $self->set_error("Invalid sequence (end)");
+    $self->set_error('Invalid sequence (end)');
     return $user_cb->();
   }
-  my $error = "Credentials don't match";
+  my $error = 'Credentials don\'t match';
   my $answers = { user => $self->{answer}{user}, pass => $self->{answer}{pass} };
   if (my $checkpass = $self->{callback}{checkpass}) {
     my $cb = sub {
@@ -109,7 +114,7 @@ sub server_step {
   elsif (my $getsecret = $self->{callback}{getsecret}) {
     my $cb = sub {
       my $good_pass = shift;
-      if ($good_pass && $good_pass eq ($self->{answer}{pass} || "")) {
+      if ($good_pass && $good_pass eq ($self->{answer}{pass} || '')) {
         $self->set_success;
       }
       else {

lib/Authen/SASL/Perl/PLAIN.pm

@@ -1,14 +1,19 @@
+## no critic (Documentation::RequirePODUseEncodingUTF8, Documentation::RequirePodSections)
 # Copyright (c) 2002 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package Authen::SASL::Perl::PLAIN;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
+use warnings;
+use utf8;
+
 use vars qw($VERSION @ISA);
 
-$VERSION = "2.14";
+$VERSION = '2.14';
-@ISA	 = qw(Authen::SASL::Perl);
+@ISA	 = qw(Authen::SASL::Perl); ## no critic (ClassHierarchies::ProhibitExplicitISA)
 
 my %secflags = (
 	noanonymous => 1,
@@ -16,13 +21,13 @@ my %secflags = (
 
 my @tokens = qw(authname user pass);
 
-sub _order { 1 }
+sub _order { return 1 }
 sub _secflags {
   shift;
-  grep { $secflags{$_} } @_;
+  return grep { $secflags{$_} } @_;
 }
 
-sub mechanism { 'PLAIN' }
+sub mechanism { return 'PLAIN' }
 
 sub client_start {
   my $self = shift;
@@ -35,7 +40,7 @@ sub client_start {
     defined($v) ? $v : ''
   } @tokens;
 
-  join("\0", @parts);
+  return join("\0", @parts);
 }
 
 sub server_start {
@@ -44,16 +49,16 @@ sub server_start {
   my $user_cb   = shift || sub {};
 
   $self->{error} = undef;
-  return $self->set_error("No response: Credentials don't match")
+  return $self->set_error('No response: Credentials don\'t match')
     unless defined $response;
 
   my %parts;
-  @parts{@tokens} = split "\0", $response, scalar @tokens;
+  @parts{@tokens} = split "\0", $response, scalar @tokens; ## no critic (BuiltinFunctions::ProhibitStringySplit)
 
 
   # I'm not entirely sure of what I am doing
   $self->{answer}{$_} = $parts{$_} for qw/authname user/;
-  my $error = "Credentials don't match";
+  my $error = 'Credentials don\'t match';
 
   ## checkpass
   if (my $checkpass = $self->callback('checkpass')) {
@@ -75,7 +80,7 @@ sub server_start {
   elsif (my $getsecret = $self->callback('getsecret')) {
     my $cb = sub {
       my $good_pass = shift;
-      if ($good_pass && $good_pass eq ($parts{pass} || "")) {
+      if ($good_pass && $good_pass eq ($parts{pass} || '')) {
         $self->set_success;
       }
       else {
@@ -92,6 +97,8 @@ sub server_start {
     $self->set_error($error);
     $user_cb->();
   }
+
+  return;
 }
 
 1;

lib/BotLib.pm

@@ -1,6 +1,6 @@
 package BotLib;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;

lib/BotLib/Anek.pm

@@ -1,15 +1,15 @@
 package BotLib::Anek;
 
-use 5.018;
+use 5.018;  ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Encode qw (decode);
-use HTML::TokeParser;
+use HTML::TokeParser ();
-use HTTP::Tiny;
+use HTTP::Tiny ();
-use JSON::XS;
+use JSON::XS ();
 use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);

lib/BotLib/Archeologist.pm

@@ -1,6 +1,6 @@
 package BotLib::Archeologist;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;

lib/BotLib/Buni.pm

@@ -1,13 +1,13 @@
 package BotLib::Buni;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use HTTP::Tiny;
+use HTTP::Tiny ();
-use HTML::TokeParser;
+use HTML::TokeParser ();
 use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);

lib/BotLib/Conf.pm

@@ -1,13 +1,13 @@
 package BotLib::Conf;
 # loads config
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use JSON::XS;
+use JSON::XS ();
 use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);

lib/BotLib/Drink.pm

@@ -1,17 +1,17 @@
 package BotLib::Drink;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Encode qw (decode);
-use CHI;
+use CHI ();
-use CHI::Driver::BerkeleyDB;
+use CHI::Driver::BerkeleyDB ();
-use DateTime;
+use DateTime ();
-use HTTP::Tiny;
+use HTTP::Tiny ();
-use HTML::TokeParser;
+use HTML::TokeParser ();
 use Log::Any qw ($log);
 use POSIX qw (strftime);
 use BotLib::Conf qw (LoadConf);

lib/BotLib/Fisher.pm

@@ -1,6 +1,6 @@
 package BotLib::Fisher;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;

lib/BotLib/Fortune.pm

@@ -1,7 +1,7 @@
 package BotLib::Fortune;
 # Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimiters.
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -11,7 +11,7 @@ use Carp qw (croak);
 use File::Path qw (make_path);
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
-use SQLite_File;
+use SQLite_File ();
 use BotLib::Conf qw (LoadConf);
 
 use version; our $VERSION = qw (1.0);

lib/BotLib/Fox.pm

@@ -1,13 +1,13 @@
 package BotLib::Fox;
 
-use 5.018;
+use 5.018;  ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use JSON::XS qw (decode_json);
-use HTTP::Tiny;
+use HTTP::Tiny ();
 use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);

lib/BotLib/Friday.pm

@@ -1,7 +1,7 @@
 package BotLib::Friday;
 # for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -11,7 +11,7 @@ use Carp qw (croak);
 use File::Path qw (make_path);
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
-use SQLite_File;
+use SQLite_File ();
 use BotLib::Conf qw (LoadConf);
 
 use version; our $VERSION = qw (1.0);

lib/BotLib/Image.pm

@@ -1,6 +1,6 @@
 package BotLib::Image;
 
-use 5.018;
+use 5.018;  ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;

lib/BotLib/Image/Flickr.pm

@@ -1,6 +1,6 @@
 package BotLib::Image::Flickr;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -8,12 +8,12 @@ use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Digest::HMAC_SHA1 ();
 use File::Path qw (make_path);
-use JSON::XS;
+use JSON::XS ();
-use HTTP::Tiny;
+use HTTP::Tiny ();
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use MIME::Base64 qw (encode_base64);
-use SQLite_File;
+use SQLite_File ();
 use URI::Encode::XS qw (uri_encode);
 
 use BotLib::Conf qw (LoadConf);

lib/BotLib/Karma.pm

@@ -1,12 +1,12 @@
 package BotLib::Karma;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use DB_File;
+use DB_File ();
 use File::Path qw (make_path);
 use Log::Any qw ($log);
 use BotLib::Conf qw (LoadConf);

lib/BotLib/Kitty.pm

@@ -1,13 +1,13 @@
 package BotLib::Kitty;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use JSON::XS qw (decode_json);
-use HTTP::Tiny;
+use HTTP::Tiny ();
 use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);

lib/BotLib/Lat.pm

@@ -1,7 +1,7 @@
 package BotLib::Lat;
 # famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -10,7 +10,7 @@ use English qw ( -no_match_vars );
 use Carp qw (carp);
 use File::Basename qw (dirname);
 use File::Path qw (make_path);
-use Hailo;
+use Hailo ();
 use Log::Any qw ($log);
 use BotLib::Conf qw (LoadConf);
 

lib/BotLib/Monkeyuser.pm

@@ -1,13 +1,13 @@
 package BotLib::Monkeyuser;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use HTTP::Tiny;
+use HTTP::Tiny ();
-use HTML::TokeParser;
+use HTML::TokeParser ();
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 

lib/BotLib/Proverb.pm

@@ -1,7 +1,7 @@
 package BotLib::Proverb;
 # Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter.
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -11,7 +11,7 @@ use Carp qw (croak);
 use File::Path qw (make_path);
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
-use SQLite_File;
+use SQLite_File ();
 use BotLib::Conf qw (LoadConf);
 use BotLib::Util qw (trim);
 

lib/BotLib/Util.pm

@@ -1,6 +1,6 @@
 package BotLib::Util;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;

lib/BotLib/Weather.pm

@@ -1,14 +1,14 @@
 package BotLib::Weather;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use CHI;
+use CHI ();
-use CHI::Driver::BerkeleyDB;
+use CHI::Driver::BerkeleyDB ();
-use HTTP::Tiny;
+use HTTP::Tiny ();
 use JSON::XS qw (decode_json);
 use Log::Any qw ($log);
 use BotLib::Conf qw (LoadConf);

lib/BotLib/Xkcd.pm

@@ -1,11 +1,11 @@
 package BotLib::Xkcd;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
-use HTTP::Tiny;
+use HTTP::Tiny ();
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);

lib/JabberBot.pm

@@ -3,7 +3,7 @@
 # в vendor_perl/5.24.3/Authen/SASL/Perl/DIGEST_MD5.pm
 package JabberBot;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -93,9 +93,9 @@ sub __new_bot_message {
 		$reply = 'Чего тебе?';
 	} elsif (($text =~ /^$qname[\,|\:]? (.+)/u) && ($hash{type} eq 'groupchat')) {
 		$reply = $hailo->{$chatid}->learn_reply ($1);
-	} elsif ($text =~ /^=\($/u || $text =~ /^\:\($/u || $text eq /^\)\:$/u) {
+	} elsif ($text =~ /^\=\($/u || $text =~ /^\:\($/u || $text eq /^\)\:$/u) {
 		$reply = ':)';
-	} elsif ($text =~ /^=\)$/u || $text =~ /^\:\)$/u || $text =~ /^\(\:$/u) {
+	} elsif ($text =~ /^\=\)$/u || $text =~ /^\:\)$/u || $text =~ /^\(\:$/u) {
 		$reply = ':D';
 	# karma adjustment
 	} elsif ($text =~ /(\+\+|\-\-)$/) {

lib/Net/Jabber/Bot.pm

@@ -1,5 +1,11 @@
+## no critic (Subroutines::ProhibitCallsToUndeclaredSubs, RegularExpressions::ProhibitUselessTopic, Documentation::RequirePODUseEncodingUTF8, Variables::ProhibitPunctuationVars, Documentation::RequirePodSections, Documentation::RequirePodAtEnd, ErrorHandling::RequireCarping, RegularExpressions::ProhibitUnusedCapture)
+
 package Net::Jabber::Bot;
 
+use 5.018; ## no critic (ProhibitImplicitImport)
+use warnings;
+use utf8;
+
 use Moose;
 use MooseX::Types
     -declare => [qw( JabberClientObject PosInt PosNum HundredInt )];
@@ -8,11 +14,12 @@ use MooseX::Types
 use MooseX::Types::Moose qw/Int HashRef Str Maybe ArrayRef Bool CodeRef Object Num/;
 
 use version;
-use Net::Jabber;
+use Net::Jabber ();
-use Time::HiRes;
+use Time::HiRes ();
-use Sys::Hostname;
+use Sys::Hostname qw(hostname);
 use Log::Log4perl qw(:easy);
-use Mozilla::CA;
+use Mozilla::CA ();
+use Net::Jabber::Client ();
 
 coerce Bool, from Str,
     via {($_ =~ m/(^on$)|(^true$)/i) + 0}; # True if it's on or true. Otherwise false.
@@ -25,7 +32,7 @@ subtype HundredInt, as Num,  where { $_ > 100 };
 
 has jabber_client               => (isa => Maybe[JabberClientObject],
                                     is => 'rw',
-                                    default => sub {Net::Jabber::Client->new});
+                                    default => sub {Net::Jabber::Client->new},);
 #my %connection_hash : ATTR; # Keep track of connection options fed to client.
 
 has 'client_session_id'   => (isa => Str, is => 'rw');
@@ -43,7 +50,7 @@ has 'username'            => (isa => Str, is => 'rw');
 has 'password'            => (isa => Str, is => 'rw');
 has 'alias'               => (isa => Str, lazy => 1, is => 'rw', default => 'net_jabber_bot');
 # Resource defaults to alias_hostname_pid
-has 'resource'            => (isa => Str, lazy => 1, is => 'rw', default => sub{shift->alias . "_" . hostname . "_" . $$});
+has 'resource'            => (isa => Str, lazy => 1, is => 'rw', default => sub{shift->alias . '_' . hostname() . '_' . $$});
 has 'message_function'    => (isa => Maybe[CodeRef], is => 'rw', default => sub{undef});
 has 'background_function' => (isa => Maybe[CodeRef], is => 'rw', default => sub{undef});
 has 'loop_sleep_time'     => (isa => PosNum, is => 'rw', default => 5);
@@ -53,7 +60,7 @@ has 'from_full'           => (isa => Str, lazy => 1, is => 'rw', default => sub{
                                                                        '@' .
                                                                        $self->server || '' .
                                                                        '/' .
-                                                                       $self->alias || '' });
+                                                                       $self->alias || '' },);
 
 has 'safety_mode'            => (isa => Bool, is => 'rw', default => 1, coerce => 1);
 has 'ignore_server_messages' => (isa => Bool, is => 'rw', default => 1, coerce => 1);
@@ -316,12 +323,12 @@ sub BUILD {
     # Deal with legacy bug
     if($params->{background_activity} || $params->{message_callback}) {
         my $warn_message = "\n\n"
-                          . "*" x 70 . "\n"
+                          . '*' x 70 . "\n"
                           . "WARNING!!! You're using old parameters for your bot initialization\n"
                           . "'message_callback' should be changed to 'message_function'\n"
                           . "'background_activity' should be changed to 'background_function'\n"
                           . "I'm correcting this, but you should fix your code\n"
-                          . "*" x 70 . "\n"
+                          . '*' x 70 . "\n"
                           . "\n\n";
         warn($warn_message);
         WARN($warn_message);
@@ -352,7 +359,7 @@ sub BUILD {
     }
 
     #Initialize the connection.
-    $self->_init_jabber;
+    return $self->_init_jabber;
 }
 
 # Return a code reference that will pass self in addition to arguements passed to callback code ref.
@@ -371,15 +378,15 @@ sub _init_jabber {
     # Autocreate the jabber object (see has jabber_client)
     my $connection = $self->jabber_client;
 
-    DEBUG("Set the call backs.");
+    DEBUG('Set the call backs.');
     $connection->PresenceDB(); # Init presence DB.
     $connection->RosterDB(); # Init Roster DB.
     $connection->SetCallBacks( 'message'  => $self->_callback_maker(\&_process_jabber_message)
                               ,'presence' => $self->_callback_maker(\&_jabber_presence_message)
-                              ,'iq'       => $self->_callback_maker(\&_jabber_in_iq_message)
+                              ,'iq'       => $self->_callback_maker(\&_jabber_in_iq_message),
                               );
 
-    DEBUG("Connect. hostname => " . $self->server . ", port => " . $self->port);
+    DEBUG('Connect. hostname => ' . $self->server . ', port => ' . $self->port);
     my %client_connect_hash = (
         hostname => $self->server,
         port => $self->port,
@@ -397,8 +404,8 @@ sub _init_jabber {
        die("Jabber server is down or connection was not allowed: $!");
     }
 
-    DEBUG("Logging in... as user " . $self->username . " / " . $self->resource);
+    DEBUG('Logging in... as user ' . $self->username . ' / ' . $self->resource);
-    DEBUG("PW: " . $self->password);
+    DEBUG('PW: ' . $self->password);
 
 # Moved into connect hash via 'componentname'
 #    my $sid = $connection->{SESSION}->{id};
@@ -410,23 +417,23 @@ sub _init_jabber {
                                             resource => $self->resource,
                                             );
 
-    if(!defined $auth_result[0] || $auth_result[0] ne "ok") {
+    if(!defined $auth_result[0] || $auth_result[0] ne 'ok') {
-        ERROR("Authorization failed: for " . $self->username . " / " . $self->resource);
+        ERROR('Authorization failed: for ' . $self->username . ' / ' . $self->resource);
         foreach my $result (@auth_result) {
             ERROR("$result");
         }
-        die("Failed to re-connect: " . join("\n", @auth_result));
+        die('Failed to re-connect: ' . join("\n", @auth_result));
     }
 
     $connection->RosterRequest();
 
     $self->client_session_id($connection->{SESSION}->{id});
 
-    DEBUG("Sending presence to tell world that we are logged in");
+    DEBUG('Sending presence to tell world that we are logged in');
     $connection->PresenceSend();
     $self->Process(5);
 
-    DEBUG("Getting Roster to tell server to send presence info");
+    DEBUG('Getting Roster to tell server to send presence info');
     $connection->RosterGet();
     $self->Process(5);
 
@@ -434,7 +441,7 @@ sub _init_jabber {
         $self->JoinForum($forum);
     }
 
-    INFO("Connected to server '" . $self->server . "' successfully");
+    INFO('Connected to server \'' . $self->server . '\' successfully');
     $self->connect_time(time); # Track when we came online.
     return 1;
 }
@@ -453,7 +460,7 @@ sub JoinForum {
     my $self = shift;
     my $forum_name = shift;
 
-    DEBUG("Joining $forum_name on " . $self->conference_server . " as " . $self->alias);
+    DEBUG("Joining $forum_name on " . $self->conference_server . ' as ' . $self->alias);
 
     $self->jabber_client->MUCJoin(room    => $forum_name,
                                   server => $self->conference_server,
@@ -461,8 +468,9 @@ sub JoinForum {
                                   );
 
     $self->forum_join_time->{$forum_name} = time;
-    DEBUG("Sleeping " . $self->message_delay . " seconds");
+    DEBUG('Sleeping ' . $self->message_delay . ' seconds');
     Time::HiRes::sleep $self->message_delay;
+    return;
 }
 
 =item B<Process>
@@ -521,8 +529,8 @@ sub Start {
 
         if($@) { #Assume the connection is down...
             ERROR("Server error: $@");
-            my $message = "Disconnected from " . $self->server . ":" . $self->port
+            my $message = 'Disconnected from ' . $self->server . ':' . $self->port
-                        . " as " . $self->username;
+                        . ' as ' . $self->username;
 
             ERROR("$message Reconnecting...");
             sleep 5; # TODO: Make re-connect time flexible somehow
@@ -531,11 +539,12 @@ sub Start {
 
         # Call background function
         if(defined $background_subroutine && $last_background + $time_between_background_routines < time) {
-            &$background_subroutine($self, ++$counter);
+            &$background_subroutine($self, ++$counter); ## no critic (References::ProhibitDoubleSigils)
             $last_background = time;
         }
         Time::HiRes::sleep $message_delay;
     }
+    return;
 }
 
 =item B<ReconnectToServer>
@@ -562,9 +571,10 @@ sub ReconnectToServer {
         sleep $sleep_time;
         $sleep_time *= 2 if($sleep_time < 300);
         $self->InitJabber();
-        INFO("Running background routine.");
+        INFO('Running background routine.');
-        &$background_subroutine($self, 0); # call background proc so we can check for errors while down.
+        &$background_subroutine($self, 0); ## no critic (References::ProhibitDoubleSigils) # call background proc so we can check for errors while down.
     }
+    return;
 }
 
 =item B<Disconnect>
@@ -579,14 +589,14 @@ sub Disconnect {
 
     $self->connect_time('9' x 10); # Way in the future
 
-    INFO("Disconnecting from server");
+    INFO('Disconnecting from server');
     return if(!defined $self->jabber_client); # do not proceed, no object.
 
     $self->jabber_client->Disconnect();
     my $old_client = $self->jabber_client;
     $self->jabber_client(undef);
 
-    DEBUG("Disconnected.");
+    DEBUG('Disconnected.');
     return 1;
 }
 
@@ -599,7 +609,7 @@ Reports connect state (true/false) based on the status of client_start_time.
 sub IsConnected {
     my $self = shift;
 
-    DEBUG("REF = " . ref($self->jabber_client));
+    DEBUG('REF = ' . ref($self->jabber_client));
     return $self->connect_time;
 }
 
@@ -612,13 +622,13 @@ Handles incoming messages.
 
 sub _process_jabber_message {
     my $self = shift;
-    DEBUG("_process_jabber_message called");
+    DEBUG('_process_jabber_message called');
 
     my $session_id = shift;
     my $message = shift;
 
     my $type = $message->GetType();
-    my $fromJID = $message->GetFrom("jid");
+    my $fromJID = $message->GetFrom('jid');
     my $from_full = $message->GetFrom();
 
     my $from = $fromJID->GetUserID();
@@ -660,7 +670,6 @@ sub _process_jabber_message {
 
     # Are these my own messages?
     if($self->ignore_self_messages ) { # TODO: || $self->safety_mode (this breaks tests in 06?)
-        
         if(defined $resource && $resource eq $self->resource) { # Ignore my own messages.
             DEBUG("Ignoring message from self...\n");
             return;
@@ -676,11 +685,11 @@ sub _process_jabber_message {
         foreach my $address_type (@aliases_to_respond_to) {
             my $qm_address_type = quotemeta($address_type);
             next if($body !~ m/^\s*$qm_address_type\s*(\S.*)$/ms);
-            $request = $1;
+            $request = $1; ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
             $bot_address_from = $address_type;
             last; # do not need to loop any more.
         }
-        DEBUG("Message not relevant to bot");
+        DEBUG('Message not relevant to bot');
         return if(!defined $request);
         $body = $request;
     }
@@ -693,13 +702,14 @@ sub _process_jabber_message {
                                   type => $type,
                                   reply_to => $reply_to,
                                   bot_address_from => $bot_address_from,
-                                  message => $message
+                                  message => $message,
                                   );
         return;
     } else {
-        WARN("No handler for messages!");
+        WARN('No handler for messages!');
         INFO("New Message: $type from $from ($resource). sub=$subject -- $body");
     }
+    return;
 }
 
 =item B<get_responses>
@@ -716,7 +726,7 @@ sub get_responses {
     my $forum = shift;
 
     if(!defined $forum) {
-    WARN("No forum supplied for get_responses()");
+    WARN('No forum supplied for get_responses()');
     return;
     }
 
@@ -741,13 +751,13 @@ sub _jabber_in_iq_message {
     my $session_id = shift;
     my $iq = shift;
 
-    DEBUG("IQ Message:" . $iq->GetXML());
+    DEBUG('IQ Message:' . $iq->GetXML());
     my $from = $iq->GetFrom();
 #    my $type = $iq->GetType();DEBUG("Type=$type");
     my $query = $iq->GetQuery();#DEBUG("query=" . Dumper($query));
 
     if (!$query) {
-        DEBUG("iq->GetQuery() returned undef.");
+        DEBUG('iq->GetQuery() returned undef.');
         return;
     }
 
@@ -755,7 +765,7 @@ sub _jabber_in_iq_message {
     my $iqReply;
 
     # Respond to version requests with information about myself.
-    if($xmlns eq "jabber:iq:version") {
+    if($xmlns eq 'jabber:iq:version') {
         # convert 5.010000 to 5.10.0
         my $perl_version = $];
         $perl_version =~ s/(\d{3})(?=\d)/$1./g;
@@ -771,11 +781,12 @@ sub _jabber_in_iq_message {
     }
 
     if($iqReply) {
-        DEBUG("Reply: ", $iqReply->GetXML());
+        DEBUG('Reply: ', $iqReply->GetXML());
         $self->jabber_client->Send($iqReply);
     }
 
 #    INFO("IQ from $from ($type). XMLNS: $xmlns");
+    return;
 }
 
 =item B<_jabber_presence_message> - DO NOT CALL
@@ -794,14 +805,14 @@ sub _jabber_presence_message {
     my $type = $presence->GetType();
     if($type eq 'subscribe') { # Always allow people to subscribe to us. Why wouldn't we?
         my $from = $presence->GetFrom();
-        $self->jabber_client->Subscription(type=>"subscribe",
+        $self->jabber_client->Subscription(type=>'subscribe',
                                               to=>$from);
-        $self->jabber_client->Subscription(type=>"subscribed",to=>$from);
+        $self->jabber_client->Subscription(type=>'subscribed',to=>$from);
         INFO("Processed subscription request from $from");
         return;
     } elsif($type eq 'unsubscribe') { # Always allow people to subscribe to us. Why wouldn't we?
         my $from = $presence->GetFrom();
-        $self->jabber_client->Subscription(type=>"unsubscribed",
+        $self->jabber_client->Subscription(type=>'unsubscribed',
                                               to=>$from);
         INFO("Processed unsubscribe request from $from");
         return;
@@ -814,13 +825,14 @@ sub _jabber_presence_message {
     $self->jabber_client->PresenceDBParse($presence); # Since we are always an object just throw it into the db.
 
     my $from = $presence->GetFrom();
-    $from = "." if(!defined $from);
+    $from = '.' if(!defined $from);
 
     my $status = $presence->GetStatus();
-    $status = "." if(!defined $status);
+    $status = '.' if(!defined $status);
 
     DEBUG("Presence From $from t=$type s=$status");
-    DEBUG("Presence XML: " . $presence->GetXML());
+    DEBUG('Presence XML: ' . $presence->GetXML());
+    return;
 }
 
 =item B<respond_to_self_messages>
@@ -971,12 +983,12 @@ sub _send_individual_message {
     my $subject = shift;
 
     if(!defined $message_type) {
-        ERROR("Undefined \$message_type");
+        ERROR('Undefined $message_type'); ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
         return "No message type!\n";
     }
 
     if(!defined $recipient) {
-        ERROR('$recipient not defined!');
+        ERROR('$recipient not defined!'); ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
         return "No recipient!\n";
     }
 
@@ -985,15 +997,15 @@ sub _send_individual_message {
     my $messages_this_hour = $self->messages_sent_today->{$yday}->{$hour} += 1;
 
     if($messages_this_hour > $self->max_messages_per_hour) {
-        $subject = "" if(!defined $subject); # Keep warning messages quiet.
+        $subject = '' if(!defined $subject); # Keep warning messages quiet.
-        $message_chunk = "" if(!defined $message_chunk); # Keep warning messages quiet.
+        $message_chunk = '' if(!defined $message_chunk); # Keep warning messages quiet.
 
         ERROR("Can't Send message because we've already tried to send $messages_this_hour of $self->max_messages_per_hour messages this hour.\n"
               . "To: $recipient\n"
               . "Subject: $subject\n"
               . "Type: $message_type\n"
               . "Message sent:\n"
-              . "$message_chunk"
+              . "$message_chunk",
               );
 
         # Send 1 panic message out to jabber if this is our last message before quieting down.
@@ -1001,15 +1013,15 @@ sub _send_individual_message {
     }
 
     if(!$self->IsConnected) {
-        $subject = "" if(!defined $subject); # Keep warning messages quiet.
+        $subject = '' if(!defined $subject); # Keep warning messages quiet.
-        $message_chunk = "" if(!defined $message_chunk); # Keep warning messages quiet.
+        $message_chunk = '' if(!defined $message_chunk); # Keep warning messages quiet.
 
         ERROR("Can't Jabber server is down. Tried to send: \n"
               . "To: $recipient\n"
               . "Subject: $subject\n"
               . "Type: $message_type\n"
               . "Message sent:\n"
-              . "$message_chunk"
+              . "$message_chunk",
               );
 
         # Send 1 panic message out to jabber if this is our last message before quieting down.
@@ -1026,17 +1038,17 @@ sub _send_individual_message {
                      , body => $message_chunk
                      , type => $message_type
 #                     , from => $connection_hash{$obj_ID}{'from_full'}
-                     , subject => $subject
+                     , subject => $subject,
                      );
 
-    DEBUG("Sleeping " . $self->message_delay . " after sending message.");
+    DEBUG('Sleeping ' . $self->message_delay . ' after sending message.');
     Time::HiRes::sleep $self->message_delay; #Throttle messages.
 
     if($messages_this_hour == $self->max_messages_per_hour) {
         $self->jabber_client->MessageSend(to => $recipient
-                         , body => "Cannot send more messages this hour. "
+                         , body => 'Cannot send more messages this hour. '
-                         . "$messages_this_hour of " . $self->max_messages_per_hour . " already sent."
+                         . "$messages_this_hour of " . $self->max_messages_per_hour . ' already sent.'
-                         , type => $message_type
+                         , type => $message_type,
                          );
     }
     return; # Means we succeeded!
@@ -1059,9 +1071,9 @@ sub SetForumSubject {
     if(length $subject > $self->max_message_size) {
     my $subject_len = length($subject);
     ERROR("Someone tried to send a subject message $subject_len bytes long!");
-    my $subject = substr($subject, 0, $self->max_message_size);
+    my $subject = substr($subject, 0, $self->max_message_size); ## no critic (Variables::ProhibitReusedNames)
     DEBUG("Truncated subject: $subject");
-    return "Subject is too long!";
+    return 'Subject is too long!';
     }
     $self->_send_individual_message($recipient, "Setting subject to $subject", 'groupchat', $subject);
 
@@ -1123,7 +1135,7 @@ sub GetStatus {
 
     if (!(defined($Pres))) {
 
-        return "unavailable" ;
+        return 'unavailable' ;
     }
 
     my $show = $Pres->GetShow();
@@ -1132,7 +1144,7 @@ sub GetStatus {
         return $show;
     }
 
-    return "available";
+    return 'available';
 
 }
 
@@ -1146,8 +1158,9 @@ sub AddUser {
     my $self = shift;
     my $user = shift;
 
-    $self->jabber_client->Subscription(type=>"subscribe", to=>$user);
+    $self->jabber_client->Subscription(type=>'subscribe', to=>$user);
-    $self->jabber_client->Subscription(type=>"subscribed",to=>$user);
+    $self->jabber_client->Subscription(type=>'subscribed',to=>$user);
+    return;
 }
 
 =item B<RmUser>
@@ -1160,8 +1173,9 @@ sub RmUser {
     my $self = shift;
     my $user = shift;
 
-    $self->jabber_client->Subscription(type=>"unsubscribe", to=>$user);
+    $self->jabber_client->Subscription(type=>'unsubscribe', to=>$user);
-    $self->jabber_client->Subscription(type=>"unsubscribed",to=>$user);
+    $self->jabber_client->Subscription(type=>'unsubscribed',to=>$user);
+    return;
 }
 =back