ETT-1394 address warning: "CGI::Param called in list context"

docker-compose.yml

@@ -58,7 +58,7 @@ services:
     extends:
       file: common/docker/perl.yml
       service: perl
-    command: "prove -r imgsrv/t ls/t mdp-lib/t"
+    command: "prove -r imgsrv/t ls/t mb/t mdp-lib/t"
     profiles:
       - testing
 

ls/lib/LS/PIFiller/ListSearchResults.pm

@@ -1309,14 +1309,14 @@ sub handle_ANALYTICS_REPORT_URL_PI
     if ( $coll_id ) {
         push @parts, 'listis';
         push @parts, $coll_id;
-        push @parts, $cgi->param('lmt') || 'all';
+        push @parts, (scalar $cgi->param('lmt') || 'all');
     } else {
-        push @parts, $cgi->param('a');
+        push @parts, scalar $cgi->param('a');
     }
 
     foreach my $param ( $cgi->param ) {
         if ( $param =~ m,q[0-9]|field[0-9]|anyall[0-9]|op[0-9]|lmt, ) {
-            $tempCgi->param($param, $cgi->param($param));
+            $tempCgi->param($param, $cgi->multi_param($param));
         }
     }
     my $qs = $tempCgi->query_string;

ls/t/LS/PIFiller/ListSearchResults.t

@@ -0,0 +1,68 @@
+use Test::More;
+use UUID::Tiny;
+
+use Auth::Auth;
+use Data::Dumper;
+
+use lib "$ENV{SDRROOT}/ls/lib";
+use lib "$ENV{SDRROOT}/slip-lib";
+use lib "$ENV{SDRROOT}/mdp-lib";
+use lib "$ENV{SDRROOT}/mdp-lib/t/lib";
+use LS::PIFiller::ListSearchResults;
+#use Collection;
+
+
+my $C = new Context;
+my $cgi = new CGI;
+$C->set_object('CGI', $cgi);
+my $config = new MdpConfig(File::Spec->catdir($ENV{SDRROOT}, 'mdp-lib/Config/uber.conf'),
+                           File::Spec->catdir($ENV{SDRROOT}, 'slip-lib/Config/common.conf'));                           
+$C->set_object('MdpConfig', $config);
+
+my $db_user = $ENV{'MARIADB_USER'} || 'ht_testing';
+my $db = new Database($db_user);
+$C->set_object('Database', $db);
+
+my $dbh = $db->get_DBH;
+$C->set_object('DBI', $dbh);
+
+#my $auth = Auth::Auth->new($C);
+#$C->set_object( 'Auth', $auth );
+
+subtest "handle_ANALYTICS_REPORT_URL_PI" => sub {
+  # FIXME: find realistic examples of this, not copies of the collection builder tests
+  subtest "with a collection ID" => sub {
+    my $cgi = $C->get_object('CGI');
+    # Given a query q1=something&sort=cn_a&colltype=featured&a=listcs
+    # The analytics URL should be /mb/listcs/?q1=something&sort=cn_a
+    # This seems kind of brittle because handle_ANALYTICS_REPORT_URL_PI relies on CGI
+    # for the ordering of parameters when constructing the URL. There's no explicit sorting.
+    $cgi->param('c', '123');
+    $cgi->param('q1', 'something');
+    $cgi->param('sort', 'cn_a');
+    $cgi->param('colltype', 'featured');
+    $cgi->param('lmt', '10');
+    my $res = LS::PIFiller::ListSearchResults::handle_ANALYTICS_REPORT_URL_PI($C, '', {});
+    is($res, "/ls/listis/123/10?q1=something&lmt=10");
+    # Clean up
+    $C->set_object('CGI', new CGI);
+  };
+
+  subtest "without a collection ID" => sub {
+    my $cgi = $C->get_object('CGI');
+    # Given a query q1=something&sort=cn_a&colltype=featured&a=listcs
+    # The analytics URL should be /mb/listcs/?q1=something&sort=cn_a
+    # This seems kind of brittle because handle_ANALYTICS_REPORT_URL_PI relies on CGI
+    # for the ordering of parameters when constructing the URL. There's no explicit sorting.
+    $cgi->param('q1', 'something');
+    $cgi->param('sort', 'cn_a');
+    $cgi->param('colltype', 'featured');
+    $cgi->param('a', 'listcs');
+    my $res = LS::PIFiller::ListSearchResults::handle_ANALYTICS_REPORT_URL_PI($C, '', {});
+    is($res, "/ls/listcs?q1=something");
+    # Clean up
+    $C->set_object('CGI', new CGI);
+  };
+};
+
+done_testing();

