Code removal fest

Dockerfile

@@ -9,41 +9,30 @@ RUN apt-get update && apt-get install -y \
   sqlite3 \
   file \
   libalgorithm-diff-xs-perl \
-  libany-moose-perl \
   libapache-session-perl \
   libarchive-zip-perl \
   libcapture-tiny-perl \
   libcgi-application-perl \
-  libcgi-compile-perl \
-  libcgi-emulate-psgi-perl \
   libcgi-psgi-perl \
-  libclass-accessor-perl \
   libclass-c3-perl \
   libclass-data-accessor-perl \
   libclass-data-inheritable-perl \
   libclass-errorhandler-perl \
   libclass-load-perl \
-  libcommon-sense-perl \
   libcompress-raw-zlib-perl \
   libconfig-auto-perl \
   libconfig-inifiles-perl \
   libconfig-tiny-perl \
-  libcrypt-openssl-random-perl \
-  libcrypt-openssl-rsa-perl \
-  libcrypt-ssleay-perl \
   libdata-optlist-perl \
   libdata-page-perl \
   libdate-calc-perl \
   libdate-manip-perl \
   libdbd-mock-perl \
   libdbd-mysql-perl \
   libdbd-sqlite3-perl \
-  libdevel-globaldestruction-perl \
   libdigest-sha-perl \
   libemail-date-format-perl \
   libencode-locale-perl \
-  liberror-perl \
-  libeval-closure-perl \
   libexcel-writer-xlsx-perl \
   libfcgi-perl \
   libfcgi-procmanager-perl \
@@ -60,9 +49,6 @@ RUN apt-get update && apt-get install -y \
   libhttp-dav-perl \
   libhttp-message-perl \
   libhttp-negotiate-perl \
-  libimage-exiftool-perl \
-  libimage-info-perl \
-  libimage-size-perl \
   libinline-perl \
   libio-html-perl \
   libio-socket-ssl-perl \
@@ -71,53 +57,36 @@ RUN apt-get update && apt-get install -y \
   libjson-perl \
   libjson-pp-perl \
   libjson-xs-perl \
-  liblist-compare-perl \
   liblist-moreutils-perl \
   liblog-log4perl-perl \
   liblwp-authen-oauth2-perl \
   liblwp-mediatypes-perl \
   libmail-sendmail-perl \
   libmailtools-perl \
+  libmarc-record-perl \
+  libmarc-xml-perl \
   libmime-lite-perl \
   libmime-types-perl \
   libmodule-implementation-perl \
   libmodule-runtime-perl \
   libmoose-perl \
   libmouse-perl \
-  libmro-compat-perl \
   libnet-dns-perl \
   libnet-http-perl \
-  libnet-libidn-perl \
-  libnet-oauth-perl \
-  libnet-ssleay-perl \
-  libpackage-deprecationmanager-perl \
-  libpackage-stash-perl \
   libparse-recdescent-perl \
   libplack-perl \
-  libpod-simple-perl \
-  libproc-processtable-perl \
-  libreadonly-perl \
-  libreadonly-xs-perl \
-  libroman-perl \
-  libsoap-lite-perl \
   libspreadsheet-writeexcel-perl \
-  libsub-exporter-progressive-perl \
-  libsub-name-perl \
   libtemplate-perl \
   libterm-readkey-perl \
   libterm-readline-gnu-perl \
-  libtest-requiresinternet-perl \
   libtest-simple-perl \
-  libtie-ixhash-perl \
   libtimedate-perl \
   libtry-tiny-perl \
-  libuniversal-require-perl \
   liburi-encode-perl \
   libuuid-perl \
   libuuid-tiny-perl \
   libversion-perl \
   libwww-perl \
-  libwww-robotrules-perl \
   libxml-dom-perl \
   libxml-libxml-perl \
   libxml-libxslt-perl \
@@ -126,9 +95,7 @@ RUN apt-get update && apt-get install -y \
   libxml-writer-perl \
   libyaml-appconfig-perl \
   libyaml-libyaml-perl \
-  libyaml-perl \
-  libmarc-record-perl \
-  libmarc-xml-perl
+  libyaml-perl
 
 RUN apt-get install -y \
   autoconf \
@@ -139,23 +106,15 @@ RUN apt-get install -y \
   libdevel-cover-perl \
   libffi-dev \
   libgdbm-dev \
-  libncurses5-dev \
   libperl-critic-perl \
   libreadline6-dev \
   libsqlite3-dev \
   libssl-dev \
-  libyaml-dev \
-  netcat \
-  openssh-server \
-  unzip \
-  wget \
-  zip \
-  zlib1g-dev
+  libyaml-dev
 
 RUN cpanm --notest \
   Devel::Cover::Report::Coveralls \
   MARC::Record::MiJ \
