Skip to content

Commit 77fc3c1

Browse files
drgrice1drgrice1
committed
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 openwebwork#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.
1 parent f70a8da commit 77fc3c1

23 files changed

+1371
-431
lines changed

‎bin/pg-critic.pl‎

Lines changed: 101 additions & 112 deletions
Original file line numberDiff line numberDiff line change
@@ -2,152 +2,141 @@
22

33
=head1 NAME
44
5-
pg-critic.pl -- Analyze a pg file for use of old and current methods.
5+
pg-critic.pl - Command line interface to critque PG problem code.
66
77
=head1 SYNOPSIS
88
99
pg-critic.pl [options] file1 file2 ...
1010
1111
Options:
1212
13-
-s|--score Give a score for each file.
14-
-f|--format Format of the output. Default ('text') is a plain text listing of the filename
15-
and the score. 'JSON' will make a JSON file.
16-
For output format 'JSON', the filename output must also be assigned,
17-
however for 'text', the output is optional.
18-
-o|--output-file Filename for the output. Note: this is required if JSON is the output format.
19-
-d|--details Include the details in the output. (Only used if the format is JSON).
20-
-v|--verbose Increase the verbosity of the output.
21-
-h|--help Show the help message.
13+
-f|--format Format of the output, either 'text' or 'json'.
14+
'text' is the default and will output a plain text
15+
listing of the results. 'json' will output results in
16+
JavaScript Object Notation.
17+
-o|--output-file Filename to write output to. If not provided output will
18+
be printed to STDOUT.
19+
-n|--no-details Only show the filename and score and do not include the
20+
details in the output for each file.
21+
-s|--strict Disable "## no critic" annotations and force all
22+
policies to be enforced.
23+
-h|--help Show the help message.
2224
2325
=head1 DESCRIPTION
2426
25-
This script analyzes the input files for old/deprecated functions and macros as well
26-
as features for current best practices features.
27-
28-
See L<PGProblemCritic.pm> for details on what features are determined presence.
29-
30-
=head1 OPTIONS
31-
32-
The option C<-v> or C<--verbose> gives more information (on STDOUT) as the
33-
script is run.
34-
35-
The option C<-s> or C<--score> will return a score for each given PG problem.
27+
C<pg-critic.pl> is a PG problem source code analyzer. It is the executable
28+
front-end to the L<WeBWorK::PG::Critic> module, which attempts to identify
29+
usage of old or deprecated PG features, as well as usage of newer features and
30+
current best practices in coding a problem.
3631
3732
=cut
3833

39-
use strict;
40-
use warnings;
41-
use experimental 'signatures';
42-
use feature 'say';
34+
use Mojo::Base -signatures;
4335

44-
use Mojo::File qw(curfile);
45-
use Mojo::Util qw(dumper);
36+
use Mojo::File qw(curfile path);
4637
use Mojo::JSON qw(encode_json);
4738
use Getopt::Long;
4839
use Pod::Usage;
4940

5041
use lib curfile->dirname->dirname . '/lib';
5142

52-
use WeBWorK::PG::PGProblemCritic qw(analyzePGfile);
43+
use WeBWorK::PG::Critic qw(critiquePGFile);
5344

54-
my ($verbose, $show_score, $details, $show_help) = (0, 1, 0, 0);
55-
my ($format, $filename) = ('text', '');
5645
GetOptions(
57-
's|score' => \$show_score,
58-
'f|format=s' => \$format,
59-
'o|output-file=s' => \$filename,
60-
'd|details' => \$details,
61-
"v|verbose" => \$verbose,
62-
'h|help' => \$show_help
46+
'f|format=s' => \my $format,
47+
'o|output-file=s' => \my $filename,
48+
'n|no-details' => \my $noDetails,
49+
's|strict' => \my $force,
50+
'h|help' => \my $show_help
6351
);
64-
pod2usage(2) if $show_help || !$show_score;
52+
pod2usage(2) if $show_help;
6553