mb/lib/MBooks/Operation/LogoutTrap.pm

@@ -158,7 +158,7 @@ sub redirect_and_exit {
 
     my $cgi = $C->get_object('CGI');
     my $temp_cgi = new CGI($redir_params);
-    $temp_cgi->param('debug', $cgi->param('debug'));
+    $temp_cgi->param('debug', scalar $cgi->param('debug'));
 
     my $redirect_url = $temp_cgi->self_url();
     MBooks::View::P_redirect_HTTP($C, $redirect_url);

mb/lib/MBooks/PIFiller/ListUtils.pm

@@ -1122,12 +1122,12 @@ sub handle_ANALYTICS_REPORT_URL_PI
     my @parts   = ('/mb');
     my $tempCgi = new CGI({});
 
-    push @parts, $cgi->param('a');
+    push @parts, scalar $cgi->param('a');
     push @parts, $coll_id;
 
     foreach my $param ( $cgi->param ) {
         if ( $param =~ m,q[0-9]|field[0-9]|anyall[0-9]|op[0-9]|lmt|sort|facet, ) {
-            $tempCgi->param( $param, $cgi->param($param) );
+            $tempCgi->param( $param, $cgi->multi_param($param) );
         }
     }
     my $qs = $tempCgi->query_string;

mb/t/MBooks/PIFiller/ListUtils.t

@@ -0,0 +1,44 @@
+use Test::More;
+use UUID::Tiny;
+
+use Auth::Auth;
+use Data::Dumper;
+
+use lib "$ENV{SDRROOT}/mb/lib";
+use lib "$ENV{SDRROOT}/slip-lib";
+use MBooks::PIFiller::ListUtils;
+use Collection;
+
+
+my $C = new Context;
+my $cgi = new CGI;
+$C->set_object('CGI', $cgi);
+my $config = new MdpConfig(File::Spec->catdir($ENV{SDRROOT}, 'mdp-lib/Config/uber.conf'),
+                           File::Spec->catdir($ENV{SDRROOT}, 'slip-lib/Config/common.conf'));                           
+$C->set_object('MdpConfig', $config);
+
+my $db_user = $ENV{'MARIADB_USER'} || 'ht_testing';
+my $db = new Database($db_user);
+$C->set_object('Database', $db);
+
+my $dbh = $db->get_DBH;
+$C->set_object('DBI', $dbh);
+
+#my $auth = Auth::Auth->new($C);
+#$C->set_object( 'Auth', $auth );
+
+subtest "handle_ANALYTICS_REPORT_URL_PI" => sub {
+  # Given a query a=listis&c=123&sort=title_d
+  # The analytics URL should be /mb/listcs/<COLLID>?q1=something&amp;sort=cn_a
+  # This seems kind of brittle because handle_ANALYTICS_REPORT_URL_PI relies on CGI
+  # for the ordering of parameters when constructing the URL. There's no explicit sorting.
+  $cgi->param('a', 'listis');
+  $cgi->param('c', '123');
+  $cgi->param('sort', 'title_d');  
+  my $res = MBooks::PIFiller::ListUtils::handle_ANALYTICS_REPORT_URL_PI($C, '', {});
+  is($res, '/mb/listis/123?sort=title_d');
+  # Clean up
+  $C->set_object('CGI', new CGI);
+};
+
+done_testing();

pt/lib/PT/Prolog.pm

@@ -131,7 +131,7 @@ sub Run {
             $cgi->param('seq', $ownerid_seq);
         } else {
             # log the ownerid failure to the appropriate seq
-            $ses->set_transient_subkey('messages', $cgi->param('seq'), 'ownerid');
+            $ses->set_transient_subkey('messages', scalar $cgi->param('seq'), 'ownerid');
         }
     }