Add a PG Critic for checking that PG code conforms to best-practices in problem authoring.

bin/pg-critic.pl

@@ -0,0 +1,140 @@
+#!/usr/bin/env perl
+
+=head1 NAME
+
+pg-critic.pl - Command line interface to critque PG problem code.
+
+=head1 SYNOPSIS
+
+    pg-critic.pl [options] file1 file2 ...
+
+Options:
+
+    -f|--format         Format of the output, either 'text' or 'json'.
+                        'text' is the default and will output a plain text
+                        listing of the results. 'json' will output results in
+                        JavaScript Object Notation.
+    -o|--output-file    Filename to write output to. If not provided output will
+                        be printed to STDOUT.
+    -n|--no-details     Only show the filename and badness score and do not
+                        include the details in the output for each file.
+    -s|--strict         Disable "## no critic" annotations and force all
+                        policies to be enforced.
+    -p|--pg-only        Only include PG critic policy violations and ignore
+                        general Perl critic policy violations (both for the
+                        score and display).
+    -h|--help           Show the help message.
+
+=head1 DESCRIPTION
+
+C<pg-critic.pl> is a PG problem source code analyzer.  It is the executable
+front-end to the L<WeBWorK::PG::Critic> module, which attempts to identify usage
+of old or deprecated PG features and code that does not conform to current
+best-practices.
+
+=cut
+
+use Mojo::Base -signatures;
+
+use Mojo::File qw(curfile path);
+use Mojo::JSON qw(encode_json);
+use Getopt::Long;
+use Pod::Usage;
+
+use lib curfile->dirname->dirname . '/lib';
+
+use WeBWorK::PG::Critic qw(critiquePGFile);
+
+GetOptions(
+	'f|format=s'      => \my $format,
+	'o|output-file=s' => \my $filename,
+	'n|no-details'    => \my $noDetails,
+	's|strict'        => \my $force,
+	'p|pg-only'       => \my $pgOnly,
+	'h|help'          => \my $show_help
+);
+pod2usage(2) if $show_help;
+
+$format //= 'text';
+
+$format = lc($format);
+
+unless (@ARGV) {
+	say 'A list of pg problem files must be provided.';
+	pod2usage(2);
+}
+unless ($format eq 'text' || $format eq 'json') {
+	say 'The output format must be "text" or "json"';
+	pod2usage(2);
+}
+
+sub scoreProblem (@violations) {
+	my $score = 0;
+	for (@violations) {
+		if ($_->policy =~ /^Perl::Critic::Policy::PG::/) {
+			$score += $_->explanation->{score} // 0;
+		} else {
+			# Add 5 points for any of the default Perl::Critic::Policy violations.
+			# These will not have a score in the explanation.
+			$score += 5;
+		}
+	}
+	return $score;
+}
+
+my @results;
+
+for (@ARGV) {
+	my @violations = critiquePGFile($_, $force);
+	@violations = grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ } @violations if $pgOnly;
+
+	my (@pgCriticViolations, @perlCriticViolations);
+	if (!$noDetails) {
+		@pgCriticViolations   = grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ } @violations;
+		@perlCriticViolations = grep { $_->policy !~ /^Perl::Critic::Policy::PG::/ } @violations;
+	}
+
+	push(
+		@results,
+		{
+			file  => $_,
+			score => scoreProblem(@violations),
+			$noDetails
+			? ()
+			: (
+				@pgCriticViolations   ? (pgCriticViolations   => \@pgCriticViolations)   : (),
+				@perlCriticViolations ? (perlCriticViolations => \@perlCriticViolations) : ()
+			)
+		}
+	);
+}
+
+Perl::Critic::Violation::set_format('%m at line %l, column %c. (%p)');
+
+my $outputMethod = $format eq 'json' ? \&encode_json : sub {
+	my $results = shift;
+
+	return join(
+		"\n",
+		map { (
+			"Filename: $_->{file}",
+			"Score: $_->{score}",
+			@{ $_->{pgCriticViolations} // [] }
+			? ('PG critic violations:', map { "\t" . $_->to_string } @{ $_->{pgCriticViolations} })
+			: (),
+			@{ $_->{perlCriticViolations} // [] }
+			? ('Perl critic violations:', map { "\t" . $_->to_string } @{ $_->{perlCriticViolations} })
+			: ()
+		) } @$results
+	);
+};
+
+if ($filename) {
+	eval { path($filename)->spew($outputMethod->(\@results), 'UTF-8') };
+	if   ($@) { say "Unable to write results to $filename: $@"; }
+	else      { say "Results written in $format format to $filename"; }
+} else {
+	say $outputMethod->(\@results);
+}
+
+1;

cpanfile

@@ -24,6 +24,12 @@ on runtime => sub {
 
 	# Needed for Rserve
 	recommends 'IO::Handle';
+
+	# Needed for WeBWorK::PG::Tidy
+	recommends 'Perl::Tidy';
+
+	# Needed for WeBWorK::PG::PGProblemCritic
+	recommends 'Perl::Critic';
 };
 
 on test => sub {

lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm

@@ -0,0 +1,36 @@
+package Perl::Critic::Policy::PG::ProhibitBeginproblem;
+use Mojo::Base 'Perl::Critic::Policy', -signatures;
+
+use Perl::Critic::Utils qw(:severities :classification :ppi);
+
+use WeBWorK::PG::Critic::Utils qw(getDeprecatedMacros);
+
+use constant DESCRIPTION => 'The beingproblem function is called';
+use constant EXPLANATION => 'The beingproblem function no longer does anything and should be removed.';
+use constant SCORE       => 5;
+
+sub supported_parameters ($) {return}
+sub default_severity ($)     { return $SEVERITY_HIGHEST }
+sub default_themes ($)       { return qw(pg) }
+sub applies_to ($)           { return qw(PPI::Token::Word) }
+
+sub violates ($self, $element, $) {
+	return unless $element eq 'beginproblem' && is_function_call($element);
+	return $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $element);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::PG::ProhibitBeginproblem - The C<beingproblem> function is
+deprecated, no longer does anything, and should be removed from all problems.
+
+=head1 DESCRIPTION
+
+The C<beingproblem> function is deprecated, no longer does anything, and should
+be removed from all problems.
+
+=cut

lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm

@@ -0,0 +1,40 @@
+package Perl::Critic::Policy::PG::ProhibitContextStrings;
+use Mojo::Base 'Perl::Critic::Policy', -signatures;
+
+use Perl::Critic::Utils qw(:severities :classification :ppi);
+
+use WeBWorK::PG::Critic::Utils qw(getDeprecatedMacros);
+
+use constant DESCRIPTION => 'Context()->%s is called';
+use constant EXPLANATION => 'Context()->%s no longer necessary and should be removed.';
+use constant SCORE       => 5;
+
+sub supported_parameters ($) {return}
+sub default_severity ($)     { return $SEVERITY_HIGHEST }
+sub default_themes ($)       { return qw(pg) }
+sub applies_to ($)           { return qw(PPI::Token::Word) }
+
+sub violates ($self, $element, $) {
+	return
+		unless ($element eq 'texStrings' || $element eq 'normalStrings')
+		&& is_method_call($element)
+		&& $element->parent =~ /^Context/;
+	return $self->violation(sprintf(DESCRIPTION, $element),
+		{ score => SCORE, explanation => sprintf(EXPLANATION, $element) }, $element);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::PG::RequireContextStrings - C<< Context()->texStrings >>
+and C<< Context->normalStrings >> calls are not necessary and should be removed.
+
+=head1 DESCRIPTION
+
+Calling C<< Context()->texStrings >> and C<< Context->normalStrings >> is no
+longer necessary and should be removed from problems.
+
+=cut

lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm

@@ -0,0 +1,85 @@
+package Perl::Critic::Policy::PG::ProhibitDeprecatedCmp;
+use Mojo::Base 'Perl::Critic::Policy', -signatures;
+
+use Perl::Critic::Utils qw(:severities :classification :ppi);
+
+use constant DESCRIPTION => 'The deprecated %s method is called';
+use constant EXPLANATION => 'Convert the answer into a MathObject and use the cmp method of the object.';
+use constant SCORE       => 55;
+
+use constant CMP_METHODS => {
+	str_cmp                         => 1,
+	std_str_cmp                     => 1,
+	std_str_cmp_list                => 1,
+	std_cs_str_cmp                  => 1,
+	std_cs_str_cmp_list             => 1,
+	strict_str_cmp                  => 1,
+	strict_str_cmp_list             => 1,
+	unordered_str_cmp               => 1,
+	unordered_str_cmp_list          => 1,
+	unordered_cs_str_cmp            => 1,
+	unordered_cs_str_cmp_list       => 1,
+	ordered_str_cmp                 => 1,
+	ordered_str_cmp_list            => 1,
+	ordered_cs_str_cmp              => 1,
+	ordered_cs_str_cmp_list         => 1,
+	num_cmp                         => 1,
+	num_rel_cmp                     => 1,
+	std_num_cmp                     => 1,
+	std_num_cmp_list                => 1,
+	std_num_cmp_abs                 => 1,
+	std_num_cmp_abs_list            => 1,
+	frac_num_cmp                    => 1,
+	frac_num_cmp_list               => 1,
+	frac_num_cmp_abs                => 1,
+	frac_num_cmp_abs_list           => 1,
+	arith_num_cmp                   => 1,
+	arith_num_cmp_list              => 1,
+	arith_num_cmp_abs               => 1,
+	arith_num_cmp_abs_list          => 1,
+	strict_num_cmp                  => 1,
+	strict_num_cmp_list             => 1,
+	strict_num_cmp_abs              => 1,
+	strict_num_cmp_abs_list         => 1,
+	std_num_str_cmp                 => 1,
+	fun_cmp                         => 1,
+	function_cmp                    => 1,
+	function_cmp_up_to_constant     => 1,
+	function_cmp_abs                => 1,
+	function_cmp_up_to_constant_abs => 1,
+	adaptive_function_cmp           => 1,
+	multivar_function_cmp           => 1,
+	cplx_cmp                        => 1,
+	multi_cmp                       => 1,
+	radio_cmp                       => 1,
+	checkbox_cmp                    => 1,
+};
+
+sub supported_parameters ($) {return}
+sub default_severity ($)     { return $SEVERITY_HIGHEST }
+sub default_themes ($)       { return qw(pg) }
+sub applies_to ($)           { return qw(PPI::Token::Word) }
+
+sub violates ($self, $element, $document) {
+	return unless CMP_METHODS->{$element} && is_function_call($element);
+	return $self->violation(sprintf(DESCRIPTION, $element), { score => SCORE, explanation => EXPLANATION }, $element);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::PG::ProhibitDeprecatedCmp - Use C<MathObjects> instead of
+the deprecated C<cmp> methods.
+
+=head1 DESCRIPTION
+
+Convert answers into a C<MathObjects> and use the C<cmp> method of the object
+instead of using any of the deprecated C<cmp> methods such as C<str_cmp> from
+the L<PGstringevaluators.pl> macro, C<num_cmp> from the
+L<PGnumericevaluators.pl> macro, or C<fun_cmp> from the
+L<PGfunctionevaluators.pl> macro.
+
+=cut

lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm

@@ -0,0 +1,45 @@
+package Perl::Critic::Policy::PG::ProhibitDeprecatedMacros;
+use Mojo::Base 'Perl::Critic::Policy', -signatures;
+
+use Perl::Critic::Utils qw(:severities :classification :ppi);
+
+use WeBWorK::PG::Critic::Utils qw(getDeprecatedMacros);
+
+use constant DESCRIPTION => 'The deprecated macro %s is loaded';
+use constant EXPLANATION => 'Remove this macro and replace methods used from this macro with modern alternatives.';
+use constant SCORE       => 10;
+
+sub supported_parameters ($) {return}
+sub default_severity ($)     { return $SEVERITY_HIGHEST }
+sub default_themes ($)       { return qw(pg) }
+sub applies_to ($)           { return qw(PPI::Token::Word) }
+
+sub violates ($self, $element, $) {
+	return unless $element eq 'loadMacros' && is_function_call($element);
+	my $deprecatedMacros = getDeprecatedMacros;
+	return unless $deprecatedMacros;
+	return map {
+		$self->violation(
+			sprintf(DESCRIPTION, $_->[0]->string),
+			{ score => SCORE, explanation => EXPLANATION },
+			$_->[0]
+		)
+		}
+		grep { $deprecatedMacros->{ $_->[0]->string } } parse_arg_list($element);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::PG::ProhibitDeprecatedMacros - Replace deprecated macro
+usage with modern alternatives.
+
+=head1 DESCRIPTION
+
+All problems that use a deprecated macro (those in the C<deprecated> directory)
+should be rewritten to use modern alternatives.
+
+=cut