66-
die 'arguments must have a list of pg files' unless @ARGV > 0;
67-
die "The output format must be 'text' or 'JSON'" if (scalar(grep { $_ eq $format } qw(text JSON)) == 0);
54+
$format //= 'text';
6855

69-
my $output_file;
70-
unless ($format eq 'text' && $filename eq '') {
71-
die "The output-file is required if using the format: $format" if $filename eq '';
72-
$output_file = Mojo::File->new($filename);
73-
my $dir = $output_file->dirname->realpath;
74-
die "The output directory $dir does not exist or is not a directory" unless -d $dir->to_string;
75-
}
56+
$format = lc($format);
7657

77-
# Give a problem an assessment score:
78-
79-
my $rubric = {
80-
metadata => -5, # score for each missing required metadta
81-
good => {
82-
PGML => 20,
83-
solution => 30,
84-
hint => 10,
85-
scaffold => 50,
86-
custom_checker => 50,
87-
multianswer => 30,
88-
answer_hints => 20,
89-
nicetable => 10,
90-
contexts => { base_n => 10, units => 10, boolean => 10, reaction => 10 },
91-
parsers => { radio_buttons => 10, checkbox_list => 10, radio_multianswer => 10, graph_tool => 10 },
92-
macros => {
93-
random_person => 10,
94-
plots => 10,
95-
tikz => 10,
96-
plotly3D => 10,
97-
latex_image => 10,
98-
scaffold => 10,
99-
answer_hints => 10,
100-
}
101-
},
102-
bad => {
103-
BEGIN_TEXT => -10,
104-
beginproblem => -5,
105-
oldtable => -25,
106-
num_cmp => -75,
107-
str_cmp => -75,
108-
fun_cmp => -75,
109-
context_texstrings => -5,
110-
multiple_loadmacros => -20,
111-
showPartialCorrect => -5,
112-
lines_below_enddocument => -5,
113-
macros => { ww_plot => -20, PGchoicemacros => -20 }
114-
},
115-
deprecated_macros => -10
116-
};
58+
unless (@ARGV) {
59+
say 'A list of pg problem files must be provided.';
60+
pod2usage(2);
61+
}
62+
unless ($format eq 'text' || $format eq 'json') {
63+
say 'The output format must be "text" or "json"';
64+
pod2usage(2);
65+
}
11766