-  OAuth::Lite \
   Test::Exception \
   Test::LWP::UserAgent
 

bin/criticize.pl

@@ -21,9 +21,8 @@ BEGIN
 my $usage = <<END;
 USAGE: $0
 
-Runs Perl::Critic on all .pm, .pl, and extensionless files in cgi/ and bin/.
-This is offered as a sort of sanity check and is not currently part of the
-test suite.
+Runs Perl::Critic on all .pm, .pl, and extensionless files in bin/, cgi/, lib/, and t/.
+This is not currently part of the test suite.
 
 -h       Print this help message.
 -v       Emit verbose debugging information. May be repeated.
@@ -39,39 +38,36 @@ END
 if ($help) { print $usage. "\n"; exit(0); }
 print "Verbosity $verbose\n" if $verbose;
 
-
 my $critic = Perl::Critic->new();
 
-my @dirs = ($ENV{'SDRROOT'}. '/crms/cgi', $ENV{'SDRROOT'}. '/crms/bin');
+my $exit_status = 0;
+my @dirs = map { $ENV{SDRROOT} . $_; } ('/crms/bin', '/crms/cgi', '/crms/lib', '/crms/t');
 my %seen;
-while (my $pwd = shift @dirs)
-{
-  opendir(DIR, "$pwd") or die "Can't open $pwd\n";
+while (my $dir = shift @dirs) {
+  opendir(DIR, "$dir") or die "Can't open $dir\n";
   my @files = readdir(DIR);
   closedir(DIR);
-  foreach my $file (sort @files)
-  {
+  foreach my $file (sort @files) {
     next if $file =~ /^\.\.?$/;
-    next if $file eq 'legacy';
-    my $path = "$pwd/$file";
-    if (-d $path)
-    {
+    my $path = "$dir/$file";
+    if (-d $path) {
       next if $seen{$path};
       $seen{$path} = 1;
       push @dirs, $path;
     }
     my $desc = `file $path`;
     chomp $desc;
-    next unless $desc =~ m/perl/i;
-    my @violations = $critic->critique($path);
-    if (scalar @violations)
-    {
-      print RED "$path\n";
-      print BOLD "  $_" for @violations;
-    }
-    else
-    {
-      print GREEN "$path\n";
+    if ($desc =~ m/perl/i || $path =~ m/\.pm$/ || $path =~ m/\.t$/) {
+      my @violations = $critic->critique($path);
+      if (scalar @violations) {
+        print RED "$path\n";
+        print BOLD "  $_" for @violations;
+        $exit_status = 1;
+      }
+      else {
+        print GREEN "$path\n" if $verbose;
+      }
     }
   }
 }
+exit($exit_status);

bin/newyear.pl

@@ -438,7 +438,7 @@ sub SubmitNewYearReview
       $record->title || '', $record->publication_date->text || '',
       $record->country || '', "$acurr/$rcurr", $extracted_data,
       $predictions, "$new_attr/$new_reason", $msg);
-    @values = map { local $_ = $_; $_ =~ s/\s+/ /g; $_; } @values;
+    @values = map { s/\s+/ /gr } @values;
     printf $tsv_fh "%s\n", join("\t", @values);
   }
 }

cgi/CRMS.pm

@@ -1,5 +1,9 @@
 package CRMS;
 
+use strict;
+use warnings;
+use utf8;
+
 ## ----------------------------------------------------------
 ## Object of shared code for the CRMS DB CGI and BIN scripts.
 ## ----------------------------------------------------------
@@ -10,10 +14,6 @@ BEGIN {
   use lib $ENV{'SDRROOT'} . '/crms/lib';
 }
 
-use strict;
-use warnings;
-use utf8;
-
 use CGI;
 use Data::Dumper;
 use Date::Calc qw(:all);
@@ -255,7 +255,7 @@ sub WebPath
     $fullpath = ($type eq 'web')? ("/c/crms/". $path): ("/$type/c/crms/". $path);
   }
   #print "$fullpath ($type, $path)\n";
-  return $self->Sysify($fullpath);
+  return $fullpath;
 }
 
 # The href or URL to use.
@@ -1105,7 +1105,7 @@ sub WriteRightsFile
   }
   my $temp = $perm . '.tmp';
   if (-f $temp) { die "file already exists: $temp\n"; }
-  open (my $fh, '>:utf8', $temp) || die "failed to open rights file ($temp): $!\n";
+  open (my $fh, '>:encoding(UTF-8)', $temp) || die "failed to open rights file ($temp): $!\n";
   print $fh $rights;
   close $fh;
   rename $temp, $perm;
