Some strictures

.perlcriticrc

@@ -8,7 +8,7 @@ severity = 1
 # Work based on a whitelist
 only = 1
 # Our whitelist (ignores severity):
-include = ExplicitReturnUndef GlobFunction NegativeIndices PrivateVars UselessInitialization MatchVars NumberSeparators NullStatements LongChainsOfMethodCalls UseStrict UseWarnings EndWithOne ConditionalUseStatements PackageMatchesPodName JoinedReadline UnreachableCode TrailingWhitespace InterpolationOfLiterals ImplicitNewlines CommaSeparatedStatements UnusedVariables UnusedCapture TwoArgOpen ProhibitHardTabs MismatchedOperators IndirectSyntax Modules:: BuiltinFunctions:: ClassHierarchies:: CommaSeparatedStatements QuotesAsQuotelikeOperatorDelimiters MixedBooleanOperators ProhibitBarewordFileHandles ConditionalUseStatements Modules::ProhibitAutomaticExportation ProhibitBarewordFileHandles ConditionalDeclarations
+include = ExplicitReturnUndef GlobFunction NegativeIndices PrivateVars UselessInitialization MatchVars NumberSeparators NullStatements LongChainsOfMethodCalls UseStrict EndWithOne ConditionalUseStatements PackageMatchesPodName JoinedReadline UnreachableCode TrailingWhitespace InterpolationOfLiterals ImplicitNewlines CommaSeparatedStatements UnusedVariables UnusedCapture TwoArgOpen ProhibitHardTabs MismatchedOperators IndirectSyntax Modules:: BuiltinFunctions:: ClassHierarchies:: CommaSeparatedStatements QuotesAsQuotelikeOperatorDelimiters MixedBooleanOperators ProhibitBarewordFileHandles ConditionalUseStatements Modules::ProhibitAutomaticExportation ProhibitBarewordFileHandles ConditionalDeclarations
 #include = MixedBooleanOperators InteractiveTest UpperCaseHeredoc ReusedNames PackageVars ConditionalDeclarations SingleCharAlternation FixedStringMatches ConditionalUseStatements QuotedWordLists
 
 exclude = RequireFilenameMatchesPackage RequireVersionVar ProhibitExcessMainComplexity ProhibitStringySplit ComplexMappings StringyEval Documentation::PodSpell BuiltinFunctions::ProhibitUselessTopic

lemonldap-ng-common/lib/Lemonldap/NG/Common/Apache/Session.pm

