From c2563d7dd01b5bc4eae5225e8ae13f92a33805d7 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Fri, 20 Jun 2025 12:08:31 -0700 Subject: [PATCH 1/6] PG critic script. --- bin/pg-critic.pl | 153 ++++++++++++++ lib/WeBWorK/PG/PGProblemCritic.pm | 319 ++++++++++++++++++++++++++++++ 2 files changed, 472 insertions(+) create mode 100755 bin/pg-critic.pl create mode 100644 lib/WeBWorK/PG/PGProblemCritic.pm diff --git a/bin/pg-critic.pl b/bin/pg-critic.pl new file mode 100755 index 000000000..2fc6b855f --- /dev/null +++ b/bin/pg-critic.pl @@ -0,0 +1,153 @@ +#!/usr/bin/env perl + +=head1 NAME + +pg-critic.pl -- Analyze a pg file for use of old and current methods. + +=head1 SYNOPSIS + + pg-critic.pl [options] file1 file2 ... + +Options: + + -s|--score Give a score for each file. + -f|--format Format of the output. Default ('text') is a plain text listing of the filename + and the score. 'JSON' will make a JSON file. + For output format 'JSON', the filename output must also be assigned, + however for 'text', the output is optional. + -o|--output-file Filename for the output. Note: this is required if JSON is the output format. + -d|--details Include the details in the output. (Only used if the format is JSON). + -v|--verbose Increase the verbosity of the output. + -h|--help Show the help message. + +=head1 DESCRIPTION + +This script analyzes the input files for old/deprecated functions and macros as well +as features for current best practices features. + +See L for details on what features are determined presence. + +=head1 OPTIONS + +The option C<-v> or C<--verbose> gives more information (on STDOUT) as the +script is run. + +The option C<-s> or C<--score> will return a score for each given PG problem. + +=cut + +use strict; +use warnings; +use experimental 'signatures'; +use feature 'say'; + +use Mojo::File qw(curfile); +use Mojo::Util qw(dumper); +use Mojo::JSON qw(encode_json); +use Getopt::Long; +use Pod::Usage; + +use lib curfile->dirname->dirname . '/lib'; + +use WeBWorK::PG::PGProblemCritic qw(analyzePGfile); + +my ($verbose, $show_score, $details, $show_help) = (0, 1, 0, 0); +my ($format, $filename) = ('text', ''); +GetOptions( + 's|score' => \$show_score, + 'f|format=s' => \$format, + 'o|output-file=s' => \$filename, + 'd|details' => \$details, + "v|verbose" => \$verbose, + 'h|help' => \$show_help +); +pod2usage(2) if $show_help || !$show_score; + +die 'arguments must have a list of pg files' unless @ARGV > 0; +die "The output format must be 'text' or 'JSON'" if (scalar(grep { $_ eq $format } qw(text JSON)) == 0); + +my $output_file; +unless ($format eq 'text' && $filename eq '') { + die "The output-file is required if using the format: $format" if $filename eq ''; + $output_file = Mojo::File->new($filename); + my $dir = $output_file->dirname->realpath; + die "The output directory $dir does not exist or is not a directory" unless -d $dir->to_string; +} + +# Give a problem an assessment score: + +my $rubric = { + metadata => -5, # score for each missing required metadta + good => { + PGML => 20, + solution => 30, + hint => 10, + scaffold => 50, + custom_checker => 50, + multianswer => 30, + answer_hints => 20, + nicetable => 10, + contexts => { base_n => 10, units => 10, boolean => 10, reaction => 10 }, + parsers => { radio_buttons => 10, checkbox_list => 10, radio_multianswer => 10, graph_tool => 10 }, + macros => { + random_person => 10, + plots => 10, + tikz => 10, + plotly3D => 10, + latex_image => 10, + scaffold => 10, + answer_hints => 10, + } + }, + bad => { + BEGIN_TEXT => -10, + beginproblem => -5, + oldtable => -25, + num_cmp => -75, + str_cmp => -75, + fun_cmp => -75, + context_texstrings => -5, + multiple_loadmacros => -20, + showPartialCorrect => -5, + lines_below_enddocument => -5, + macros => { ww_plot => -20, PGchoicemacros => -20 } + }, + deprecated_macros => -10 +}; + +sub scoreProblem ($prob) { + my $score = 0; + $score += (1 - $prob->{metadata}{$_}) * $rubric->{metadata} for (keys %{ $prob->{metadata} }); + $score += $prob->{good}{$_} * $rubric->{good}{$_} for (keys %{ $prob->{good} }); + $score += $prob->{bad}{$_} * $rubric->{bad}{$_} for (keys %{ $prob->{bad} }); + $score += $rubric->{deprecated_macros} for (@{ $prob->{deprecated_macros} }); + return $score; +} + +my @scores; + +for (grep { $_ =~ /\.pg$/ } @ARGV) { + say $_ if $verbose; + my $features = analyzePGfile($_); + my $file_info = { file => $_, score => scoreProblem($features) }; + $file_info->{details} = $features if $details; + push(@scores, $file_info); +} + +if ($format eq 'text') { + my $output_str = ''; + for my $score (@scores) { + $output_str .= "filename: $score->{file}; score: $score->{score}\n"; + } + if ($filename eq '') { + say $output_str; + } else { + $output_file->spew($output_str); + say "Results written in text format to $output_file" if $verbose; + } +} elsif ($format eq 'JSON') { + $output_file->spew(encode_json(\@scores)); + say "Results written in JSON format to $output_file" if $verbose; +} + +1; diff --git a/lib/WeBWorK/PG/PGProblemCritic.pm b/lib/WeBWorK/PG/PGProblemCritic.pm new file mode 100644 index 000000000..f637d36f6 --- /dev/null +++ b/lib/WeBWorK/PG/PGProblemCritic.pm @@ -0,0 +1,319 @@ + +=head1 NAME + +PGProblemCritic - Parse a PG program and analyze the contents for positive and negative features. + +=head1 DESCRIPTION + +Analyze a pg file for use of old and current methods. + +=over + +=item * C: a list of the macros that the problem uses that is in the C +folder. + +=item * Positive features: + +=over + +=item * Uses PGML + +=item * Provides a solution + +=item * Provides a hint + +=item * Uses Scaffolds + +=item * Uses a custom checker + +=item * Uses a multianswer + +=item * Uses answer hints + +=item * Uses nicetables + +=item * Uses randomness + +=back + +=item Old and deprecated features + +=over + +=item * Use of BEGIN_TEXT/END_TEXT + +=item * Include the C + +=item * Include old tables (for example from C) + +=item * The use of C, C and C in lieu of using MathObjects + +=item * Including C<< Context()->TeXStrings >> + +=item * Calling C more than once. + +=item * Using the line C< $showPartialCorrectAnswers = 1 > which is the default behavior and thus unnecessary. + +=item * Using methods from C + +=item * Inlcuding code or other text below the C line indicating the end of the problem. + +=back + +=back + + +=cut + +package WeBWorK::PG::PGProblemCritic; +use parent qw(Exporter); + +use strict; +use warnings; +use experimental 'signatures'; +use feature 'say'; + +use Mojo::File qw(curfile); +use Mojo::Util qw(dumper); + +our @EXPORT_OK = qw(analyzePGfile analyzePGcode getDeprecatedMacros); + +sub analyzePGcode ($code) { + # default flags for presence of features in a PG problem + my $features = { + metadata => { DBsubject => 0, DBchapter => 0, DBsection => 0, KEYWORDS => 0 }, + positive => { + PGML => 0, + solution => 0, + hint => 0, + custom_checker => 0, + multianswer => 0, + nicetables => 0, + randomness => 0, + contexts => { BaseN => 0, Units => 0, Boolean => 0, Reaction => 0 }, + parsers => + { dropdown => 0, RadioButtons => 0, CheckboxList => 0, RadioMultianswer => 0, GraphTool => 0 }, + macros => { + randomPerson => 0, + Plots => 0, + PGtikz => 0, + Plotly3D => 0, + PGlateximage => 0, + Scaffold => 0, + AnswerHints => 0, + } + }, + negative => { + BEGIN_TEXT => 0, + beginproblem => 0, + oldtable => 0, + num_cmp => 0, + str_cmp => 0, + fun_cmp => 0, + context_texstrings => 0, + multiple_loadmacros => 0, + showPartialCorrect => 0, + lines_below_enddocument => 0, + macros => { PGgraphmacros => 0, PGchoicemacros => 0 } + }, + deprecated_macros => [], + macros => [] + }; + + # Get a list of all deprecated macros. + my $all_deprecated_macros = getDeprecatedMacros(curfile->dirname->dirname->dirname->dirname); + + # determine if the loadMacros has been parsed. + my $loadmacros_parsed = 0; + + my @pglines = split /\n/, $code; + my $line = ''; + while (1) { + $line = shift @pglines; + # print Dumper $line; + last unless defined($line); # end of the file. + next if $line =~ /^\s*$/; # skip any blank lines. + + # Determine if some of the metadata tags are present. + for (qw(DBsubject DBchapter DBsection KEYWORDS)) { + $features->{metadata}{$_} = 1 if $line =~ /$_\(/i; + } + + # Skip any full-line comments. + next if $line =~ /^\s*#/; + + $features->{positive}{solution} = 1 if $line =~ /BEGIN_(PGML_)?SOLUTION/; + $features->{positive}{hint} = 1 if $line =~ /BEGIN_(PGML_)?HINT/; + + # Analyze the loadMacros info. + if ($line =~ /loadMacros\(/) { + $features->{negative}{multiple_loadmacros} = 1 if $loadmacros_parsed == 1; + $loadmacros_parsed = 1; + # Parse the macros, which may be on multiple rows. + my $macros = $line; + while ($line && $line !~ /\);\s*$/) { + $line = shift @pglines; + + # Strip any comments at the end of lines. + $line =~ s/(.*)#.*/$1/; + $macros .= $line; + } + + $macros =~ s/^\s*loadMacros\(\s*(.*)\s*\);\s*$/$1/; + my @macros; + # if the arguments of loadMacros is q[qw] form, handle this. + if ($macros =~ /^q[qw]?[\(\[\{\/](.*)[\)\]\/\}]$/) { + $macros =~ s/^q[qw]?[\(\[\{\/](.*)[\)\]\/\}]$/$1/; + @macros = grep { $_ ne '' } split(/\s+/, $macros); + } else { # arguments are strings separated by commas. + @macros = map {s/['"\s]//gr} split(/\s*,\s*/, $macros =~ s/loadMacros\((.*)\)\;$/$1/r); + } + + $features->{macros} = \@macros; + for my $macro (@macros) { + push(@{ $features->{deprecated_macros} }, $macro) if (grep { $macro eq $_ } @$all_deprecated_macros); + } + } elsif ($line =~ /BEGIN_PGML(_SOLUTION|_HINT)?/) { + $features->{positive}{PGML} = 1; + my @pgml_lines; + while (1) { + $line = shift @pglines; + last if $line =~ /END_PGML(_SOLUTON|_HINT)?/; + push(@pgml_lines, $line); + } + + my $pgml_features = analyzePGMLBlock(@pgml_lines); + $features->{negative}{missing_alt_tag} = 1 if $pgml_features->{missing_alt_tag}; + } + + if ($line =~ /ENDDOCUMENT/) { # scan if there are any lines below the ENDDOCUMENT + + do { + $line = shift @pglines; + last unless defined($line); + $features->{negative}{lines_below_enddocument} = 1 if $line !~ /^\s*$/; + } while (defined($line)); + } + + # Check for negative features. + $features->{negative}{beginproblem} = 1 if $line =~ /beginproblem\(\)/; + $features->{negative}{BEGIN_TEXT} = 1 if $line =~ /(BEGIN_(TEXT|HINT|SOLUTION))|EV[23]/; + $features->{negative}{context_texstrings} = 1 if $line =~ /->(texStrings|normalStrings)/; + for (qw(num str fun)) { + $features->{negative}{ $_ . '_cmp' } = 1 if $line =~ /${_}_cmp\(/; + } + $features->{negative}{oldtable} = 1 if $line =~ /BeginTable/i; + $features->{negative}{showPartialCorrect} = 1 if $line =~ /\$showPartialCorrectAnswers\s=\s1/; + $features->{negative}{macros}{PGgraphmacros} = 1 if $line =~ /init_graph\(/; + $features->{negative}{macros}{PGchoicemacros} = 1 + if $line =~ /new_checkbox_multiple_choice/ + || $line =~ /new_match_list/ + || $line =~ /new_select_list/ + || $line =~ /new_multiple_choice/ + || $line =~ /qa\s\(/; + + # check for positive features + # macros: + $features->{positive}{macros}{Scaffold} = 1 if $line =~ /Scaffold::Begin/; + $features->{positive}{macros}{Plots} = 1 if $line =~ /Plot\(/; + $features->{positive}{macros}{Plotly3D} = 1 if $line =~ /Graph3D\(/; + $features->{positive}{macros}{PGtikz} = 1 if $line =~ /createTikZImage\(/; + $features->{positive}{macros}{AnswerHints} = 1 if $line =~ /AnswerHints/; + $features->{positive}{macros}{randomPerson} = 1 if $line =~ /randomPerson\(/ || $line =~ /randomLastName\(/; + $features->{positive}{macros}{PGlateximage} = 1 if $line =~ /createLaTeXImage\(/; + + # contexts: + + $features->{positive}{contexts}{Units} = 1 if $line =~ /Context\(['"]Units['"]\)/; + $features->{positive}{contexts}{BaseN} = 1 if $line =~ /Context\(['"](Limited)?BaseN['"]\)/; + $features->{positive}{contexts}{Boolean} = 1 if $line =~ /Context\(['"]Boolean['"]\)/; + $features->{positive}{contexts}{Reaction} = 1 if $line =~ /Context\(['"]Reaction['"]\)/; + + # parsers: + $features->{positive}{parsers}{PopUp} = 1 if $line =~ /DropDown\(/; + $features->{positive}{parsers}{RadioButtons} = 1 if $line =~ /RadioButtons\(/; + $features->{positive}{parsers}{CheckboxList} = 1 if $line =~ /CheckboxList\(/; + $features->{positive}{parsers}{GraphTool} = 1 if $line =~ /GraphTool\(/; + + # other: + $features->{positive}{multianswer} = 1 if $line =~ /MultiAnswer/; + $features->{positive}{custom_checker} = 1 if $line =~ /checker\s*=>/; + $features->{positive}{nicetables} = 1 if $line =~ /DataTable|LayoutTable/; + $features->{positive}{randomness} = 1 if $line =~ /random\(|random_(\w+)\(|list_random\(/; + + } + return $features; +} + +# Return a list of the macro filenames in the 'macros/deprecated' directory. +sub getDeprecatedMacros ($pgroot) { + return Mojo::File->new($pgroot)->child('macros/deprecated')->list->map(sub { $_->basename })->to_array; +} + +sub analyzePGfile ($file) { + my $path = Mojo::File->new($file); + die "The file: $file does not exist or is not readable" unless -r $path; + + return analyzePGcode($path->slurp); +} + +# Parse a string that is a function in the form of "funct($arg1, $arg2, ..., param1 => val1, param2 => val2 , ...)" +# A hashref of the form {_args = [$arg1, $arg2, ...], param1 => val1, param2 => val2} is returned. + +sub parseFunctionString($string) { + + my ($funct, $args); + if ($string =~ /(\w+)\(\s*(.*)\)/) { + ($funct, $args) = ($1, $2); + } else { + return (); + } + + my @args = split(/,\s/, $args); + + my %params = (_name => $funct, _args => []); + for (@args) { + if ($_ !~ /=>/) { + push(@{ $params{_args} }, $_); + } else { + if ($_ =~ /(\w+)\s*=>\s*["']?([^"]*)["']?/) { + my ($key, $value) = ($1, $2); + $params{$key} = $value; + } + } + } + return %params; +} + +# Perform some analysis of a PGML block. + +sub analyzePGMLBlock(@lines) { + my $pgml_features = {}; + + while (1) { + my $line = shift @lines; + last unless defined($line); + + # If there is a perl block analyze [@ @] + if ($line =~ /\[@/) { + my $perl_line = $line; + while ($perl_line !~ /@\]/) { + $line = shift @lines; + $perl_line .= $line; + } + my ($perlcode) = $perl_line =~ /\[@\s*(.*)\s*@\]/; + + my %funct_info = parseFunctionString($perlcode); + if (%funct_info && $funct_info{_name} =~ /image/) { + if (defined($funct_info{extra_html_tags}) && $funct_info{extra_html_tags} !~ /alt/) { + $pgml_features->{missing_alt_tag} = 1; + } + } + + } elsif (my ($alt_text) = $line =~ /\[!(.*)!\]/) { + $pgml_features->{missing_alt_tag} = 1 if $alt_text =~ /^\s$/; + } + + } + return $pgml_features; +} From 14e7db7309b41e51c28c5d0d1c41995d8a9176e1 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 9 Jul 2025 09:16:03 -0500 Subject: [PATCH 2/6] Add a PG critic for problem code. This uses `Perl::Critic` and custom PG policies for `Perl::Critic` to analyze the code. The custom PG policies must be under the `Perl::Critic::Policy` to be loaded by `Perl::Critic` (they give no alternative for that). That means they are in the `lib/Perl/Critic/Policy` directory. Policies corresponding to everything that was attempted to be detected in #1254 have been implemented except for `randomness`. `randomness` of a problem is far more complicated than just checking if `random`, `list_random`, etc. are called. Basically, the code of a problem is first translated (via the `default_preprocess_code` method of the `WeBWorK::PG::Translator` package), then converted to a `PPI::Document` (the underlying library that `Perl::Critic` uses), and that is passed to `Perl::Critic`. There are some utility methods provided in the `WeBWorK::PG::Critic::Utils` package that can be used by the PG policies. At this point those are `getDeprecatedMacros`, `parsePGMLBlock`, and `parseTextBlock`. The `getDeprecatedMacros` method just lists the macros in the `macros/deprecated` directory. The `parsePGMLBlock` method parses PGML contents, and actually uses PGML::Parse for the parsing, and returns `PPI::Document` representations of the content. At this point only command blocks are returned (perl content of `[@ ... @]` blocks), but more can be added as needed by the policies that are created. The `parseTextBlock` method is similar but parses `BEGIN_TEXT`/`END_TEXT` blocks (and the ilk) using a simplified `ev_substring` approach. At this point only the contents of `\{ ... \}` blocks are returned, and other elements can be added later if needed. Unfortunately, the `parsePGMLBlock` and `parseTextBlock` methods do not give proper positioning within the code, so the line and column numbers of the things in the return value will not be reliable. The only policy that uses these at this point is the `Perl::Critic::Policy::PG::RequireImageAltAttribute` policy and that just reports the violations as being inside the PGML or text block the violations are found in. Also, the original untranslated code is passed to the policies and can be used if needed. The `Perl::Critic::Policy::PG::ProhibitEnddocumentMatter` is the only policy that uses this at this point. Note that since this is just `Perl::Critic` this also reports violations of the core `Perl::Critic` policies (at severity level 4). However, there are policies that clearly don't apply to PG problem code, and so those are disabled. For instance, obviously `use strict` and `use warnings` can't be called in a problem, so the `Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict` and `Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings` policies are disabled. The disabled policies start at line 57 of the `WeBWorK::PG::Critic` package. This may need tweaking as there may be other policies that need to be disabled as well, but those are the common violations that I have seen over the years using this for problems that should not apply to problems (I have used a form of this PG critic without the custom PG policies for some time now -- see https://github.com/drgrice1/pg-language-server). Also note that since this is just `Perl::Critic`, you can also use `## no critic` annotations in the code to disable policy violations for a specific line, the entire file, a specific policy on a specific line, etc. See https://metacpan.org/pod/Perl::Critic#BENDING-THE-RULES. For example, if you have a problem that is in the works and are not ready to add metadata, then add `## no critic (PG::RequireMetadata)` to the beginning of the file, and you won't see the violations for having missing metadata. Note that the `bin/pg-critic.pl` script has a `-s` or `--strict` option that ignores all `## no critic` annotations, and forces all policies to be enforced. The result is a reliable, versatile, and extendable approach for critiquing problem code. Since there was a desire to have a "problem score" and to reward good behavior that has been implemented. That means that not all "violations" are bad. Some of them are good. The score is implemented by setting the "explanation" of each violation as a hash which will have the keys `score` and `explanation`. The score will be positive if the "violation" is good, and negative otherwise. The `explanation` is of course a string that would be the usual explanation. This is a bit of a hack since `Perl::Critic` expects the violation to be either a string or a reference to an array of numbers (page numbers in the PBP book), but the `explanation` method of the `Perl::Critic::Violation` object returns the hash as is so this works to get the score from the policy. Although, I am wondering if this "problem score" is really a good idea. If we do start using this and make these scores public, will a low score on a problem deter usage of the problem? It seems like this might happen, and there are basic but quite good problems that are going to get low scores simply because they don't need complicated macros and code for there implementation. Will a high score really mean that a problem is good anyway? What do we really want these scores for? Some sort of validation when our problems get high scores because they utilize the things that happen to be encouraged at the time? I am thinking that this "problem score" idea really was NOT a good idea, and should be removed. If the score is removed, then there is also no point in the "positive violations". Those simply become a "pat on the back" for doing something right which is really not needed (in fact that is all they really are even with the score in my opinion). So my proposal is to actually make this a proper critic that just shows the things in a problem that need improvement, and remove the score and the "positive violations". That is in my opinion what is really important here. --- bin/pg-critic.pl | 213 ++++++------ cpanfile | 6 + .../Policy/PG/EncourageCustomCheckers.pm | 43 +++ .../Policy/PG/EncourageModernContextUsage.pm | 65 ++++ .../Critic/Policy/PG/EncouragePGMLUsage.pm | 57 ++++ .../Policy/PG/EncourageQualityMacroUsage.pm | 100 ++++++ .../Policy/PG/EncourageSolutionsAndHints.pm | 61 ++++ .../Critic/Policy/PG/ProhibitBeginproblem.pm | 36 ++ .../Policy/PG/ProhibitContextStrings.pm | 40 +++ .../Critic/Policy/PG/ProhibitDeprecatedCmp.pm | 85 +++++ .../Policy/PG/ProhibitDeprecatedMacros.pm | 45 +++ .../PG/ProhibitDeprecatedMultipleChoice.pm | 55 +++ .../Policy/PG/ProhibitEnddocumentMatter.pm | 41 +++ .../Critic/Policy/PG/ProhibitGraphMacros.pm | 42 +++ .../PG/ProhibitMultipleLoadMacrosCalls.pm | 38 +++ lib/Perl/Critic/Policy/PG/ProhibitOldText.pm | 53 +++ ...ssarilySettingShowPartialCorrectAnswers.pm | 42 +++ .../Policy/PG/RequireImageAltAttribute.pm | 96 ++++++ lib/Perl/Critic/Policy/PG/RequireMetadata.pm | 51 +++ lib/Perl/Critic/Policy/PG/RequireSolution.pm | 61 ++++ lib/WeBWorK/PG/Critic.pm | 94 ++++++ lib/WeBWorK/PG/Critic/Utils.pm | 159 +++++++++ lib/WeBWorK/PG/PGProblemCritic.pm | 319 ------------------ 23 files changed, 1371 insertions(+), 431 deletions(-) create mode 100644 lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm create mode 100644 lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm create mode 100644 lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm create mode 100644 lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm create mode 100644 lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitOldText.pm create mode 100644 lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm create mode 100644 lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm create mode 100644 lib/Perl/Critic/Policy/PG/RequireMetadata.pm create mode 100644 lib/Perl/Critic/Policy/PG/RequireSolution.pm create mode 100644 lib/WeBWorK/PG/Critic.pm create mode 100644 lib/WeBWorK/PG/Critic/Utils.pm delete mode 100644 lib/WeBWorK/PG/PGProblemCritic.pm diff --git a/bin/pg-critic.pl b/bin/pg-critic.pl index 2fc6b855f..bc4f09422 100755 --- a/bin/pg-critic.pl +++ b/bin/pg-critic.pl @@ -2,7 +2,7 @@ =head1 NAME -pg-critic.pl -- Analyze a pg file for use of old and current methods. +pg-critic.pl - Command line interface to critque PG problem code. =head1 SYNOPSIS @@ -10,144 +10,133 @@ =head1 SYNOPSIS Options: - -s|--score Give a score for each file. - -f|--format Format of the output. Default ('text') is a plain text listing of the filename - and the score. 'JSON' will make a JSON file. - For output format 'JSON', the filename output must also be assigned, - however for 'text', the output is optional. - -o|--output-file Filename for the output. Note: this is required if JSON is the output format. - -d|--details Include the details in the output. (Only used if the format is JSON). - -v|--verbose Increase the verbosity of the output. - -h|--help Show the help message. + -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 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. + -h|--help Show the help message. =head1 DESCRIPTION -This script analyzes the input files for old/deprecated functions and macros as well -as features for current best practices features. - -See L for details on what features are determined presence. - -=head1 OPTIONS - -The option C<-v> or C<--verbose> gives more information (on STDOUT) as the -script is run. - -The option C<-s> or C<--score> will return a score for each given PG problem. +C is a PG problem source code analyzer. It is the executable +front-end to the L module, which attempts to identify +usage of old or deprecated PG features, as well as usage of newer features and +current best practices in coding a problem. =cut -use strict; -use warnings; -use experimental 'signatures'; -use feature 'say'; +use Mojo::Base -signatures; -use Mojo::File qw(curfile); -use Mojo::Util qw(dumper); +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::PGProblemCritic qw(analyzePGfile); +use WeBWorK::PG::Critic qw(critiquePGFile); -my ($verbose, $show_score, $details, $show_help) = (0, 1, 0, 0); -my ($format, $filename) = ('text', ''); GetOptions( - 's|score' => \$show_score, - 'f|format=s' => \$format, - 'o|output-file=s' => \$filename, - 'd|details' => \$details, - "v|verbose" => \$verbose, - 'h|help' => \$show_help + 'f|format=s' => \my $format, + 'o|output-file=s' => \my $filename, + 'n|no-details' => \my $noDetails, + 's|strict' => \my $force, + 'h|help' => \my $show_help ); -pod2usage(2) if $show_help || !$show_score; +pod2usage(2) if $show_help; -die 'arguments must have a list of pg files' unless @ARGV > 0; -die "The output format must be 'text' or 'JSON'" if (scalar(grep { $_ eq $format } qw(text JSON)) == 0); +$format //= 'text'; -my $output_file; -unless ($format eq 'text' && $filename eq '') { - die "The output-file is required if using the format: $format" if $filename eq ''; - $output_file = Mojo::File->new($filename); - my $dir = $output_file->dirname->realpath; - die "The output directory $dir does not exist or is not a directory" unless -d $dir->to_string; -} +$format = lc($format); -# Give a problem an assessment score: - -my $rubric = { - metadata => -5, # score for each missing required metadta - good => { - PGML => 20, - solution => 30, - hint => 10, - scaffold => 50, - custom_checker => 50, - multianswer => 30, - answer_hints => 20, - nicetable => 10, - contexts => { base_n => 10, units => 10, boolean => 10, reaction => 10 }, - parsers => { radio_buttons => 10, checkbox_list => 10, radio_multianswer => 10, graph_tool => 10 }, - macros => { - random_person => 10, - plots => 10, - tikz => 10, - plotly3D => 10, - latex_image => 10, - scaffold => 10, - answer_hints => 10, - } - }, - bad => { - BEGIN_TEXT => -10, - beginproblem => -5, - oldtable => -25, - num_cmp => -75, - str_cmp => -75, - fun_cmp => -75, - context_texstrings => -5, - multiple_loadmacros => -20, - showPartialCorrect => -5, - lines_below_enddocument => -5, - macros => { ww_plot => -20, PGchoicemacros => -20 } - }, - deprecated_macros => -10 -}; +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 ($prob) { +sub scoreProblem (@violations) { my $score = 0; - $score += (1 - $prob->{metadata}{$_}) * $rubric->{metadata} for (keys %{ $prob->{metadata} }); - $score += $prob->{good}{$_} * $rubric->{good}{$_} for (keys %{ $prob->{good} }); - $score += $prob->{bad}{$_} * $rubric->{bad}{$_} for (keys %{ $prob->{bad} }); - $score += $rubric->{deprecated_macros} for (@{ $prob->{deprecated_macros} }); + for (@violations) { + if ($_->policy =~ /^Perl::Critic::Policy::PG::/) { + $score += $_->explanation->{score} // 0; + } else { + # Deduct 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 @scores; +my @results; -for (grep { $_ =~ /\.pg$/ } @ARGV) { - say $_ if $verbose; - my $features = analyzePGfile($_); - my $file_info = { file => $_, score => scoreProblem($features) }; - $file_info->{details} = $features if $details; - push(@scores, $file_info); -} +for (@ARGV) { + my @violations = critiquePGFile($_, $force); -if ($format eq 'text') { - my $output_str = ''; - for my $score (@scores) { - $output_str .= "filename: $score->{file}; score: $score->{score}\n"; - } - if ($filename eq '') { - say $output_str; - } else { - $output_file->spew($output_str); - say "Results written in text format to $output_file" if $verbose; + my (@positivePGResults, @negativePGResults, @perlCriticResults); + if (!$noDetails) { + @positivePGResults = + grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ && $_->explanation->{score} > 0 } @violations; + @negativePGResults = + grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ && $_->explanation->{score} < 0 } @violations; + @perlCriticResults = grep { $_->policy !~ /^Perl::Critic::Policy::PG::/ } @violations; } -} elsif ($format eq 'JSON') { - $output_file->spew(encode_json(\@scores)); - say "Results written in JSON format to $output_file" if $verbose; + + push( + @results, + { + file => $_, + score => scoreProblem(@violations), + $noDetails + ? () + : ( + positivePGResults => \@positivePGResults, + negativePGResults => \@negativePGResults, + perlCriticResults => \@perlCriticResults + ) + } + ); +} + +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}", + @{ $_->{positivePGResults} // [] } + ? ('positive pg critic results:', map { "\t" . $_->to_string } @{ $_->{positivePGResults} }) + : (), + @{ $_->{negativePGResults} // [] } + ? ('negative pg critic results:', map { "\t" . $_->to_string } @{ $_->{negativePGResults} }) + : (), + @{ $_->{perlCriticResults} // [] } + ? ('perl critic results:', map { "\t" . $_->to_string } @{ $_->{perlCriticResults} }) + : () + ) } @$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; diff --git a/cpanfile b/cpanfile index 12c7e39b7..00b469c47 100644 --- a/cpanfile +++ b/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 { diff --git a/lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm b/lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm new file mode 100644 index 000000000..45e50f43f --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm @@ -0,0 +1,43 @@ +package Perl::Critic::Policy::PG::EncourageCustomCheckers; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'A custom checker is utilized'; +use constant EXPLANATION => 'Custom checkers demonstrate a high level of sophistication in problem coding.'; +use constant SCORE => 50; + +sub supported_parameters ($) {return} +sub default_severity ($) { return $SEVERITY_HIGHEST } +sub default_themes ($) { return qw(pg) } +sub applies_to ($) { return qw(PPI::Token::Word) } + +use Mojo::Util qw(dumper); + +# FIXME: This misses some important cases. For example, answer checking can also be performed in a post filter. In +# fact that demonstrates an even higher level of sophistication than using a checker in some senses. It is more +# complicated to use correctly, and can work around type limitations imposed on MathObject checkers. However, there is +# no reliable way to determine what a post filter is in a problem for, as there are other reasons to add a post filter. +sub violates ($self, $element, $document) { + return unless $element eq 'checker' || $element eq 'list_checker'; + return $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $element); +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::EncourageCustomCheckers - Custom checkers demonstrate +a high level of sophistication in problem coding. + +=head1 DESCRIPTION + +Utilization of a custom checker in a problem demonstrates a high level of +sophistication in coding a problem. Custom checkers can be used to supplement +default MathObject checkers in several ways. For example, to award partial +credit and display more meaningful messages for answers that are not entirely +correct + +=cut diff --git a/lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm b/lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm new file mode 100644 index 000000000..f9010cfdd --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm @@ -0,0 +1,65 @@ +package Perl::Critic::Policy::PG::EncourageModernContextUsage; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +# FIXME: Is this policy really a good idea? Why are these contexts so special? Just because they are newer? Many of the +# contexts that have been around for a long time are actually better than some of these, and some of them are more +# complicated to use and demonstrate a higher level of sophistication than these. + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'The context %s is used from the macro %s'; +use constant EXPLANATION => '%s is a modern context whose usage demonstrates currency in problem authoring.'; + +use constant CONTEXTS => { + BaseN => { macro => 'contextBaseN.pl', score => 10 }, + Boolean => { macro => 'contextBoolean.pl', score => 10 }, + Reaction => { macro => 'contextReaction.pl', score => 10 }, + Units => { macro => 'contextUnits.pl', 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, $document) { + return unless $element eq 'Context' && is_function_call($element); + my $context = first_arg($element); + return $self->violation( + sprintf(DESCRIPTION, $context->string, CONTEXTS->{ $context->string }{macro}), + { + score => CONTEXTS->{ $context->string }{score}, + explanation => sprintf(EXPLANATION, CONTEXTS->{ $context->string }{macro}) + }, + $context + ) if $context && CONTEXTS->{ $context->string }; + return; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::EncourageModernContextUsage - Usage of recently +created contexts demonstrates currency in problem authoring. + +=head1 DESCRIPTION + +Usage of recently created contexts demonstrates currency in problem authoring. +Currently this policy encourages the use of the following contexts: + +=over + +=item * L + +=item * L + +=item * L + +=item * L + +=back + +=cut diff --git a/lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm b/lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm new file mode 100644 index 000000000..fd67cc9de --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm @@ -0,0 +1,57 @@ +package Perl::Critic::Policy::PG::EncouragePGMLUsage; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'PGML is used for problem text'; +use constant EXPLANATION => 'PGML should be used for problem text.'; +use constant SCORE => 20; + +sub supported_parameters ($) {return} +sub default_severity ($) { return $SEVERITY_HIGHEST } +sub default_themes ($) { return qw(pg) } +sub applies_to ($) { return qw(PPI::Token::HereDoc) } + +# Only report this once even if there are multiple PGML blocks in the problem. +sub default_maximum_violations_per_document ($) { return 1; } + +sub violates ($self, $element, $document) { + return $self->violation( + DESCRIPTION, + { score => SCORE, explanation => EXPLANATION }, + $element->parent->parent->parent->parent->parent + ) + if $element->terminator =~ /^END_PGML(_SOLUTION|_HINT)?$/ + && $element->parent + && $element->parent->parent + && $element->parent->parent->parent + && $element->parent->parent->parent->first_element eq 'PGML::Format2' + && is_function_call($element->parent->parent->parent->first_element) + && $element->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent->first_element =~ /^(STATEMENT|HINT|SOLUTION)$/ + && is_function_call($element->parent->parent->parent->parent->parent->first_element); + return; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::EncouragePGMLUsages - All problems should use PGML to +insert problem text. + +=head1 DESCRIPTION + +All problems should use PGML via C/C, +C/C, or +C/C blocks to insert problem text, +instead of the older C/C, C/C, or +C/C blocks. The PGML syntax is much easier to read +for other problem authors looking at the code, and PGML helps to ensure that +many text elements (for example images and tables) are inserted correctly for +recent requirements for accessibility. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm b/lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm new file mode 100644 index 000000000..79b1cb878 --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm @@ -0,0 +1,100 @@ +package Perl::Critic::Policy::PG::EncourageQualityMacroUsage; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => '%s is used from the macro %s'; +use constant EXPLANATION => '%s is a high quality macro whose usage is encouraged.'; + +# FIXME: A better explanation is needed. Perhaps instead of a single explanation for all macros, add an explanation key +# to each of the methods below and give an explanation specific to the method and macro used. + +use constant METHODS => { + AnswerHints => { macro => 'answerHints.pl', score => 10 }, + CheckboxList => { macro => 'parserCheckboxList.pl', score => 10 }, + createLaTeXImage => { macro => 'PGlateximage.pl', score => 10 }, + createTikZImage => { macro => 'PGtikz.pl', score => 10 }, + DataTable => { macro => 'niceTables.pl', score => 10 }, + DraggableProof => { macro => 'draggableProof.pl', score => 10 }, + DraggableSubset => { macro => 'draggableSubset.pl', score => 10 }, + DropDown => { macro => 'parserPopUp.pl', score => 10 }, + Graph3D => { macro => 'plotly3D.pl', score => 10 }, + GraphTool => { marco => 'parserGraphTool.pl', score => 10 }, + LayoutTable => { macro => 'niceTables.pl', score => 10 }, + MultiAnswer => { macro => 'parserMultiAnswer.pl', score => 30 }, + Plots => { macro => 'plots.pl', score => 10 }, + RadioButtons => { macro => 'parserRadioButtons.pl', score => 10 }, + RadioMultiAnswer => { macro => 'parserRadioMultiAnswer.pl', score => 30 }, + randomLastName => { macro => 'randomPerson.pl', score => 10 }, + randomPerson => { macro => 'randomPerson.pl', score => 10 }, + 'Scaffold::Begin' => { macro => 'scaffold.pl', score => 20 } +}; + +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 METHODS->{$element} && is_function_call($element); + return $self->violation(sprintf(DESCRIPTION, $element, METHODS->{$element}{macro}), + { score => METHODS->{$element}{score}, explanation => sprintf(EXPLANATION, METHODS->{$element}{macro}) }, + $element); +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::EncourageQualityMacroUsage - Usage of macros that are +well maintained and provide advanced MathObject answers is encouraged. + +=head1 DESCRIPTION + +Usage of macros that are well maintained and provide advanced MathObject answers +is encouraged. This policy currently recognizes the usage of the following +macros: + +=over + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=item * L + +=back + +=cut diff --git a/lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm b/lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm new file mode 100644 index 000000000..abe694486 --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm @@ -0,0 +1,61 @@ +package Perl::Critic::Policy::PG::EncourageSolutionsAndHints; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'A %s is included'; +use constant EXPLANATION => { + solution => 'A solution should be added to all problems.', + hint => 'A hint is helpful for students.' +}; +use constant SCORE => { solution => 15, hint => 10 }; + +sub supported_parameters ($) {return} +sub default_severity ($) { return $SEVERITY_HIGHEST } +sub default_themes ($) { return qw(pg) } +sub applies_to ($) { return qw(PPI::Token::HereDoc) } + +sub violates ($self, $element, $) { + if ( + $element->terminator =~ /^END_(PGML_)?(SOLUTION|HINT)/ + && $element->parent + && $element->parent->parent + && $element->parent->parent->parent + && ($element->parent->parent->parent->first_element eq 'PGML::Format2' + || $element->parent->parent->parent->first_element eq 'EV3P') + && is_function_call($element->parent->parent->parent->first_element) + && $element->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent->first_element =~ /^(HINT|SOLUTION)$/ + && is_function_call($element->parent->parent->parent->parent->parent->first_element) + ) + { + my $type = lc($1); + return $self->violation( + sprintf(DESCRIPTION, $type), + { score => SCORE->{$type}, explanation => EXPLANATION->{$type} }, + $element->parent->parent->parent->parent->parent + ); + } + return; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::EncourageSolutionsAndHints - Solutions should be +provided in all problems, and hints are helpful for students. + +=head1 DESCRIPTION + +All problems should provide solutions that demonstrate how to work the problem, +and which do not just give the answers to the problem. + +Hints are helpful for students that are struggling with the concepts presented +in the problem, and it is recommended that hints be added particularly for more +difficult problems. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm b/lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm new file mode 100644 index 000000000..2176f8422 --- /dev/null +++ b/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 function is +deprecated, no longer does anything, and should be removed from all problems. + +=head1 DESCRIPTION + +The C function is deprecated, no longer does anything, and should +be removed from all problems. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm b/lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm new file mode 100644 index 000000000..4487c616e --- /dev/null +++ b/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 diff --git a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm new file mode 100644 index 000000000..21ec89d42 --- /dev/null +++ b/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 instead of +the deprecated C methods. + +=head1 DESCRIPTION + +Convert answers into a C and use the C method of the object +instead of using any of the deprecated C methods such as C from +the L macro, C from the +L macro, or C from the +L macro. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm new file mode 100644 index 000000000..38e051bb3 --- /dev/null +++ b/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 directory) +should be rewritten to use modern alternatives. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm new file mode 100644 index 000000000..d7667be8e --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm @@ -0,0 +1,55 @@ +package Perl::Critic::Policy::PG::ProhibitDeprecatedMultipleChoice; +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 %s function is called'; +use constant EXPLANATION => 'The deprecated %s function should be replaced with a modern alternative.'; +use constant SCORE => -20; +use constant SAMPLE_PROBLEMS => [ + [ 'Multiple Choice with Checkbox' => 'Misc/MultipleChoiceCheckbox' ], + [ 'Multiple Choice with Popup' => 'Misc/MultipleChoicePopup' ], + [ 'Multiple Choice with Radio Buttons' => 'Misc/MultipleChoiceRadio' ] +]; + +# Note that new_match_list is not in this list because there is not a modern alternative yet. +# The qa method is also not listed because it is needed with new_match_list. +use constant MULTIPLE_CHOICE_METHODS => { + new_checkbox_multiple_choice => 1, + new_multiple_choice => 1, + new_pop_up_select_list => 1, + new_select_list => 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, $) { + return unless MULTIPLE_CHOICE_METHODS->{$element} && is_function_call($element); + return $self->violation(sprintf(DESCRIPTION, $element), + { score => SCORE, explanation => sprintf(EXPLANATION, $element), sampleProblems => SAMPLE_PROBLEMS }, + $element); +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::ProhibitDeprecatedMultipleChoice - Replace usage of +L multiple choice methods with the appropriate MathObject +multiple choice +macro. + +=head1 DESCRIPTION + +Replace usage of L multiple choice methods with the +appropriate modern multiple choice macro. For example, consider using +L, L, or L. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm b/lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm new file mode 100644 index 000000000..9f240628f --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm @@ -0,0 +1,41 @@ +package Perl::Critic::Policy::PG::ProhibitEnddocumentMatter; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'There is content after the ENDDOCUMENT call'; +use constant EXPLANATION => 'Remove this content. The ENDDOCUMENT call should be at the end of the problem.'; +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 default_maximum_violations_per_document ($) { return 1; } + +sub violates ($self, $element, $document) { + return $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $element) + if $element eq 'ENDDOCUMENT' + && is_function_call($element) + && ($document->{_doc}{untranslatedCode} // '') =~ /ENDDOCUMENT[^\n]*\n(.*)/s + && $1 =~ /\S/; + return; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::ProhibitEnddocumentMatter - There should not be any +content after the C call in a problem. + +=head1 DESCRIPTION + +The C call is intended to signify the end of the problem code. +Although all content after the C call is ignored, there should not +be any content (text or code) in this area. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm b/lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm new file mode 100644 index 000000000..734fd74ef --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm @@ -0,0 +1,42 @@ +package Perl::Critic::Policy::PG::ProhibitGraphMacros; +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 init_graph function from PGgraphmacros.pl is called'; +use constant EXPLANATION => 'PGgraphmacros.pl generates poor quality graphics. Consider using a modern alternative.'; +use constant SCORE => -20; +use constant SAMPLE_PROBLEMS => [ + [ 'TikZ Graph Images' => 'ProblemTechniques/TikZImages' ], + [ 'Inserting Images in PGML' => 'ProblemTechniques/Images' ], + [ 'Function Plot' => 'Algebra/FunctionPlot' ] +]; + +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 'init_graph' && is_function_call($element); + return $self->violation(DESCRIPTION, + { score => SCORE, explanation => EXPLANATION, sampleProblems => SAMPLE_PROBLEMS }, $element); +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::ProhibitGraphMacros - L generates +poor quality graphics. Modern alternatives should be used instead. + +=head1 DESCRIPTION + +L generates poor quality graphics. Replace its usage with a +modern alternative such as L, L, or L. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm b/lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm new file mode 100644 index 000000000..b680bbf55 --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm @@ -0,0 +1,38 @@ +package Perl::Critic::Policy::PG::ProhibitMultipleLoadMacrosCalls; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'loadMacros is called multiple times'; +use constant EXPLANATION => 'Consolidate multiple loadMacros calls into a single call.'; +use constant SCORE => -20; + +sub supported_parameters ($) {return} +sub default_severity ($) { return $SEVERITY_HIGHEST } +sub default_themes ($) { return qw(pg) } +sub applies_to ($) { return qw(PPI::Document) } + +sub violates ($self, $element, $document) { + my $tokens = $document->find('PPI::Token'); + return unless $tokens; + my @loadMacrosCalls = grep { $_ eq 'loadMacros' && is_function_call($_) } @$tokens; + shift @loadMacrosCalls; + return map { $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $_) } @loadMacrosCalls; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::ProhibitMultipleLoadMacrosCalls - The C +function should only be called once in each problem. + +=head1 DESCRIPTION + +The C function should only be called once in each problem. +Consolidate multiple C calls into a single call and make sure that +all macros that are loaded are actually used in the problem. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitOldText.pm b/lib/Perl/Critic/Policy/PG/ProhibitOldText.pm new file mode 100644 index 000000000..ca37c3098 --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/ProhibitOldText.pm @@ -0,0 +1,53 @@ +package Perl::Critic::Policy::PG::ProhibitOldText; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'A BEGIN_%1$s/END_%1$s block is used for problem text'; +use constant EXPLANATION => 'Load the macro PGML.pl and replace the BEGIN_%1$s/END_%1$s ' + . 'block with a BEGIN_PGML%2$s/END_PGML%2$s block.'; +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::HereDoc) } + +sub violates ($self, $element, $document) { + if ($element->terminator =~ /^END_(TEXT|SOLUTION|HINT)?$/ + && $element->parent + && $element->parent->parent + && $element->parent->parent->parent + && $element->parent->parent->parent->first_element eq 'EV3P' + && is_function_call($element->parent->parent->parent->first_element) + && $element->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent->first_element =~ /^(STATEMENT|HINT|SOLUTION)$/ + && is_function_call($element->parent->parent->parent->parent->parent->first_element)) + { + my $oldType = $1 eq 'STATEMENT' ? 'TEXT' : $1; + return $self->violation( + sprintf(DESCRIPTION, $oldType), + { score => SCORE, explanation => sprintf(EXPLANATION, $oldType, $1 eq 'STATEMENT' ? '' : "_$1") }, + $element->parent->parent->parent->parent->parent + ); + } + return; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::ProhibitOldText - Replace old PG text usage with PGML. + +=head1 DESCRIPTION + +Load the C macro and replace all C/C, +C/C, and C/C blocks with +C/C, C/C, and +C/C blocks. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm b/lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm new file mode 100644 index 000000000..51252dc6f --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm @@ -0,0 +1,42 @@ +package Perl::Critic::Policy::PG::ProhibitUnnecessarilySettingShowPartialCorrectAnswers; +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 => '$showPartialCorrectAnswers is set to 1'; +use constant EXPLANATION => 'The value of $showPartialCorrectAnswers is 1 by default, ' + . 'so it should only ever be set to 0 to change the value.'; +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::Operator) } + +sub violates ($self, $element, $) { + return unless is_assignment_operator($element); + my $left = $element->sprevious_sibling; + my $right = $element->snext_sibling; + return $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $left) + if $left && $left eq '$showPartialCorrectAnswers' && $element eq '=' && $right && $right eq '1'; + return; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::ProhibitUnnecessarilySettingShowPartialCorrectAnswers +- There is no need to set C<$showPartialCorrectAnswers> to 1 since that is the +default value. + +=head1 DESCRIPTION + +The value of C<$showPartialCorrectAnswers> is 1 by default, so it should only +ever be set to 0 to change the value. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm b/lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm new file mode 100644 index 000000000..e538b409a --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm @@ -0,0 +1,96 @@ +package Perl::Critic::Policy::PG::RequireImageAltAttribute; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use WeBWorK::PG::Critic::Utils qw(parsePGMLBlock parseTextBlock); + +use constant DESCRIPTION => 'An image is missing the alt attribute'; +use constant EXPLANATION => 'Add an alt attribute that describes the image content.'; +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::HereDoc PPI::Token::Word) } + +sub hasAltTag ($self, $element) { + my @args = + map { $_->[0]->isa('PPI::Token::Quote') ? $_->[0]->string : $_->[0]->content } parse_arg_list($element); + shift @args; # Remove the image argument. + my %args = @args % 2 ? () : @args; + return $args{alt} || ($args{extra_html_tags} && $args{extra_html_tags} =~ /alt/); +} +use Mojo::Util qw(dumper); + +sub violates ($self, $element, $) { + my @violations; + if ($element->isa('PPI::Token::Word') && $element eq 'image' && is_function_call($element)) { + push(@violations, $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $element)) + unless $self->hasAltTag($element); + } elsif ( + $element->isa('PPI::Token::HereDoc') + && $element->terminator =~ /^END_(PGML|PGML_SOLUTION|PGML_HINT|TEXT|HINT|SOLUTION)?$/ + && $element->parent + && $element->parent->parent + && $element->parent->parent->parent + && ($element->parent->parent->parent->first_element eq 'PGML::Format2' + || $element->parent->parent->parent->first_element eq 'EV3P') + && is_function_call($element->parent->parent->parent->first_element) + && $element->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent + && $element->parent->parent->parent->parent->parent->first_element =~ /^(STATEMENT|HINT|SOLUTION)$/ + && is_function_call($element->parent->parent->parent->parent->parent->first_element) + ) + { + for my $command ( + @{ + ( + $element->terminator =~ /PGML/ + ? parsePGMLBlock($element->heredoc)->{commands} + : parseTextBlock($element->heredoc)->{commands} + ) // [] + } + ) + { + for (grep { $_ eq 'image' && is_function_call($_) } @{ $command->find('PPI::Token::Word') || [] }) { + next if $self->hasAltTag($_); + push( + @violations, + $self->violation( + DESCRIPTION + . ' inside the ' + . ($element->terminator =~ s/END/BEGIN/r) . '/' + . ($element->terminator) + . ' block', + { score => SCORE, explanation => EXPLANATION }, + $element->parent->parent->parent->parent->parent + ) + ); + } + } + } + + return @violations; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::RequireImageAltAttribute - Images created with the +C method should have the C attribute set. + +=head1 DESCRIPTION + +The C attribute is crucial for accessibility, especially for visually +impaired users who rely on screen readers to understand the content of the +problem. So all images added to a problem should have the C attribute set. +Note that it can be set to the empty string to indicate that the image is not +essential to the meaning of the problem content. Generally it is better to use +the PGML syntax for images C<[!alternate text!]{$image}> rather than using the +C method. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/RequireMetadata.pm b/lib/Perl/Critic/Policy/PG/RequireMetadata.pm new file mode 100644 index 000000000..799f859e6 --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/RequireMetadata.pm @@ -0,0 +1,51 @@ +package Perl::Critic::Policy::PG::RequireMetadata; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'The %s metadata tag is required'; +use constant EXPLANATION => 'Include the required metadata tags at the beginning of the problem file.'; +use constant SCORE => -5; +use constant REQUIRED_METADATA => [ 'DBsubject', 'DBchapter', 'DBsection', 'KEYWORDS' ]; + +sub supported_parameters ($) {return} +sub default_severity ($) { return $SEVERITY_HIGHEST } +sub default_themes ($) { return qw(pg) } +sub applies_to ($) { return qw(PPI::Document) } + +sub violates ($self, $element, $document) { + my $comments = $document->find('PPI::Token::Comment'); + my %foundMetadata; + if ($comments) { + for my $comment (@$comments) { + my ($metadataType) = grep { $comment =~ /#\s*$_\(/i } @{ REQUIRED_METADATA() }; + $foundMetadata{$metadataType} = 1 if $metadataType; + } + } + + my @violations; + for (@{ REQUIRED_METADATA() }) { + push(@violations, + $self->violation(sprintf(DESCRIPTION, $_), { score => SCORE, explanation => EXPLANATION }, $document)) + unless $foundMetadata{$_}; + } + return @violations; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::RequireMetadata - All problems should have the +appropriate OPL metadata tags set. + +=head1 DESCRIPTION + +All problems should have the appropriate OPL metadata tags set. The required +metadata attributes should be set at the beginning of the problem file before +the C call. The metadata tags that are required for all problems are +C, C, C, and C. + +=cut diff --git a/lib/Perl/Critic/Policy/PG/RequireSolution.pm b/lib/Perl/Critic/Policy/PG/RequireSolution.pm new file mode 100644 index 000000000..937be8bf1 --- /dev/null +++ b/lib/Perl/Critic/Policy/PG/RequireSolution.pm @@ -0,0 +1,61 @@ +package Perl::Critic::Policy::PG::RequireSolution; +use Mojo::Base 'Perl::Critic::Policy', -signatures; + +use Perl::Critic::Utils qw(:severities :classification :ppi); + +use constant DESCRIPTION => 'A solution is not included in this problem'; +use constant EXPLANATION => 'A solution should be included in all problems.'; +use constant SCORE => -15; + +sub supported_parameters ($) {return} +sub default_severity ($) { return $SEVERITY_HIGHEST } +sub default_themes ($) { return qw(pg) } +sub applies_to ($) { return qw(PPI::Document) } + +sub default_maximum_violations_per_document ($) { return 1; } + +sub violates ($self, $element, $document) { + my $solutionFound = 0; + if (my $heredocs = $document->find('PPI::Token::HereDoc')) { + for (@$heredocs) { + if ( + $_->terminator =~ /^END_(PGML_)?SOLUTION$/ + && $_->parent + && $_->parent->parent + && $_->parent->parent->parent + && ($_->parent->parent->parent->first_element eq 'PGML::Format2' + || $_->parent->parent->parent->first_element eq 'EV3P') + && is_function_call($_->parent->parent->parent->first_element) + && $_->parent->parent->parent->parent + && $_->parent->parent->parent->parent->parent + && $_->parent->parent->parent->parent->parent->first_element eq 'SOLUTION' + && is_function_call($_->parent->parent->parent->first_element) + ) + { + $solutionFound = 1; + last; + } + } + } + return $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $document) + unless $solutionFound; + return; +} + +1; + +__END__ + +=head1 NAME + +Perl::Critic::Policy::PG::RequireSolution - All problems should provide a +solution. + +=head1 DESCRIPTION + +A solution should be included in all problems. Note that a solution should +demonstrate all steps to solve a problem, and should certainly not just give the +answers to questions in the problem. This is one of the most challenging parts +of PG problem authoring, but the solution should not be omitted. + +=cut diff --git a/lib/WeBWorK/PG/Critic.pm b/lib/WeBWorK/PG/Critic.pm new file mode 100644 index 000000000..a235fc541 --- /dev/null +++ b/lib/WeBWorK/PG/Critic.pm @@ -0,0 +1,94 @@ + +=head1 NAME + +WeBWorK::PG::Critic - Critique PG problem source code for best-practices. + +=head1 DESCRIPTION + +Analyze a pg file for use of old and current methods. + +=head1 FUNCTIONS + +=head2 critiquePGCode + + my $results = critiquePGCode($code, $force = 0); + +Parses and critiques the given PG problem source provided in C<$code>. An array +of "violations" that are found is returned. Note that the elements of this +return array are L objects. However, not all of these +"violations" are bad. Some are actually noting good things that are used in the +source code for the problem. The C method can be called for each +element, and that will either return a string or a reference to a hash. The +string return type will occur for a violation of a default L +policy. The last return type will occur with a C +policy, and the hash will contain a C key and an C key +containing the actual explanation. If the C is positive, then it is not +actually a violation, but something good. In some cases the C +return hash will also contain the key C which will be a +reference to an array each of whose entries will be a reference to a two element +array whose first element is the title of a sample problem and whose second +element is the path for that sample problem where the sample problem +demonstrates a way to fix the policy violation. + +Note that C<## no critic> annotations can be used in the code to disable a +violation for a line or the entire file. See L<"BENDING THE +RULES"|https://metacpan.org/pod/Perl::Critic#BENDING-THE-RULES>. However, if +C<$force> is true, then C<## no critic> annotations are ignored, and all +policies are enforced regardless. + +=head2 critiquePGFile + + my $results = critiquePGFile($file, $force); + +This just executes C on the contents of C<$file> and returns +the result. +=cut + +package WeBWorK::PG::Critic; +use Mojo::Base 'Exporter', -signatures; + +use Mojo::File qw(path); +use PPI; +use Perl::Critic; + +our @EXPORT_OK = qw(critiquePGFile critiquePGCode); + +sub critiquePGCode ($code, $force = 0) { + my $critic = Perl::Critic->new( + -severity => 4, + -exclude => [ + 'Perl::Critic::Policy::Modules::ProhibitMultiplePackages', + 'Perl::Critic::Policy::Modules::RequireEndWithOne', + 'Perl::Critic::Policy::Modules::RequireExplicitPackage', + 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage', + 'Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms', + 'Perl::Critic::Policy::Subroutines::RequireArgUnpacking', + 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict', + 'Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings', + 'Perl::Critic::Policy::Variables::RequireLocalizedPunctuationVars', + + # Make sure that Community and Freenode policies are not used if installed on the system. + '.*::Community::.*', '.*::Freenode::.*' + ], + -force => $force + ); + + my $translatedCode = WeBWorK::PG::Translator::default_preprocess_code($code); + + my $document = PPI::Document->new(\$translatedCode); + + # Provide the untranslated code so that policies can access it. It will be in the _doc key of the $document that is + # passed as the third argument to the violates method. See Perl::Critic::Policy::PG::ProhibitEnddocumentMatter which + # uses this for example. + $document->{untranslatedCode} = $code; + + return $critic->critique($document); +} + +sub critiquePGFile ($file, $force = 0) { + my $code = eval { path($file)->slurp('UTF-8') }; + die qq{Unable to read contents of "$file": $@} if $@; + return critiquePGCode($code, $force); +} + +1; diff --git a/lib/WeBWorK/PG/Critic/Utils.pm b/lib/WeBWorK/PG/Critic/Utils.pm new file mode 100644 index 000000000..a0e1f005d --- /dev/null +++ b/lib/WeBWorK/PG/Critic/Utils.pm @@ -0,0 +1,159 @@ + +=head1 NAME + +WeBWorK::PG::Critic::Utils - Utility methods for PG Critic policies. + +=head1 DESCRIPTION + +Utility methods for PG Critic policies. + +=head1 FUNCTIONS + +=head2 getDeprecatedMacros + + my @deprecatedMacros = getDeprecatedMacros(); + +Returns a list of deprecated macros. These are the macros found in the +C directory. + +=head2 parsePGMLBlock + + my $pgmlElements = parsePGMLBlock(@lines); + +Parses the given C<@lines> of code from a PGML block and returns a reference to +a hash containing details of the PGML blocks found. + +If any C<[@ ... @]> blocks are found in the PGML code, then the return hash will +contain the key C which will be a reference to an array of +L objects representing the Perl code within the C<[@ ... @]> +blocks found. + +If the PGML content or a block within fails to parse, then the return hash will +contain the key C with a reference to an array of errors that occurred. + +=head2 parseTextBlock + + my $textElements = parseTextBlock(@lines); + +Parses the given C<@lines> of code from a C/C, +C/C, or C/C block and +returns a reference to a hash containing details of the elements found. + +If any C<\{ ... \}> blocks are found in the code, then the return hash will +contain the key C which will be a reference to an array of +L objects representing the Perl code within the C<\{ ... \}> +blocks found. + +If a block within fails to parse, then the return hash will contain the key +C which is a reference to an array of errors that occurred. + +=cut + +package WeBWorK::PG::Critic::Utils; +use Mojo::Base 'Exporter', -signatures; + +use Mojo::File qw(curfile path); +use PPI; +use Perl::Critic::Utils qw(:classification :ppi); +use Scalar::Util qw(blessed); +use Mojo::Util qw(md5_sum encode); +use Env qw(PG_ROOT); + +use lib curfile->dirname->dirname->dirname->dirname->dirname->child('lib'); + +require WeBWorK::PG::Translator; + +our @EXPORT_OK = qw(getDeprecatedMacros parsePGMLBlock parseTextBlock); + +$PG_ROOT = curfile->dirname->dirname->dirname->dirname->dirname; + +sub getDeprecatedMacros () { + state $deprecatedMacros; + return $deprecatedMacros if $deprecatedMacros; + return $deprecatedMacros = + { map { $_->basename => 1 } @{ path($PG_ROOT)->child('macros', 'deprecated')->list } }; +} + +sub main::PG_restricted_eval ($code) { return $code; } + +sub walkPGMLTree ($block, $results //= {}) { + for my $item (@{ $block->{stack} }) { + next unless blessed $item && $item->isa('PGML::Block'); + if ($item->{type} eq 'command') { + my $command = PPI::Document->new(\($item->{text})); + if ($command->errstr) { + push(@{ $results->{errors} }, $command->errstr); + } else { + push(@{ $results->{commands} }, $command); + } + } + walkPGMLTree($item, $results); + } + return $results; +} + +# For now, only command blocks are returned. Add other PGML elements as needed. +sub parsePGMLBlock (@lines) { + state %processedBlocks; + + my $source = join('', @lines); + + # Cache the results of parsing particular PGML blocks so that if multiple policies + # use the same PGML block the parsing does not need to be done again. + my $sourceHash = md5_sum(encode('UTF-8', $source)); + return $processedBlocks{$sourceHash} if defined $processedBlocks{$sourceHash}; + + package main; ## no critic (Modules::ProhibitMultiplePackages) + + require WeBWorK::PG::Environment; + require WeBWorK::PG; + require PGcore; + require Parser; + + $WeBWorK::PG::IO::pg_envir = WeBWorK::PG::Environment->new; + %main::envir = %{ WeBWorK::PG::defineProblemEnvironment($WeBWorK::PG::IO::pg_envir) }; + + do "$ENV{PG_ROOT}/macros/PG.pl"; + + $main::PG = $main::PG = PGcore->new(\%main::envir); + loadMacros('PGML.pl'); + + $PGML::warningsFatal = $PGML::warningsFatal = 1; + my $parser = eval { PGML::Parse->new($source =~ s/\\\\/\\/gr) }; + return { errors => [$@] } if $@; + + return $processedBlocks{$sourceHash} = WeBWorK::PG::Critic::Utils::walkPGMLTree($parser->{root}); +} + +# For now, only contents of \{ .. \} blocks are returned. Add other text elements as needed. +sub parseTextBlock (@lines) { + state %processedBlocks; + + my $source = join('', @lines); + + # Cache the results of parsing particular text blocks so that if multiple policies + # use the same text block the parsing does not need to be done again. + my $sourceHash = md5_sum(encode('UTF-8', $source)); + return $processedBlocks{$sourceHash} if defined $processedBlocks{$sourceHash}; + + my $results = {}; + + while ($source ne '') { + if ($source =~ /\Q\\{\E/s) { + $source =~ s/^(.*?)\Q\\{\E//s; + $source =~ s/^(.*?)\Q\\}\E//s; + my $command = PPI::Document->new(\($1)); + if ($command->errstr) { + push(@{ $results->{errors} }, $command->errstr); + } else { + push(@{ $results->{commands} }, $command); + } + } else { + last; + } + + } + + return $processedBlocks{$sourceHash} = $results; +} +1; diff --git a/lib/WeBWorK/PG/PGProblemCritic.pm b/lib/WeBWorK/PG/PGProblemCritic.pm deleted file mode 100644 index f637d36f6..000000000 --- a/lib/WeBWorK/PG/PGProblemCritic.pm +++ /dev/null @@ -1,319 +0,0 @@ - -=head1 NAME - -PGProblemCritic - Parse a PG program and analyze the contents for positive and negative features. - -=head1 DESCRIPTION - -Analyze a pg file for use of old and current methods. - -=over - -=item * C: a list of the macros that the problem uses that is in the C -folder. - -=item * Positive features: - -=over - -=item * Uses PGML - -=item * Provides a solution - -=item * Provides a hint - -=item * Uses Scaffolds - -=item * Uses a custom checker - -=item * Uses a multianswer - -=item * Uses answer hints - -=item * Uses nicetables - -=item * Uses randomness - -=back - -=item Old and deprecated features - -=over - -=item * Use of BEGIN_TEXT/END_TEXT - -=item * Include the C - -=item * Include old tables (for example from C) - -=item * The use of C, C and C in lieu of using MathObjects - -=item * Including C<< Context()->TeXStrings >> - -=item * Calling C more than once. - -=item * Using the line C< $showPartialCorrectAnswers = 1 > which is the default behavior and thus unnecessary. - -=item * Using methods from C - -=item * Inlcuding code or other text below the C line indicating the end of the problem. - -=back - -=back - - -=cut - -package WeBWorK::PG::PGProblemCritic; -use parent qw(Exporter); - -use strict; -use warnings; -use experimental 'signatures'; -use feature 'say'; - -use Mojo::File qw(curfile); -use Mojo::Util qw(dumper); - -our @EXPORT_OK = qw(analyzePGfile analyzePGcode getDeprecatedMacros); - -sub analyzePGcode ($code) { - # default flags for presence of features in a PG problem - my $features = { - metadata => { DBsubject => 0, DBchapter => 0, DBsection => 0, KEYWORDS => 0 }, - positive => { - PGML => 0, - solution => 0, - hint => 0, - custom_checker => 0, - multianswer => 0, - nicetables => 0, - randomness => 0, - contexts => { BaseN => 0, Units => 0, Boolean => 0, Reaction => 0 }, - parsers => - { dropdown => 0, RadioButtons => 0, CheckboxList => 0, RadioMultianswer => 0, GraphTool => 0 }, - macros => { - randomPerson => 0, - Plots => 0, - PGtikz => 0, - Plotly3D => 0, - PGlateximage => 0, - Scaffold => 0, - AnswerHints => 0, - } - }, - negative => { - BEGIN_TEXT => 0, - beginproblem => 0, - oldtable => 0, - num_cmp => 0, - str_cmp => 0, - fun_cmp => 0, - context_texstrings => 0, - multiple_loadmacros => 0, - showPartialCorrect => 0, - lines_below_enddocument => 0, - macros => { PGgraphmacros => 0, PGchoicemacros => 0 } - }, - deprecated_macros => [], - macros => [] - }; - - # Get a list of all deprecated macros. - my $all_deprecated_macros = getDeprecatedMacros(curfile->dirname->dirname->dirname->dirname); - - # determine if the loadMacros has been parsed. - my $loadmacros_parsed = 0; - - my @pglines = split /\n/, $code; - my $line = ''; - while (1) { - $line = shift @pglines; - # print Dumper $line; - last unless defined($line); # end of the file. - next if $line =~ /^\s*$/; # skip any blank lines. - - # Determine if some of the metadata tags are present. - for (qw(DBsubject DBchapter DBsection KEYWORDS)) { - $features->{metadata}{$_} = 1 if $line =~ /$_\(/i; - } - - # Skip any full-line comments. - next if $line =~ /^\s*#/; - - $features->{positive}{solution} = 1 if $line =~ /BEGIN_(PGML_)?SOLUTION/; - $features->{positive}{hint} = 1 if $line =~ /BEGIN_(PGML_)?HINT/; - - # Analyze the loadMacros info. - if ($line =~ /loadMacros\(/) { - $features->{negative}{multiple_loadmacros} = 1 if $loadmacros_parsed == 1; - $loadmacros_parsed = 1; - # Parse the macros, which may be on multiple rows. - my $macros = $line; - while ($line && $line !~ /\);\s*$/) { - $line = shift @pglines; - - # Strip any comments at the end of lines. - $line =~ s/(.*)#.*/$1/; - $macros .= $line; - } - - $macros =~ s/^\s*loadMacros\(\s*(.*)\s*\);\s*$/$1/; - my @macros; - # if the arguments of loadMacros is q[qw] form, handle this. - if ($macros =~ /^q[qw]?[\(\[\{\/](.*)[\)\]\/\}]$/) { - $macros =~ s/^q[qw]?[\(\[\{\/](.*)[\)\]\/\}]$/$1/; - @macros = grep { $_ ne '' } split(/\s+/, $macros); - } else { # arguments are strings separated by commas. - @macros = map {s/['"\s]//gr} split(/\s*,\s*/, $macros =~ s/loadMacros\((.*)\)\;$/$1/r); - } - - $features->{macros} = \@macros; - for my $macro (@macros) { - push(@{ $features->{deprecated_macros} }, $macro) if (grep { $macro eq $_ } @$all_deprecated_macros); - } - } elsif ($line =~ /BEGIN_PGML(_SOLUTION|_HINT)?/) { - $features->{positive}{PGML} = 1; - my @pgml_lines; - while (1) { - $line = shift @pglines; - last if $line =~ /END_PGML(_SOLUTON|_HINT)?/; - push(@pgml_lines, $line); - } - - my $pgml_features = analyzePGMLBlock(@pgml_lines); - $features->{negative}{missing_alt_tag} = 1 if $pgml_features->{missing_alt_tag}; - } - - if ($line =~ /ENDDOCUMENT/) { # scan if there are any lines below the ENDDOCUMENT - - do { - $line = shift @pglines; - last unless defined($line); - $features->{negative}{lines_below_enddocument} = 1 if $line !~ /^\s*$/; - } while (defined($line)); - } - - # Check for negative features. - $features->{negative}{beginproblem} = 1 if $line =~ /beginproblem\(\)/; - $features->{negative}{BEGIN_TEXT} = 1 if $line =~ /(BEGIN_(TEXT|HINT|SOLUTION))|EV[23]/; - $features->{negative}{context_texstrings} = 1 if $line =~ /->(texStrings|normalStrings)/; - for (qw(num str fun)) { - $features->{negative}{ $_ . '_cmp' } = 1 if $line =~ /${_}_cmp\(/; - } - $features->{negative}{oldtable} = 1 if $line =~ /BeginTable/i; - $features->{negative}{showPartialCorrect} = 1 if $line =~ /\$showPartialCorrectAnswers\s=\s1/; - $features->{negative}{macros}{PGgraphmacros} = 1 if $line =~ /init_graph\(/; - $features->{negative}{macros}{PGchoicemacros} = 1 - if $line =~ /new_checkbox_multiple_choice/ - || $line =~ /new_match_list/ - || $line =~ /new_select_list/ - || $line =~ /new_multiple_choice/ - || $line =~ /qa\s\(/; - - # check for positive features - # macros: - $features->{positive}{macros}{Scaffold} = 1 if $line =~ /Scaffold::Begin/; - $features->{positive}{macros}{Plots} = 1 if $line =~ /Plot\(/; - $features->{positive}{macros}{Plotly3D} = 1 if $line =~ /Graph3D\(/; - $features->{positive}{macros}{PGtikz} = 1 if $line =~ /createTikZImage\(/; - $features->{positive}{macros}{AnswerHints} = 1 if $line =~ /AnswerHints/; - $features->{positive}{macros}{randomPerson} = 1 if $line =~ /randomPerson\(/ || $line =~ /randomLastName\(/; - $features->{positive}{macros}{PGlateximage} = 1 if $line =~ /createLaTeXImage\(/; - - # contexts: - - $features->{positive}{contexts}{Units} = 1 if $line =~ /Context\(['"]Units['"]\)/; - $features->{positive}{contexts}{BaseN} = 1 if $line =~ /Context\(['"](Limited)?BaseN['"]\)/; - $features->{positive}{contexts}{Boolean} = 1 if $line =~ /Context\(['"]Boolean['"]\)/; - $features->{positive}{contexts}{Reaction} = 1 if $line =~ /Context\(['"]Reaction['"]\)/; - - # parsers: - $features->{positive}{parsers}{PopUp} = 1 if $line =~ /DropDown\(/; - $features->{positive}{parsers}{RadioButtons} = 1 if $line =~ /RadioButtons\(/; - $features->{positive}{parsers}{CheckboxList} = 1 if $line =~ /CheckboxList\(/; - $features->{positive}{parsers}{GraphTool} = 1 if $line =~ /GraphTool\(/; - - # other: - $features->{positive}{multianswer} = 1 if $line =~ /MultiAnswer/; - $features->{positive}{custom_checker} = 1 if $line =~ /checker\s*=>/; - $features->{positive}{nicetables} = 1 if $line =~ /DataTable|LayoutTable/; - $features->{positive}{randomness} = 1 if $line =~ /random\(|random_(\w+)\(|list_random\(/; - - } - return $features; -} - -# Return a list of the macro filenames in the 'macros/deprecated' directory. -sub getDeprecatedMacros ($pgroot) { - return Mojo::File->new($pgroot)->child('macros/deprecated')->list->map(sub { $_->basename })->to_array; -} - -sub analyzePGfile ($file) { - my $path = Mojo::File->new($file); - die "The file: $file does not exist or is not readable" unless -r $path; - - return analyzePGcode($path->slurp); -} - -# Parse a string that is a function in the form of "funct($arg1, $arg2, ..., param1 => val1, param2 => val2 , ...)" -# A hashref of the form {_args = [$arg1, $arg2, ...], param1 => val1, param2 => val2} is returned. - -sub parseFunctionString($string) { - - my ($funct, $args); - if ($string =~ /(\w+)\(\s*(.*)\)/) { - ($funct, $args) = ($1, $2); - } else { - return (); - } - - my @args = split(/,\s/, $args); - - my %params = (_name => $funct, _args => []); - for (@args) { - if ($_ !~ /=>/) { - push(@{ $params{_args} }, $_); - } else { - if ($_ =~ /(\w+)\s*=>\s*["']?([^"]*)["']?/) { - my ($key, $value) = ($1, $2); - $params{$key} = $value; - } - } - } - return %params; -} - -# Perform some analysis of a PGML block. - -sub analyzePGMLBlock(@lines) { - my $pgml_features = {}; - - while (1) { - my $line = shift @lines; - last unless defined($line); - - # If there is a perl block analyze [@ @] - if ($line =~ /\[@/) { - my $perl_line = $line; - while ($perl_line !~ /@\]/) { - $line = shift @lines; - $perl_line .= $line; - } - my ($perlcode) = $perl_line =~ /\[@\s*(.*)\s*@\]/; - - my %funct_info = parseFunctionString($perlcode); - if (%funct_info && $funct_info{_name} =~ /image/) { - if (defined($funct_info{extra_html_tags}) && $funct_info{extra_html_tags} !~ /alt/) { - $pgml_features->{missing_alt_tag} = 1; - } - } - - } elsif (my ($alt_text) = $line =~ /\[!(.*)!\]/) { - $pgml_features->{missing_alt_tag} = 1 if $alt_text =~ /^\s$/; - } - - } - return $pgml_features; -} From 5218f8303adb9c61d119263b5b9e8df65157d6cc Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 16 Jul 2025 06:29:12 -0500 Subject: [PATCH 3/6] Remove "positive violations" and invert score. Now all violations are really violations. There is no need for the "positive violations". The score is now purely a badness score. The higher the score, the more work is needed to fix the problem. A score of 0 means the problem has no issues. The "positive violations" were really going to be a problem if the intent of the score is to obtain a measure of how much work is needed to fix a problem and make it conform to current best-practices in problem authoring. For example, a problem could do quite a bit wrong but have a custom checker. The custom checker score was really high, and so that would offset the things done wrong and it might end up with a score that is the same as for a problem that only does a few things wrong, but doesn't have a custom checker. So that first problem with the custom checker really needs a lot of work, but the second problem without the checker only needs trivial fixes. By only having a badness score you get a much clearer measure of how much is needed to update a problem to conform with current best-practices. --- bin/pg-critic.pl | 44 +++----- .../Policy/PG/EncourageCustomCheckers.pm | 43 -------- .../Policy/PG/EncourageModernContextUsage.pm | 65 ------------ .../Critic/Policy/PG/EncouragePGMLUsage.pm | 57 ---------- .../Policy/PG/EncourageQualityMacroUsage.pm | 100 ------------------ .../Policy/PG/EncourageSolutionsAndHints.pm | 61 ----------- .../Critic/Policy/PG/ProhibitBeginproblem.pm | 2 +- .../Policy/PG/ProhibitContextStrings.pm | 2 +- .../Critic/Policy/PG/ProhibitDeprecatedCmp.pm | 2 +- .../Policy/PG/ProhibitDeprecatedMacros.pm | 2 +- .../PG/ProhibitDeprecatedMultipleChoice.pm | 2 +- .../Policy/PG/ProhibitEnddocumentMatter.pm | 2 +- .../Critic/Policy/PG/ProhibitGraphMacros.pm | 2 +- .../PG/ProhibitMultipleLoadMacrosCalls.pm | 2 +- lib/Perl/Critic/Policy/PG/ProhibitOldText.pm | 2 +- ...ssarilySettingShowPartialCorrectAnswers.pm | 2 +- .../Policy/PG/RequireImageAltAttribute.pm | 2 +- lib/Perl/Critic/Policy/PG/RequireMetadata.pm | 2 +- lib/Perl/Critic/Policy/PG/RequireSolution.pm | 2 +- lib/WeBWorK/PG/Critic.pm | 34 +++--- 20 files changed, 46 insertions(+), 384 deletions(-) delete mode 100644 lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm delete mode 100644 lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm delete mode 100644 lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm delete mode 100644 lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm delete mode 100644 lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm diff --git a/bin/pg-critic.pl b/bin/pg-critic.pl index bc4f09422..6e8ab7c4c 100755 --- a/bin/pg-critic.pl +++ b/bin/pg-critic.pl @@ -16,8 +16,8 @@ =head1 SYNOPSIS 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 score and do not include the - details in the output for each file. + -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. -h|--help Show the help message. @@ -25,9 +25,9 @@ =head1 SYNOPSIS =head1 DESCRIPTION C is a PG problem source code analyzer. It is the executable -front-end to the L module, which attempts to identify -usage of old or deprecated PG features, as well as usage of newer features and -current best practices in coding a problem. +front-end to the L module, which attempts to identify usage +of old or deprecated PG features and code that does not conform to current +best-practices. =cut @@ -70,9 +70,9 @@ (@violations) if ($_->policy =~ /^Perl::Critic::Policy::PG::/) { $score += $_->explanation->{score} // 0; } else { - # Deduct 5 points for any of the default Perl::Critic::Policy violations. + # Add 5 points for any of the default Perl::Critic::Policy violations. # These will not have a score in the explanation. - $score -= 5; + $score += 5; } } return $score; @@ -83,13 +83,10 @@ (@violations) for (@ARGV) { my @violations = critiquePGFile($_, $force); - my (@positivePGResults, @negativePGResults, @perlCriticResults); + my (@pgCriticViolations, @perlCriticViolations); if (!$noDetails) { - @positivePGResults = - grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ && $_->explanation->{score} > 0 } @violations; - @negativePGResults = - grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ && $_->explanation->{score} < 0 } @violations; - @perlCriticResults = grep { $_->policy !~ /^Perl::Critic::Policy::PG::/ } @violations; + @pgCriticViolations = grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ } @violations; + @perlCriticViolations = grep { $_->policy !~ /^Perl::Critic::Policy::PG::/ } @violations; } push( @@ -99,11 +96,7 @@ (@violations) score => scoreProblem(@violations), $noDetails ? () - : ( - positivePGResults => \@positivePGResults, - negativePGResults => \@negativePGResults, - perlCriticResults => \@perlCriticResults - ) + : (pgCriticViolations => \@pgCriticViolations, perlCriticViolations => \@perlCriticViolations) } ); } @@ -116,16 +109,13 @@ (@violations) return join( "\n", map { ( - "filename: $_->{file}", - "score: $_->{score}", - @{ $_->{positivePGResults} // [] } - ? ('positive pg critic results:', map { "\t" . $_->to_string } @{ $_->{positivePGResults} }) + "Filename: $_->{file}", + "Score: $_->{score}", + @{ $_->{pgCriticViolations} // [] } + ? ('PG critic violations:', map { "\t" . $_->to_string } @{ $_->{pgCriticViolations} }) : (), - @{ $_->{negativePGResults} // [] } - ? ('negative pg critic results:', map { "\t" . $_->to_string } @{ $_->{negativePGResults} }) - : (), - @{ $_->{perlCriticResults} // [] } - ? ('perl critic results:', map { "\t" . $_->to_string } @{ $_->{perlCriticResults} }) + @{ $_->{perlCriticViolations} // [] } + ? ('Perl critic violations:', map { "\t" . $_->to_string } @{ $_->{perlCriticViolations} }) : () ) } @$results ); diff --git a/lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm b/lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm deleted file mode 100644 index 45e50f43f..000000000 --- a/lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm +++ /dev/null @@ -1,43 +0,0 @@ -package Perl::Critic::Policy::PG::EncourageCustomCheckers; -use Mojo::Base 'Perl::Critic::Policy', -signatures; - -use Perl::Critic::Utils qw(:severities :classification :ppi); - -use constant DESCRIPTION => 'A custom checker is utilized'; -use constant EXPLANATION => 'Custom checkers demonstrate a high level of sophistication in problem coding.'; -use constant SCORE => 50; - -sub supported_parameters ($) {return} -sub default_severity ($) { return $SEVERITY_HIGHEST } -sub default_themes ($) { return qw(pg) } -sub applies_to ($) { return qw(PPI::Token::Word) } - -use Mojo::Util qw(dumper); - -# FIXME: This misses some important cases. For example, answer checking can also be performed in a post filter. In -# fact that demonstrates an even higher level of sophistication than using a checker in some senses. It is more -# complicated to use correctly, and can work around type limitations imposed on MathObject checkers. However, there is -# no reliable way to determine what a post filter is in a problem for, as there are other reasons to add a post filter. -sub violates ($self, $element, $document) { - return unless $element eq 'checker' || $element eq 'list_checker'; - return $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $element); -} - -1; - -__END__ - -=head1 NAME - -Perl::Critic::Policy::PG::EncourageCustomCheckers - Custom checkers demonstrate -a high level of sophistication in problem coding. - -=head1 DESCRIPTION - -Utilization of a custom checker in a problem demonstrates a high level of -sophistication in coding a problem. Custom checkers can be used to supplement -default MathObject checkers in several ways. For example, to award partial -credit and display more meaningful messages for answers that are not entirely -correct - -=cut diff --git a/lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm b/lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm deleted file mode 100644 index f9010cfdd..000000000 --- a/lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm +++ /dev/null @@ -1,65 +0,0 @@ -package Perl::Critic::Policy::PG::EncourageModernContextUsage; -use Mojo::Base 'Perl::Critic::Policy', -signatures; - -# FIXME: Is this policy really a good idea? Why are these contexts so special? Just because they are newer? Many of the -# contexts that have been around for a long time are actually better than some of these, and some of them are more -# complicated to use and demonstrate a higher level of sophistication than these. - -use Perl::Critic::Utils qw(:severities :classification :ppi); - -use constant DESCRIPTION => 'The context %s is used from the macro %s'; -use constant EXPLANATION => '%s is a modern context whose usage demonstrates currency in problem authoring.'; - -use constant CONTEXTS => { - BaseN => { macro => 'contextBaseN.pl', score => 10 }, - Boolean => { macro => 'contextBoolean.pl', score => 10 }, - Reaction => { macro => 'contextReaction.pl', score => 10 }, - Units => { macro => 'contextUnits.pl', 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, $document) { - return unless $element eq 'Context' && is_function_call($element); - my $context = first_arg($element); - return $self->violation( - sprintf(DESCRIPTION, $context->string, CONTEXTS->{ $context->string }{macro}), - { - score => CONTEXTS->{ $context->string }{score}, - explanation => sprintf(EXPLANATION, CONTEXTS->{ $context->string }{macro}) - }, - $context - ) if $context && CONTEXTS->{ $context->string }; - return; -} - -1; - -__END__ - -=head1 NAME - -Perl::Critic::Policy::PG::EncourageModernContextUsage - Usage of recently -created contexts demonstrates currency in problem authoring. - -=head1 DESCRIPTION - -Usage of recently created contexts demonstrates currency in problem authoring. -Currently this policy encourages the use of the following contexts: - -=over - -=item * L - -=item * L - -=item * L - -=item * L - -=back - -=cut diff --git a/lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm b/lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm deleted file mode 100644 index fd67cc9de..000000000 --- a/lib/Perl/Critic/Policy/PG/EncouragePGMLUsage.pm +++ /dev/null @@ -1,57 +0,0 @@ -package Perl::Critic::Policy::PG::EncouragePGMLUsage; -use Mojo::Base 'Perl::Critic::Policy', -signatures; - -use Perl::Critic::Utils qw(:severities :classification :ppi); - -use constant DESCRIPTION => 'PGML is used for problem text'; -use constant EXPLANATION => 'PGML should be used for problem text.'; -use constant SCORE => 20; - -sub supported_parameters ($) {return} -sub default_severity ($) { return $SEVERITY_HIGHEST } -sub default_themes ($) { return qw(pg) } -sub applies_to ($) { return qw(PPI::Token::HereDoc) } - -# Only report this once even if there are multiple PGML blocks in the problem. -sub default_maximum_violations_per_document ($) { return 1; } - -sub violates ($self, $element, $document) { - return $self->violation( - DESCRIPTION, - { score => SCORE, explanation => EXPLANATION }, - $element->parent->parent->parent->parent->parent - ) - if $element->terminator =~ /^END_PGML(_SOLUTION|_HINT)?$/ - && $element->parent - && $element->parent->parent - && $element->parent->parent->parent - && $element->parent->parent->parent->first_element eq 'PGML::Format2' - && is_function_call($element->parent->parent->parent->first_element) - && $element->parent->parent->parent->parent - && $element->parent->parent->parent->parent->parent - && $element->parent->parent->parent->parent->parent->first_element =~ /^(STATEMENT|HINT|SOLUTION)$/ - && is_function_call($element->parent->parent->parent->parent->parent->first_element); - return; -} - -1; - -__END__ - -=head1 NAME - -Perl::Critic::Policy::PG::EncouragePGMLUsages - All problems should use PGML to -insert problem text. - -=head1 DESCRIPTION - -All problems should use PGML via C/C, -C/C, or -C/C blocks to insert problem text, -instead of the older C/C, C/C, or -C/C blocks. The PGML syntax is much easier to read -for other problem authors looking at the code, and PGML helps to ensure that -many text elements (for example images and tables) are inserted correctly for -recent requirements for accessibility. - -=cut diff --git a/lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm b/lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm deleted file mode 100644 index 79b1cb878..000000000 --- a/lib/Perl/Critic/Policy/PG/EncourageQualityMacroUsage.pm +++ /dev/null @@ -1,100 +0,0 @@ -package Perl::Critic::Policy::PG::EncourageQualityMacroUsage; -use Mojo::Base 'Perl::Critic::Policy', -signatures; - -use Perl::Critic::Utils qw(:severities :classification :ppi); - -use constant DESCRIPTION => '%s is used from the macro %s'; -use constant EXPLANATION => '%s is a high quality macro whose usage is encouraged.'; - -# FIXME: A better explanation is needed. Perhaps instead of a single explanation for all macros, add an explanation key -# to each of the methods below and give an explanation specific to the method and macro used. - -use constant METHODS => { - AnswerHints => { macro => 'answerHints.pl', score => 10 }, - CheckboxList => { macro => 'parserCheckboxList.pl', score => 10 }, - createLaTeXImage => { macro => 'PGlateximage.pl', score => 10 }, - createTikZImage => { macro => 'PGtikz.pl', score => 10 }, - DataTable => { macro => 'niceTables.pl', score => 10 }, - DraggableProof => { macro => 'draggableProof.pl', score => 10 }, - DraggableSubset => { macro => 'draggableSubset.pl', score => 10 }, - DropDown => { macro => 'parserPopUp.pl', score => 10 }, - Graph3D => { macro => 'plotly3D.pl', score => 10 }, - GraphTool => { marco => 'parserGraphTool.pl', score => 10 }, - LayoutTable => { macro => 'niceTables.pl', score => 10 }, - MultiAnswer => { macro => 'parserMultiAnswer.pl', score => 30 }, - Plots => { macro => 'plots.pl', score => 10 }, - RadioButtons => { macro => 'parserRadioButtons.pl', score => 10 }, - RadioMultiAnswer => { macro => 'parserRadioMultiAnswer.pl', score => 30 }, - randomLastName => { macro => 'randomPerson.pl', score => 10 }, - randomPerson => { macro => 'randomPerson.pl', score => 10 }, - 'Scaffold::Begin' => { macro => 'scaffold.pl', score => 20 } -}; - -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 METHODS->{$element} && is_function_call($element); - return $self->violation(sprintf(DESCRIPTION, $element, METHODS->{$element}{macro}), - { score => METHODS->{$element}{score}, explanation => sprintf(EXPLANATION, METHODS->{$element}{macro}) }, - $element); -} - -1; - -__END__ - -=head1 NAME - -Perl::Critic::Policy::PG::EncourageQualityMacroUsage - Usage of macros that are -well maintained and provide advanced MathObject answers is encouraged. - -=head1 DESCRIPTION - -Usage of macros that are well maintained and provide advanced MathObject answers -is encouraged. This policy currently recognizes the usage of the following -macros: - -=over - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=item * L - -=back - -=cut diff --git a/lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm b/lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm deleted file mode 100644 index abe694486..000000000 --- a/lib/Perl/Critic/Policy/PG/EncourageSolutionsAndHints.pm +++ /dev/null @@ -1,61 +0,0 @@ -package Perl::Critic::Policy::PG::EncourageSolutionsAndHints; -use Mojo::Base 'Perl::Critic::Policy', -signatures; - -use Perl::Critic::Utils qw(:severities :classification :ppi); - -use constant DESCRIPTION => 'A %s is included'; -use constant EXPLANATION => { - solution => 'A solution should be added to all problems.', - hint => 'A hint is helpful for students.' -}; -use constant SCORE => { solution => 15, hint => 10 }; - -sub supported_parameters ($) {return} -sub default_severity ($) { return $SEVERITY_HIGHEST } -sub default_themes ($) { return qw(pg) } -sub applies_to ($) { return qw(PPI::Token::HereDoc) } - -sub violates ($self, $element, $) { - if ( - $element->terminator =~ /^END_(PGML_)?(SOLUTION|HINT)/ - && $element->parent - && $element->parent->parent - && $element->parent->parent->parent - && ($element->parent->parent->parent->first_element eq 'PGML::Format2' - || $element->parent->parent->parent->first_element eq 'EV3P') - && is_function_call($element->parent->parent->parent->first_element) - && $element->parent->parent->parent->parent - && $element->parent->parent->parent->parent->parent - && $element->parent->parent->parent->parent->parent->first_element =~ /^(HINT|SOLUTION)$/ - && is_function_call($element->parent->parent->parent->parent->parent->first_element) - ) - { - my $type = lc($1); - return $self->violation( - sprintf(DESCRIPTION, $type), - { score => SCORE->{$type}, explanation => EXPLANATION->{$type} }, - $element->parent->parent->parent->parent->parent - ); - } - return; -} - -1; - -__END__ - -=head1 NAME - -Perl::Critic::Policy::PG::EncourageSolutionsAndHints - Solutions should be -provided in all problems, and hints are helpful for students. - -=head1 DESCRIPTION - -All problems should provide solutions that demonstrate how to work the problem, -and which do not just give the answers to the problem. - -Hints are helpful for students that are struggling with the concepts presented -in the problem, and it is recommended that hints be added particularly for more -difficult problems. - -=cut diff --git a/lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm b/lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm index 2176f8422..ee2e300b9 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitBeginproblem.pm @@ -7,7 +7,7 @@ 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; +use constant SCORE => 5; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm b/lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm index 4487c616e..309ee1a83 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitContextStrings.pm @@ -7,7 +7,7 @@ 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; +use constant SCORE => 5; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm index 21ec89d42..4af90b468 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedCmp.pm @@ -5,7 +5,7 @@ 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 SCORE => 55; use constant CMP_METHODS => { str_cmp => 1, diff --git a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm index 38e051bb3..27bbd2651 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMacros.pm @@ -7,7 +7,7 @@ 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; +use constant SCORE => 10; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm index d7667be8e..bc3834446 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitDeprecatedMultipleChoice.pm @@ -7,7 +7,7 @@ use WeBWorK::PG::Critic::Utils qw(getDeprecatedMacros); use constant DESCRIPTION => 'The deprecated %s function is called'; use constant EXPLANATION => 'The deprecated %s function should be replaced with a modern alternative.'; -use constant SCORE => -20; +use constant SCORE => 20; use constant SAMPLE_PROBLEMS => [ [ 'Multiple Choice with Checkbox' => 'Misc/MultipleChoiceCheckbox' ], [ 'Multiple Choice with Popup' => 'Misc/MultipleChoicePopup' ], diff --git a/lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm b/lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm index 9f240628f..0267989b3 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitEnddocumentMatter.pm @@ -5,7 +5,7 @@ use Perl::Critic::Utils qw(:severities :classification :ppi); use constant DESCRIPTION => 'There is content after the ENDDOCUMENT call'; use constant EXPLANATION => 'Remove this content. The ENDDOCUMENT call should be at the end of the problem.'; -use constant SCORE => -5; +use constant SCORE => 5; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm b/lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm index 734fd74ef..437951b0d 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitGraphMacros.pm @@ -7,7 +7,7 @@ use WeBWorK::PG::Critic::Utils qw(getDeprecatedMacros); use constant DESCRIPTION => 'The init_graph function from PGgraphmacros.pl is called'; use constant EXPLANATION => 'PGgraphmacros.pl generates poor quality graphics. Consider using a modern alternative.'; -use constant SCORE => -20; +use constant SCORE => 20; use constant SAMPLE_PROBLEMS => [ [ 'TikZ Graph Images' => 'ProblemTechniques/TikZImages' ], [ 'Inserting Images in PGML' => 'ProblemTechniques/Images' ], diff --git a/lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm b/lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm index b680bbf55..6dd18ca2e 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitMultipleLoadMacrosCalls.pm @@ -5,7 +5,7 @@ use Perl::Critic::Utils qw(:severities :classification :ppi); use constant DESCRIPTION => 'loadMacros is called multiple times'; use constant EXPLANATION => 'Consolidate multiple loadMacros calls into a single call.'; -use constant SCORE => -20; +use constant SCORE => 20; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/ProhibitOldText.pm b/lib/Perl/Critic/Policy/PG/ProhibitOldText.pm index ca37c3098..b46ccbe8e 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitOldText.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitOldText.pm @@ -6,7 +6,7 @@ use Perl::Critic::Utils qw(:severities :classification :ppi); use constant DESCRIPTION => 'A BEGIN_%1$s/END_%1$s block is used for problem text'; use constant EXPLANATION => 'Load the macro PGML.pl and replace the BEGIN_%1$s/END_%1$s ' . 'block with a BEGIN_PGML%2$s/END_PGML%2$s block.'; -use constant SCORE => -10; +use constant SCORE => 20; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm b/lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm index 51252dc6f..2faac1d9f 100644 --- a/lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm +++ b/lib/Perl/Critic/Policy/PG/ProhibitUnnecessarilySettingShowPartialCorrectAnswers.pm @@ -8,7 +8,7 @@ use WeBWorK::PG::Critic::Utils qw(getDeprecatedMacros); use constant DESCRIPTION => '$showPartialCorrectAnswers is set to 1'; use constant EXPLANATION => 'The value of $showPartialCorrectAnswers is 1 by default, ' . 'so it should only ever be set to 0 to change the value.'; -use constant SCORE => -5; +use constant SCORE => 5; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm b/lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm index e538b409a..7fbc02657 100644 --- a/lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm +++ b/lib/Perl/Critic/Policy/PG/RequireImageAltAttribute.pm @@ -7,7 +7,7 @@ use WeBWorK::PG::Critic::Utils qw(parsePGMLBlock parseTextBlock); use constant DESCRIPTION => 'An image is missing the alt attribute'; use constant EXPLANATION => 'Add an alt attribute that describes the image content.'; -use constant SCORE => -10; +use constant SCORE => 10; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/Perl/Critic/Policy/PG/RequireMetadata.pm b/lib/Perl/Critic/Policy/PG/RequireMetadata.pm index 799f859e6..ab081f9df 100644 --- a/lib/Perl/Critic/Policy/PG/RequireMetadata.pm +++ b/lib/Perl/Critic/Policy/PG/RequireMetadata.pm @@ -5,7 +5,7 @@ use Perl::Critic::Utils qw(:severities :classification :ppi); use constant DESCRIPTION => 'The %s metadata tag is required'; use constant EXPLANATION => 'Include the required metadata tags at the beginning of the problem file.'; -use constant SCORE => -5; +use constant SCORE => 5; use constant REQUIRED_METADATA => [ 'DBsubject', 'DBchapter', 'DBsection', 'KEYWORDS' ]; sub supported_parameters ($) {return} diff --git a/lib/Perl/Critic/Policy/PG/RequireSolution.pm b/lib/Perl/Critic/Policy/PG/RequireSolution.pm index 937be8bf1..eb14e1a64 100644 --- a/lib/Perl/Critic/Policy/PG/RequireSolution.pm +++ b/lib/Perl/Critic/Policy/PG/RequireSolution.pm @@ -5,7 +5,7 @@ use Perl::Critic::Utils qw(:severities :classification :ppi); use constant DESCRIPTION => 'A solution is not included in this problem'; use constant EXPLANATION => 'A solution should be included in all problems.'; -use constant SCORE => -15; +use constant SCORE => 25; sub supported_parameters ($) {return} sub default_severity ($) { return $SEVERITY_HIGHEST } diff --git a/lib/WeBWorK/PG/Critic.pm b/lib/WeBWorK/PG/Critic.pm index a235fc541..35742f7d7 100644 --- a/lib/WeBWorK/PG/Critic.pm +++ b/lib/WeBWorK/PG/Critic.pm @@ -11,24 +11,22 @@ Analyze a pg file for use of old and current methods. =head2 critiquePGCode - my $results = critiquePGCode($code, $force = 0); + my @violations = critiquePGCode($code, $force = 0); Parses and critiques the given PG problem source provided in C<$code>. An array -of "violations" that are found is returned. Note that the elements of this -return array are L objects. However, not all of these -"violations" are bad. Some are actually noting good things that are used in the -source code for the problem. The C method can be called for each -element, and that will either return a string or a reference to a hash. The -string return type will occur for a violation of a default L -policy. The last return type will occur with a C -policy, and the hash will contain a C key and an C key -containing the actual explanation. If the C is positive, then it is not -actually a violation, but something good. In some cases the C -return hash will also contain the key C which will be a -reference to an array each of whose entries will be a reference to a two element -array whose first element is the title of a sample problem and whose second -element is the path for that sample problem where the sample problem -demonstrates a way to fix the policy violation. +of violations that are found is returned. Note that the elements of this return +array are L objects. The C method can be +called for each element, and that will either return a string or a reference to +a hash. The string return type will occur for a violation of a default +L policy. The last return type will occur with a +C policy, and the hash will contain a C key and +an C key containing the actual explanation. Note that the greater +the score, the worse the violation is. In some cases the C return +hash will also contain the key C which will be a reference to an +array each of whose entries will be a reference to a two element array whose +first element is the title of a sample problem and whose second element is the +path for that sample problem where the sample problem demonstrates a way to fix +the policy violation. Note that C<## no critic> annotations can be used in the code to disable a violation for a line or the entire file. See L<"BENDING THE @@ -38,10 +36,10 @@ policies are enforced regardless. =head2 critiquePGFile - my $results = critiquePGFile($file, $force); + my @violations = critiquePGFile($file, $force); This just executes C on the contents of C<$file> and returns -the result. +the violations found. =cut package WeBWorK::PG::Critic; From 196e096343ec4d47c85bacf15a82df2ae566b00f Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 16 Jul 2025 07:16:52 -0500 Subject: [PATCH 4/6] Add a "--pg-only" ("-p" for short) option to the `bin/pg-critic.pl` script. If this option is set, only PG critic policy violations (those in the `Perl::Critic::Policy::PG` namespace) are shown and scored, and general Perl critic policies are ignored. --- bin/pg-critic.pl | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/bin/pg-critic.pl b/bin/pg-critic.pl index 6e8ab7c4c..2c4431d95 100755 --- a/bin/pg-critic.pl +++ b/bin/pg-critic.pl @@ -20,6 +20,9 @@ =head1 SYNOPSIS 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 @@ -47,6 +50,7 @@ =head1 DESCRIPTION '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; @@ -82,6 +86,7 @@ (@violations) for (@ARGV) { my @violations = critiquePGFile($_, $force); + @violations = grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ } @violations if $pgOnly; my (@pgCriticViolations, @perlCriticViolations); if (!$noDetails) { @@ -96,7 +101,10 @@ (@violations) score => scoreProblem(@violations), $noDetails ? () - : (pgCriticViolations => \@pgCriticViolations, perlCriticViolations => \@perlCriticViolations) + : ( + @pgCriticViolations ? (pgCriticViolations => \@pgCriticViolations) : (), + @perlCriticViolations ? (perlCriticViolations => \@perlCriticViolations) : () + ) } ); } From 2db6e22ac1033ab585057854cf07cb52aa80386d Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 16 Jul 2025 07:49:14 -0500 Subject: [PATCH 5/6] Switch to a better approach to using `PGML::Parse`. This is much more minimal. --- lib/WeBWorK/PG/Critic.pm | 2 ++ lib/WeBWorK/PG/Critic/Utils.pm | 24 +++++++----------------- 2 files changed, 9 insertions(+), 17 deletions(-) diff --git a/lib/WeBWorK/PG/Critic.pm b/lib/WeBWorK/PG/Critic.pm index 35742f7d7..0a656d494 100644 --- a/lib/WeBWorK/PG/Critic.pm +++ b/lib/WeBWorK/PG/Critic.pm @@ -49,6 +49,8 @@ use Mojo::File qw(path); use PPI; use Perl::Critic; +require WeBWorK::PG::Translator; + our @EXPORT_OK = qw(critiquePGFile critiquePGCode); sub critiquePGCode ($code, $force = 0) { diff --git a/lib/WeBWorK/PG/Critic/Utils.pm b/lib/WeBWorK/PG/Critic/Utils.pm index a0e1f005d..a36e32275 100644 --- a/lib/WeBWorK/PG/Critic/Utils.pm +++ b/lib/WeBWorK/PG/Critic/Utils.pm @@ -61,7 +61,7 @@ use Env qw(PG_ROOT); use lib curfile->dirname->dirname->dirname->dirname->dirname->child('lib'); -require WeBWorK::PG::Translator; +require Value; our @EXPORT_OK = qw(getDeprecatedMacros parsePGMLBlock parseTextBlock); @@ -74,7 +74,12 @@ sub getDeprecatedMacros () { { map { $_->basename => 1 } @{ path($PG_ROOT)->child('macros', 'deprecated')->list } }; } +# Mock methods used by PGML. sub main::PG_restricted_eval ($code) { return $code; } +sub main::loadMacros(@macros) { return; } +sub main::Context() { return; } + +do "$PG_ROOT/macros/core/PGML.pl"; sub walkPGMLTree ($block, $results //= {}) { for my $item (@{ $block->{stack} }) { @@ -103,22 +108,7 @@ sub parsePGMLBlock (@lines) { my $sourceHash = md5_sum(encode('UTF-8', $source)); return $processedBlocks{$sourceHash} if defined $processedBlocks{$sourceHash}; - package main; ## no critic (Modules::ProhibitMultiplePackages) - - require WeBWorK::PG::Environment; - require WeBWorK::PG; - require PGcore; - require Parser; - - $WeBWorK::PG::IO::pg_envir = WeBWorK::PG::Environment->new; - %main::envir = %{ WeBWorK::PG::defineProblemEnvironment($WeBWorK::PG::IO::pg_envir) }; - - do "$ENV{PG_ROOT}/macros/PG.pl"; - - $main::PG = $main::PG = PGcore->new(\%main::envir); - loadMacros('PGML.pl'); - - $PGML::warningsFatal = $PGML::warningsFatal = 1; + PGML::ClearWarnings(); my $parser = eval { PGML::Parse->new($source =~ s/\\\\/\\/gr) }; return { errors => [$@] } if $@; From be1aac20d4934bcb05503661e9ec51d8bae7ce03 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 16 Jul 2025 08:59:16 -0500 Subject: [PATCH 6/6] Add warnings to the return data of the `parsePGMLBlock` method. --- lib/WeBWorK/PG/Critic/Utils.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lib/WeBWorK/PG/Critic/Utils.pm b/lib/WeBWorK/PG/Critic/Utils.pm index a36e32275..425233aea 100644 --- a/lib/WeBWorK/PG/Critic/Utils.pm +++ b/lib/WeBWorK/PG/Critic/Utils.pm @@ -31,6 +31,9 @@ blocks found. If the PGML content or a block within fails to parse, then the return hash will contain the key C with a reference to an array of errors that occurred. +Also if there are any warnings that occur in the parsing, those will be in the +C key of the return hash. + =head2 parseTextBlock my $textElements = parseTextBlock(@lines); @@ -110,9 +113,10 @@ sub parsePGMLBlock (@lines) { PGML::ClearWarnings(); my $parser = eval { PGML::Parse->new($source =~ s/\\\\/\\/gr) }; - return { errors => [$@] } if $@; + return { errors => [$@], warnings => \@PGML::warnings } if $@; - return $processedBlocks{$sourceHash} = WeBWorK::PG::Critic::Utils::walkPGMLTree($parser->{root}); + return $processedBlocks{$sourceHash} = + WeBWorK::PG::Critic::Utils::walkPGMLTree($parser->{root}, { warnings => \@PGML::warnings }); } # For now, only contents of \{ .. \} blocks are returned. Add other text elements as needed.