@@ -1273,7 +1273,7 @@ sub CheckAndLoadItemIntoCandidates
       $self->RemoveFromCandidates($id);
     }
   }
-  return undef;
+  return;
 }
 
 sub AddItemToCandidates
@@ -3445,7 +3445,7 @@ sub LinkToReview
 
   $title = $self->GetTitle($id) unless $title;
   $title = CGI::escapeHTML($title);
-  my $url = $self->Sysify($self->WebPath('cgi', "crms?p=review;htid=$id;editing=1"));
+  my $url = $self->WebPath('cgi', "crms?p=review;htid=$id;editing=1");
   $url .= ";importUser=$user" if $user;
   $self->ClearErrors();
   return "<a href='$url' target='_blank'>$title</a>";
@@ -5762,34 +5762,6 @@ sub CountCorrectReviews
   return ($correct, $incorrect, $neutral);
 }
 
-# Gets only those reviewers that are not experts
-sub GetType1Reviewers
-{
-  my $self = shift;
-
-  my $sql = 'SELECT id FROM users WHERE id NOT LIKE "rereport%" AND expert=0';
-  return map {$_->[0]} @{ $self->SelectAll($sql) };
-}
-
-sub GetValidation
-{
-  my $self  = shift;
-  my $start = shift;
-  my $end   = shift;
-  my $users = shift;
-
-  # FIXME: what purpose does GetType1Reviewers serve here?
-  $users = sprintf '"%s"', join '","', $self->GetType1Reviewers() unless $users;
-  $start = substr($start,0,7);
-  $end = substr($end,0,7);
-  my $sql = 'SELECT SUM(total_reviews),SUM(total_correct),SUM(total_incorrect),SUM(total_neutral) FROM userstats' .
-            " WHERE monthyear>=? AND monthyear<=? AND user IN ($users)";
-  #print "$sql<br/>\n";
-  my $ref = $self->SelectAll($sql, $start, $end);
-  my $row = $ref->[0];
-  return @{ $row };
-}
-
 sub ReviewSearchMenu
 {
   my $self       = shift;
@@ -6440,7 +6412,7 @@ sub LinkNoteText
 
   if ($note =~ m/See\sall\sreviews\sfor\sSys\s#(\d+)/)
   {
-    my $url = $self->Sysify($self->WebPath('cgi', "crms?p=adminHistoricalReviews;stype=reviews;search1=SysID;search1value=$1"));
+    my $url = $self->WebPath('cgi', "crms?p=adminHistoricalReviews;stype=reviews;search1=SysID;search1value=$1");
     $note =~ s/(See\sall\sreviews\sfor\sSys\s#)(\d+)/$1<a href="$url" target="_blank">$2<\/a>/;
   }
   return $note;
@@ -6851,7 +6823,7 @@ sub AddInheritanceToQueue
       my $n = $self->SimpleSqlGet($sql, $id);
       if ($n)
       {
-        my $url = $self->Sysify("?p=adminReviews;search1=Identifier;search1value=$id");
+        my $url = "?p=adminReviews;search1=Identifier;search1value=$id";
         my $msg = sprintf "already has $n <a href='$url' target='_blank'>%s</a>", $self->Pluralize('review',$n);
         push @msgs, $msg;
         $stat = 1;
@@ -7425,16 +7397,6 @@ sub Authorities
   return \@all;
 }
 
-# Previously used to make sure viral params were appended to generated URLs.
-# No longer needed -- can be removed.
-sub Sysify
-{
-  my $self = shift;
-  my $url  = shift;
-
-  return $url;
-}
-
 # Used to simplify the search results page links.
 # Makes URL params for all values defined in the CGI,
 # ignoring those that are valueless.
@@ -7476,15 +7438,6 @@ sub Hiddenify
   return join "\n", @comps;
 }
 
-# Previously used to make sure viral params were included in hidden input.
-# No longer needed -- can be removed.
-sub HiddenSys
-{
-  my $self = shift;
-
-  return '';
-}
-
 # Compares 2 strings or undefs. Returns 1 or 0 for equality.
 sub TolerantCompare
 {
@@ -7787,17 +7740,6 @@ sub CountRemainingVolumesForProject
   return $self->SimpleSqlGet($sql, $proj);
 }
 
-# Returns the id of the added project, or undef on error.
-sub AddProject
-{
-  my $self     = shift;
-  my $name     = shift;
-
-  my $sql = 'INSERT INTO projects (name) VALUES (?,?)';
-  $self->PrepareSubmitSql($sql, $name);
-  return $self->SimpleSqlGet('SELECT id FROM projects WHERE name=?', $name);
-}
-
 sub AllAssignableRights
 {
   my $self = shift;