118-
sub scoreProblem ($prob) {
67+
sub scoreProblem (@violations) {
11968
my $score = 0;
120-
$score += (1 - $prob->{metadata}{$_}) * $rubric->{metadata} for (keys %{ $prob->{metadata} });
121-
$score += $prob->{good}{$_} * $rubric->{good}{$_} for (keys %{ $prob->{good} });
122-
$score += $prob->{bad}{$_} * $rubric->{bad}{$_} for (keys %{ $prob->{bad} });
123-
$score += $rubric->{deprecated_macros} for (@{ $prob->{deprecated_macros} });
69+
for (@violations) {
70+
if ($_->policy =~ /^Perl::Critic::Policy::PG::/) {
71+
$score += $_->explanation->{score} // 0;
72+
} else {
73+
# Deduct 5 points for any of the default Perl::Critic::Policy violations.
74+
# These will not have a score in the explanation.
75+
$score -= 5;
76+
}
77+
}
12478
return $score;
12579
}
12680

127-
my @scores;
81+
my @results;
12882

129-
for (grep { $_ =~ /\.pg$/ } @ARGV) {
130-
say $_ if $verbose;
131-
my $features = analyzePGfile($_);
132-
my $file_info = { file => $_, score => scoreProblem($features) };
133-
$file_info->{details} = $features if $details;
134-
push(@scores, $file_info);
135-
}
83+
for (@ARGV) {
84+
my @violations = critiquePGFile($_, $force);
13685

137-
if ($format eq 'text') {
138-
my $output_str = '';
139-
for my $score (@scores) {
140-
$output_str .= "filename: $score->{file}; score: $score->{score}\n";
141-
}
142-
if ($filename eq '') {
143-
say $output_str;
144-
} else {
145-
$output_file->spew($output_str);
146-
say "Results written in text format to $output_file" if $verbose;
86+
my (@positivePGResults, @negativePGResults, @perlCriticResults);
87+
if (!$noDetails) {
88+
@positivePGResults =
89+
grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ && $_->explanation->{score} > 0 } @violations;
90+
@negativePGResults =
91+
grep { $_->policy =~ /^Perl::Critic::Policy::PG::/ && $_->explanation->{score} < 0 } @violations;
92+
@perlCriticResults = grep { $_->policy !~ /^Perl::Critic::Policy::PG::/ } @violations;
14793
}
148-
} elsif ($format eq 'JSON') {
149-
$output_file->spew(encode_json(\@scores));
150-
say "Results written in JSON format to $output_file" if $verbose;
94+
95+
push(
96+
@results,
97+
{
98+
file => $_,
99+
score => scoreProblem(@violations),
100+
$noDetails
101+
? ()
102+
: (
103+
positivePGResults => \@positivePGResults,
104+
negativePGResults => \@negativePGResults,
105+
perlCriticResults => \@perlCriticResults
106+
)
107+
}
108+
);
109+
}
110+
111+
Perl::Critic::Violation::set_format('%m at line %l, column %c. (%p)');
112+
113+
my $outputMethod = $format eq 'json' ? \&encode_json : sub {
114+
my $results = shift;
115+
116+
return join(
117+
"\n",
118+
map { (
119+
"filename: $_->{file}",
120+
"score: $_->{score}",
121+
@{ $_->{positivePGResults} // [] }
122+
? ('positive pg critic results:', map { "\t" . $_->to_string } @{ $_->{positivePGResults} })
123+
: (),
124+
@{ $_->{negativePGResults} // [] }
125+
? ('negative pg critic results:', map { "\t" . $_->to_string } @{ $_->{negativePGResults} })
126+
: (),
127+
@{ $_->{perlCriticResults} // [] }
128+
? ('perl critic results:', map { "\t" . $_->to_string } @{ $_->{perlCriticResults} })
129+
: ()
130+
) } @$results
131+
);
132+
};
133+
134+
if ($filename) {
135+
eval { path($filename)->spew($outputMethod->(\@results), 'UTF-8') };
136+
if ($@) { say "Unable to write results to $filename: $@"; }
137+
else { say "Results written in $format format to $filename"; }
138+
} else {
139+
say $outputMethod->(\@results);
151140
}
152141

153142
1;

‎cpanfile‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,12 @@ on runtime => sub {
2424

2525
# Needed for Rserve
2626
recommends 'IO::Handle';
27+
28+
# Needed for WeBWorK::PG::Tidy
29+
recommends 'Perl::Tidy';
30+
31+
# Needed for WeBWorK::PG::PGProblemCritic
32+
recommends 'Perl::Critic';
2733
};
2834

2935
on test => sub {

‎lib/Perl/Critic/Policy/PG/EncourageCustomCheckers.pm‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
package Perl::Critic::Policy::PG::EncourageCustomCheckers;
2+
use Mojo::Base 'Perl::Critic::Policy', -signatures;
3+
4+
use Perl::Critic::Utils qw(:severities :classification :ppi);
5+
6+
use constant DESCRIPTION => 'A custom checker is utilized';
7+
use constant EXPLANATION => 'Custom checkers demonstrate a high level of sophistication in problem coding.';
8+
use constant SCORE => 50;
9+
10+
sub supported_parameters ($) {return}
11+
sub default_severity ($) { return $SEVERITY_HIGHEST }
12+
sub default_themes ($) { return qw(pg) }
13+
sub applies_to ($) { return qw(PPI::Token::Word) }
14+
15+
use Mojo::Util qw(dumper);
16+
17+
# FIXME: This misses some important cases. For example, answer checking can also be performed in a post filter. In
18+
# fact that demonstrates an even higher level of sophistication than using a checker in some senses. It is more
19+
# complicated to use correctly, and can work around type limitations imposed on MathObject checkers. However, there is
20+
# no reliable way to determine what a post filter is in a problem for, as there are other reasons to add a post filter.
21+
sub violates ($self, $element, $document) {
22+
return unless $element eq 'checker' || $element eq 'list_checker';
23+
return $self->violation(DESCRIPTION, { score => SCORE, explanation => EXPLANATION }, $element);
24+
}
25+
26+
1;
27+
28+
__END__
29+
30+
=head1 NAME
31+
32+
Perl::Critic::Policy::PG::EncourageCustomCheckers - Custom checkers demonstrate
33+
a high level of sophistication in problem coding.
34+
35+
=head1 DESCRIPTION
36+
37+
Utilization of a custom checker in a problem demonstrates a high level of
38+
sophistication in coding a problem. Custom checkers can be used to supplement
39+
default MathObject checkers in several ways. For example, to award partial
40+
credit and display more meaningful messages for answers that are not entirely
41+
correct
42+
43+
=cut

‎lib/Perl/Critic/Policy/PG/EncourageModernContextUsage.pm‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
package Perl::Critic::Policy::PG::EncourageModernContextUsage;
2+
use Mojo::Base 'Perl::Critic::Policy', -signatures;
3+
4+
# FIXME: Is this policy really a good idea? Why are these contexts so special? Just because they are newer? Many of the
5+
# contexts that have been around for a long time are actually better than some of these, and some of them are more
6+
# complicated to use and demonstrate a higher level of sophistication than these.
7+
8+
use Perl::Critic::Utils qw(:severities :classification :ppi);
9+
10+
use constant DESCRIPTION => 'The context %s is used from the macro %s';
11+
use constant EXPLANATION => '%s is a modern context whose usage demonstrates currency in problem authoring.';
12+
13+
use constant CONTEXTS => {
14+
BaseN => { macro => 'contextBaseN.pl', score => 10 },
15+
Boolean => { macro => 'contextBoolean.pl', score => 10 },
16+
Reaction => { macro => 'contextReaction.pl', score => 10 },
17+
Units => { macro => 'contextUnits.pl', score => 10 }
18+
};
19+
20+
sub supported_parameters ($) {return}
21+
sub default_severity ($) { return $SEVERITY_HIGHEST }
22+
sub default_themes ($) { return qw(pg) }
23+
sub applies_to ($) { return qw(PPI::Token::Word) }
24+
25+
sub violates ($self, $element, $document) {
26+
return unless $element eq 'Context' && is_function_call($element);
27+
my $context = first_arg($element);
28+
return $self->violation(
29+
sprintf(DESCRIPTION, $context->string, CONTEXTS->{ $context->string }{macro}),
30+
{
31+
score => CONTEXTS->{ $context->string }{score},
32+
explanation => sprintf(EXPLANATION, CONTEXTS->{ $context->string }{macro})
33+
},
34+
$context
35+
) if $context && CONTEXTS->{ $context->string };
36+
return;
37+
}
38+
39+
1;
40+
41+
__END__
42+
43+
=head1 NAME
44+
45+
Perl::Critic::Policy::PG::EncourageModernContextUsage - Usage of recently
46+
created contexts demonstrates currency in problem authoring.
47+
48+
=head1 DESCRIPTION
49+
50+
Usage of recently created contexts demonstrates currency in problem authoring.
51+
Currently this policy encourages the use of the following contexts:
52+
53+
=over
54+
55+
=item * L<contextBaseN.pl>
56+
57+
=item * L<contextBoolean.pl>
58+
59+
=item * L<contextReaction.pl>
60+
61+
=item * L<contextUnits.pl>
62+
63+
=back
64+
65+
=cut

0 commit comments

Comments
 (0)