@@ -30,14 +30,14 @@ sub populate {
     my $self    = shift;
     my $backend = $self->{args}->{backend};
     _load($backend);
-    $backend .= "::populate";
+    $backend .= '::populate';
     {
         no strict 'refs';
         $self = $self->$backend(@_);
     }
     if ( $backend =~
 /^Apache::Session::(?:(?:Postgre|Redi)s|S(?:QLite3|ybase)|(?:My|No)SQL|F(?:ile|lex)|Cassandra|Oracle|LDAP)/
-        and !$self->{args}->{useStorable} )
+        and not $self->{args}->{useStorable} )
     {
         $self->{serialize} =
           \&Lemonldap::NG::Common::Apache::Session::Serialize::JSON::serialize;
@@ -52,8 +52,8 @@ sub populate {
         my $generate = $self->{args}->{generateModule};
         eval "require $generate";
         die $@ if ($@);
-        $self->{generate} = \&{ $generate . "::generate" };
-        $self->{validate} = \&{ $generate . "::validate" };
+        $self->{generate} = \&{ $generate . '::generate' };
+        $self->{validate} = \&{ $generate . '::validate' };
     }
     if ( $self->{args}->{setId} ) {
         $self->{generate} = \&setId;
@@ -72,6 +72,8 @@ sub populate {
     return $self;
 }
 
+1;
+
 __END__
 
 sub setId {

lemonldap-ng-common/lib/Lemonldap/NG/Common/Apache/Session/Generate/SHA256.pm

@@ -30,7 +30,7 @@ sub generate {
         ),
         0, $length
     );
-
+    return;
 }
 
 sub validate {
@@ -42,10 +42,10 @@ sub validate {
     my $session = shift;
 
     if ( $session->{data}->{_session_id} =~ /^([a-fA-F0-9]+)$/ ) {
-        $session->{data}->{_session_id} = $1;
+        return $session->{data}->{_session_id} = $1;
     }
     else {
-        die "Invalid session ID: " . $session->{data}->{_session_id};
+        die 'Invalid session ID: ' . $session->{data}->{_session_id};
     }
 }
 

lemonldap-ng-common/lib/Lemonldap/NG/Common/Apache/Session/Lock.pm

@@ -41,9 +41,10 @@ sub acquire_read_lock {
     if ( $self->cache->get($id) ) {
 
         # got session from cache, no need to ask for locks
+        return
     }
     else {
-        $self->module->acquire_read_lock($session);
+        return $self->module->acquire_read_lock($session);
     }
 }
 
@@ -51,21 +52,21 @@ sub acquire_write_lock {
     my $self    = shift;
     my $session = shift;
 
-    $self->module->acquire_write_lock($session);
+    return $self->module->acquire_write_lock($session);
 }
 
 sub release_write_lock {
     my $self    = shift;
     my $session = shift;
 
-    $self->module->release_write_lock($session);
+    return $self->module->release_write_lock($session);
 }
 
 sub release_all_locks {
     my $self    = shift;
     my $session = shift;
 
-    $self->module->release_all_locks($session);
+    return $self->module->release_all_locks($session);
 }
 
 1;

lemonldap-ng-common/lib/Lemonldap/NG/Common/Apache/Session/REST.pm

@@ -7,14 +7,14 @@ use JSON qw(from_json to_json);
 
 our $VERSION = '2.1.0';
 
-our @ISA = qw(Lemonldap::NG::Common::Apache::Session::Generate::SHA256);
+use base 'Lemonldap::NG::Common::Apache::Session::Generate::SHA256';
 
 # PUBLIC INTERFACE
 
 # Constructor for Perl TIE mechanism. See perltie(3) for more.
 sub TIEHASH {
     my ( $class, $session_id, $args ) = @_;
-    die "baseUrl argument is required"
+    die 'baseUrl argument is required'
       unless ( $args and $args->{baseUrl} );
     my $self = {
         data     => { _session_id => $session_id },
@@ -37,7 +37,7 @@ sub TIEHASH {
         $self->newSession;
     }
     else {
-        die "unable to create session"
+        die 'unable to create session'
           unless ( $self->newSession() );
     }
     return $self;
@@ -65,7 +65,7 @@ sub DELETE {
 
     $self->{modified} = 1;
 
-    delete $self->{data}->{$key};
+    return delete $self->{data}->{$key};
 }
 
 sub CLEAR {
@@ -73,7 +73,7 @@ sub CLEAR {
 
     $self->{modified} = 1;
 
-    $self->{data} = {};
+    return $self->{data} = {};
 }
 
 sub EXISTS {
@@ -95,7 +95,7 @@ sub NEXTKEY {
 
 sub DESTROY {
     my $self = shift;
-    $self->save;
+    return $self->save;
 }
 
 sub ua {
@@ -207,7 +207,7 @@ sub save {
 
     # Update session in cache
     if ( $self->{localStorage} ) {
-        my $id = "rest" . $self->{data}->{_session_id};
+        my $id = 'rest' . $self->{data}->{_session_id};
         if ( $self->cache->get($id) ) {
             $self->cache->remove($id);
         }
@@ -236,7 +236,7 @@ sub save {
         return $res;
     }
     else {
-        print STDERR "REST server returns " . $resp->status_line;
+        print STDERR 'REST server returns ' . $resp->status_line;
         return;
     }
 }
@@ -248,7 +248,7 @@ sub delete {
 
     # Remove session from cache
     if ( $self->{localStorage} ) {
-        my $id = "rest" . $self->{data}->{_session_id};
+        my $id = 'rest' . $self->{data}->{_session_id};
         if ( $self->cache->get($id) ) {
             $self->cache->remove($id);
         }
@@ -265,7 +265,7 @@ sub delete {
 ## @method get_key_from_all_sessions()
 # Not documented.
 sub get_key_from_all_sessions() {
-    die "Not implemented";
+    die 'Not implemented';
     my ( $class, $args, $data ) = @_;
     my $self = bless {}, $class;
     foreach (qw(baseUrl user password realm)) {
@@ -303,10 +303,10 @@ sub cache {
 1;
 __END__
 
-=head1 NAME
-
 =encoding utf8
 
+=head1 NAME
+
 Lemonldap::NG::Common::Apache::Session::REST - Perl extension written to
 access to Lemonldap::NG Web-SSO sessions via REST.
 

lemonldap-ng-common/lib/Lemonldap/NG/Common/Apache/Session/SOAP.pm

@@ -38,8 +38,7 @@ sub TIEHASH {
 
     my $session_id = shift;
     my $args       = shift;
-    my ( $proxy, $proxyOptions );
-    die "proxy argument is required"
+    die 'proxy argument is required'
       unless ( $args and $args->{proxy} );
     my $self = {
         data     => { _session_id => $session_id },
@@ -56,7 +55,7 @@ sub TIEHASH {
           unless ( $self->get($session_id) );
     }
     else {
-        die "unable to create session"
+        die 'unable to create session'
           unless ( $self->newSession() );
     }
     return $self;
@@ -84,7 +83,7 @@ sub DELETE {
 
     $self->{modified} = 1;
 
-    delete $self->{data}->{$key};
+    return delete $self->{data}->{$key};
 }
 
 sub CLEAR {
@@ -92,7 +91,7 @@ sub CLEAR {
 
     $self->{modified} = 1;
 
-    $self->{data} = {};
+    return $self->{data} = {};
 }
 
 sub EXISTS {
@@ -114,7 +113,7 @@ sub NEXTKEY {
 
 sub DESTROY {
     my $self = shift;
-    $self->save;
+    return $self->save;
 }
 
 ## @method private SOAP::Lite _connect()
@@ -139,7 +138,7 @@ sub _soapCall {
     my $func = shift;
     my $r    = $self->_connect->$func(@_);
     if ( $r->fault ) {
-        print STDERR "SOAP Error: " . $r->fault->{faultstring};
+        print STDERR 'SOAP Error: ' . $r->fault->{faultstring};
         return ();
     }
     return $r->result;
@@ -158,7 +157,7 @@ sub get {
     }
 
     # No cache, use SOAP and set cache
-    my $r = $self->_soapCall( "getAttributes", $id );
+    my $r = $self->_soapCall( 'getAttributes', $id );
     return 0 unless ( $r or $r->{error} );
     $self->{data} = $r->{attributes};
 
@@ -172,11 +171,11 @@ sub get {
 # @return User data (just the session ID)
 sub newSession {
     my $self = shift;
-    $self->{data} = $self->_soapCall("newSession");
+    $self->{data} = $self->_soapCall('newSession');
 
     # Set cache
     if ( $self->{localStorage} ) {
-        my $id = "soap" . $self->{data}->{_session_id};
+        my $id = 'soap' . $self->{data}->{_session_id};
         if ( $self->cache->get($id) ) {
             $self->cache->remove($id);
         }
@@ -194,7 +193,7 @@ sub save {
 
     # Update session in cache
     if ( $self->{localStorage} ) {
-        my $id = "soap" . $self->{data}->{_session_id};
+        my $id = 'soap' . $self->{data}->{_session_id};
         if ( $self->cache->get($id) ) {
             $self->cache->remove($id);
         }
@@ -202,7 +201,7 @@ sub save {
     }
 
     # SOAP
-    return $self->_soapCall( "setAttributes", $self->{data}->{_session_id},
+    return $self->_soapCall( 'setAttributes', $self->{data}->{_session_id},
         $self->{data} );
 }
 
@@ -213,14 +212,14 @@ sub delete {
 
     # Remove session from cache
     if ( $self->{localStorage} ) {
-        my $id = "soap" . $self->{data}->{_session_id};
+        my $id = 'soap' . $self->{data}->{_session_id};
         if ( $self->cache->get($id) ) {
             $self->cache->remove($id);
         }
     }
 
     # SOAP
-    return $self->_soapCall( "deleteSession", $self->{data}->{_session_id} );
+    return $self->_soapCall( 'deleteSession', $self->{data}->{_session_id} );
 }
 
 ## @method get_key_from_all_sessions()
@@ -240,7 +239,7 @@ sub get_key_from_all_sessions() {
     my $token = Lemonldap::NG::Handler::Main->tsv->{cipher}
       ->decrypt( $self->_soapCall('getCipheredToken') );
     if ( ref($data) eq 'CODE' ) {
-        my $r = $self->_soapCall( "get_key_from_all_sessions", $token );
+        my $r = $self->_soapCall( 'get_key_from_all_sessions', $token );
         my $res;
         if ($r) {
             foreach my $k ( keys %$r ) {
@@ -248,9 +247,10 @@ sub get_key_from_all_sessions() {
                 $res->{$k} = $tmp if ( defined($tmp) );
             }
         }
+        return;
     }
     else {
-        return $self->_soapCall( "get_key_from_all_sessions", $token, $data );
+        return $self->_soapCall( 'get_key_from_all_sessions', $token, $data );
     }
 }
 
@@ -269,10 +269,10 @@ sub cache {
 1;
 __END__
 
-=head1 NAME
-
 =encoding utf8
 
+=head1 NAME
+
 Lemonldap::NG::Common::Apache::Session::SOAP - Perl extension written to
 access to Lemonldap::NG Web-SSO sessions via SOAP.
 

lemonldap-ng-common/lib/Lemonldap/NG/Common/Apache/Session/Serialize/JSON.pm

@@ -8,23 +8,24 @@ our $VERSION = '2.1.0';
 sub serialize {
     my $session = shift;
 
-    $session->{serialized} = to_json( $session->{data}, { allow_nonref => 1 } );
+    return $session->{serialized} =
+      to_json( $session->{data}, { allow_nonref => 1 } );
 }
 
 sub unserialize {
     my $session = shift;
 
     my $data = _unserialize( $session->{serialized} );
-    die "Session could not be unserialized" unless defined $data;
-    $session->{data} = $data;
+    die 'Session could not be unserialized' unless defined $data;
+    return $session->{data} = $data;
 }
 
 sub unserializeBase64 {
     my $session = shift;
 
     my $data = _unserialize( $session->{serialized}, \&decodeThaw64 );
-    die "Session could not be unserialized" unless defined $data;
-    $session->{data} = $data;
+    die 'Session could not be unserialized' unless defined $data;
+    return $session->{data} = $data;
 }
 
 sub decodeThaw64 {
@@ -49,10 +50,10 @@ sub _unserialize {
 
 =pod
 
-=head1 NAME
-
 =encoding utf8
 
+=head1 NAME
+
 Lemonldap::NG::Common::Apache::Session::Serialize::JSON - Use JSON to zip up data
 
 =head1 SYNOPSIS

lemonldap-ng-common/lib/Lemonldap/NG/Common/Apache/Session/Store.pm

-
 package Lemonldap::NG::Common::Apache::Session::Store;
 
+use strict;
+
 our $VERSION = '2.1.0';
 
 sub new {

lemonldap-ng-common/lib/Lemonldap/NG/Common/Combination/Parser.pm

@@ -163,7 +163,7 @@ sub findB {
     my @chars = split //, $expr;
     while (@chars) {
         my $c = shift @chars;
-        if ( $c eq "\\" ) {
+        if ( $c eq '\\' ) {
             $res .= $c . shift(@chars);
             next;
         }
@@ -175,11 +175,11 @@ sub findB {
         }
         if ( $c =~ /^(?:\(|\{|\[|'|")$/ ) {
             my $wanted = {
-                '(' => ')',
-                '{' => '}',
-                '[' => ']',
-                "'" => "'",
-                '"' => '"'
+                '('  => ')',
+                '{'  => '}',
+                '['  => ']',
+                '\'' => '\'',
+                '"'  => '"'
             }->{$c};
             my ( $m, $rest ) =
               $self->findB( join( '', @chars ), $wanted );
@@ -192,7 +192,7 @@ sub findB {
         }
         $res .= $c;
     }
-    return undef;
+    return;
 }
 
 # Compiles condition into sub

lemonldap-ng-common/lib/Lemonldap/NG/Common/Logger/Dispatch.pm

@@ -24,13 +24,10 @@ sub new {
                 $bck{$last} = $last->new(@_);
             }
             my $obj = $bck{$last};
-            eval "sub $l {
-                shift;
-                return \$obj->$l(\@_);
-            }";
+            eval "sub $l { shift; return \$obj->$l(\@_); }";
         }
         else {
-            eval qq'sub $l {1}';
+            eval "sub $l {1}";
         }
         $show = 0 if ( $conf->{logLevel} eq $l );
 

lemonldap-ng-common/lib/Lemonldap/NG/Common/Logger/Null.pm

 package Lemonldap::NG::Common::Logger::Null;
 
+use strict;
+
 our $VERSION = '2.1.0';
 
 sub new {

lemonldap-ng-common/lib/Lemonldap/NG/Common/Logger/Sentry.pm

@@ -23,11 +23,11 @@ sub new {
         $rl = 'info'    if ( $rl = 'notice' );
         if ($show) {
             eval
-qq'sub $_ {\$_[0]->{raven}->capture_message(\$_[1],level => "$rl")}';
+qq@sub $_ {\$_[0]->{raven}->capture_message(\$_[1],level => "$rl")}@;
             die $@ if ($@);
         }
         else {
-            eval qq'sub $_ {1}';
+            eval "sub $_ {1}";
         }
         $show = 0 if ( $conf->{logLevel} eq $_ );
     }

lemonldap-ng-common/lib/Lemonldap/NG/Common/Logger/Std.pm

@@ -10,10 +10,10 @@ sub new {
     my $show = 1;
     foreach (qw(error warn notice info debug)) {
         if ($show) {
-            eval qq'sub $_ {print STDERR "[$_] \$_[1]\n"}';
+            eval qq@sub $_ {print STDERR "[$_] \$_[1]\n"}@;
         }
         else {
-            eval qq'sub $_ {1}';
+            eval qq@sub $_ {1}@;
         }
         $show = 0 if ( $level eq $_ );
     }

lemonldap-ng-common/lib/Lemonldap/NG/Common/Logger/Syslog.pm

@@ -23,11 +23,11 @@ sub new {
             my $name = $_;
             $name = 'warning' if ( $_ eq 'warn' );
             $name = 'err'     if ( $_ eq 'error' );
-            eval qq'sub $_ {syslog("$name|".\$_[0]->{facility},\$_[1])}';
+            eval qq@sub $_ {syslog("$name|".\$_[0]->{facility},\$_[1])}@;
             die $@ if ($@);
         }
         else {
-            eval qq'sub $_ {1}';
+            eval "sub $_ {1}";
         }
         $show = 0 if ( $level eq $_ );
     }

lemonldap-ng-common/lib/Lemonldap/NG/Common/PSGI/Cli/Lib.pm

@@ -118,12 +118,12 @@ sub _del {
 sub jsonResponse {
     my ( $self, $path, $query ) = @_;
     my $res = $self->_get( $path, $query )
-      or die "PSGI lib has refused my get, aborting";
+      or die 'PSGI lib has refused my get, aborting';
     unless ( $res->[0] == 200 ) {
         require Data::Dumper;
         $Data::Dumper::Useperl = 1;
         print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
-        die "Manager lib does not return a 200 code, aborting";
+        die 'Manager lib does not return a 200 code, aborting';
     }
     my $href = from_json( $res->[2]->[0], { allow_nonref => 1 } )
       or die 'Response is not JSON';
@@ -133,12 +133,12 @@ sub jsonResponse {
 sub jsonPostResponse {
     my ( $self, $path, $query, $body, $type, $len ) = @_;
     my $res = $self->_post( $path, $query, $body, $type, $len )
-      or die "PSGI lib has refused my post, aborting";
+      or die 'PSGI lib has refused my post, aborting';
     unless ( $res->[0] == 200 ) {
         require Data::Dumper;
         $Data::Dumper::Useperl = 1;
         print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
-        die "Manager lib does not return a 200 code, aborting";
+        die 'Manager lib does not return a 200 code, aborting';
     }
     my $href = from_json( $res->[2]->[0], { allow_nonref => 1 } )
       or die 'Response is not JSON';
@@ -148,12 +148,12 @@ sub jsonPostResponse {
 sub jsonPutResponse {
     my ( $self, $path, $query, $body, $type, $len ) = @_;
     my $res = $self->_put( $path, $query, $body, $type, $len )
-      or die "PSGI lib has refused my put, aborting";
+      or die 'PSGI lib has refused my put, aborting';
     unless ( $res->[0] == 200 ) {
         require Data::Dumper;
         $Data::Dumper::Useperl = 1;
         print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
-        die "Manager lib does not return a 200 code, aborting";
+        die 'Manager lib does not return a 200 code, aborting';
     }
     my $href = from_json( $res->[2]->[0], { allow_nonref => 1 } )
       or die 'Response is not JSON';

lemonldap-ng-common/lib/Lemonldap/NG/Common/PSGI/Request.pm

@@ -9,7 +9,7 @@ use URI::Escape;
 
 our $VERSION = '2.1.0';
 
-our @ISA = ('Plack::Request');
+use base 'Plack::Request';
 
 #       http          ://  server   / path      ? query      # fragment
 # m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
@@ -19,6 +19,7 @@ sub BUILD {
     foreach ( keys %$env ) {
         $self->{$_} ||= $env->{$_} if (/^(?:HTTP|SSL)_/);
     }
+    return $self;
 }
 
 sub new {
@@ -39,9 +40,9 @@ sub new {
     return bless( $self, $_[0] );
 }
 
-sub data { $_[0]->{data} }
+sub data { return $_[0]->{data} }
 
-sub uri { $_[0]->{uri} }
+sub uri { return $_[0]->{uri} }
 
 sub userData {
     my ( $self, $v ) = @_;
@@ -55,13 +56,13 @@ sub respHeaders {
     return $self->{respHeaders};
 }
 
-sub accept        { $_[0]->env->{HTTP_ACCEPT} }
-sub encodings     { $_[0]->env->{HTTP_ACCEPT_ENCODING} }
-sub languages     { $_[0]->env->{HTTP_ACCEPT_LANGUAGE} }
-sub authorization { $_[0]->env->{HTTP_AUTHORIZATION} }
-sub hostname      { $_[0]->env->{HTTP_HOST} }
-sub referer       { $_[0]->env->{REFERER} }
-sub query_string  { $_[0]->env->{QUERY_STRING} }