Skip to content

Commit 4ed2649

Browse files
pstaabppstaabp
committed
Initial checkin of PG critic script.
1 parent b35f650 commit 4ed2649

File tree

2 files changed

+371
-0
lines changed

2 files changed

+371
-0
lines changed

‎bin/pg-critic.pl

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
#!/usr/bin/env perl
2+
3+
=head1 NAME
4+
5+
pg-critic.pl -- Analyze a pg file for use of old and current methods.
6+
7+
=head1 SYNOPSIS
8+
9+
pg-critic.pl [options] file1 file2 ...
10+
11+
=head1 DESCRIPTION
12+
13+
This script analyzes the input files for old/deprecated functions and macros as well
14+
as features for current best practices features.
15+
16+
See L<PGProblemCritic.pm> for details on what features are determined presence.
17+
18+
=head1 OPTIONS
19+
20+
The option C<-v> or C<--verbose> gives more information (on STDOUT) as the
21+
script is run.
22+
23+
The option C<-s> or C<--score> will return a score for each given PG problem.
24+
25+
=cut
26+
27+
use strict;
28+
use warnings;
29+
use experimental 'signatures';
30+
use feature 'say';
31+
32+
use Mojo::File qw(curfile);
33+
use Getopt::Long;
34+
use Data::Dumper;
35+
36+
use lib curfile->dirname->dirname . '/lib';
37+
38+
use WeBWorK::PG::PGProblemCritic qw(analyzePGfile);
39+
40+
my $verbose = 0;
41+
my $score = 0;
42+
GetOptions(
43+
"v|verbose" => \$verbose,
44+
's|score' => \$score
45+
);
46+
47+
die 'arguments must have a list of pg files' unless @ARGV > 0;
48+
49+
# Give a problem an assessment score:
50+
51+
my $rubric = {
52+
metadata => -5,
53+
good => {
54+
PGML => 20,
55+
solution => 30,
56+
hint => 10,
57+
scaffold => 50,
58+
custom_checker => 50,
59+
multianswer => 30,
60+
answer_hints => 20,
61+
nicetable => 10,
62+
},
63+
bad => {
64+
BEGIN_TEXT => -10,
65+
beginproblem => -5,
66+
oldtable => -25,
67+
num_cmp => -75,
68+
str_cmp => -75,
69+
fun_cmp => -75,
70+
context_texstrings => -5,
71+
multiple_loadmacros => -20,
72+
showPartialCorrect => -5,
73+
old_multiple_choice => -20,
74+
lines_below_enddocument => -5,
75+
},
76+
deprecated_macros => -10
77+
};
78+
79+
sub scoreProblem ($prob) {
80+
my $score = 0;
81+
$score += (1-$prob->{metadata}{$_})*$rubric->{metadata} for (keys %{$prob->{metadata}});
82+
$score += $prob->{good}{$_}*$rubric->{good}{$_} for (keys %{$prob->{good}});
83+
$score += $prob->{bad}{$_}*$rubric->{bad}{$_} for (keys %{$prob->{bad}});
84+
$score += $rubric->{deprecated_macros} for (@{$prob->{deprecated_macros}});
85+
return $score;
86+
}
87+
88+
for (grep { $_ =~ /\.pg$/ } @ARGV) {
89+
say $_ if $verbose;
90+
my $features = analyzePGfile($_);
91+
# print Dumper $features if $verbose;
92+
if ($score) {
93+
print Dumper scoreProblem($features) if $verbose;
94+
}
95+
}
96+
97+
1;

‎lib/WeBWorK/PG/PGProblemCritic.pm

Lines changed: 274 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,274 @@
1+
package WeBWorK::PG::PGProblemCritic;
2+
use parent qw(Exporter);
3+
4+
use strict;
5+
use warnings;
6+
use experimental 'signatures';
7+
use feature 'say';
8+
9+
use Mojo::File qw(curfile);
10+
use Data::Dumper;
11+
12+
our @EXPORT_OK = qw(analyzePGfile analyzePGcode getDeprecatedMacros);
13+
14+
=head1 NAME
15+
16+
PGProblemCritic - Parse a PG program and analyze the contents for good and bad features.
17+
18+
=head1 DESCRIPTION
19+
20+
Analyze a pg file for use of old and current methods.
21+
22+
=over
23+
24+
=item C<deprecated_macros>: a list of the macros that the problem uses that is in the C<macros/deprecated>
25+
folder.
26+
27+
=item Positive features:
28+
29+
=over 10
30+
31+
=item Uses PGML
32+
33+
=item Provides a solution
34+
35+
=item Provides a hint
36+
37+
=item Uses Scaffolds
38+
39+
=item Uses a custom checker
40+
41+
=item Uses a multianswer
42+
43+
=item Uses answer hints
44+
45+
=item Uses nicetables
46+
47+
=back
48+
49+
=item Old and deprecated features
50+
51+
=over 10
52+
53+
=item Use of BEGIN_TEXT/END_TEXT
54+
55+
=item Include the C<TEXT(beginproblem)>
56+
57+
=item Include old tables (for example from C<unionTables.pl>)
58+
59+
=item The use of C<num_cmp>, C<str_cmp> and C<fun_cmp> in lieu of using MathObjects
60+
61+
=item Including C<< Context()->TeXStrings >>
62+
63+
=item Calling C<loadMacros> more than once.
64+
65+
=item Using the line C< $showPartialCorrectAnswers = 1 > which is the default behavior and thus unnecessary.
66+
67+
=item Using methods from C<PGchoicemacros.pl>
68+
69+
=item Inlcuding code or other text below the C<ENDDOCUMENT();> line indicating the end of the problem.
70+
71+
=back
72+
73+
=back
74+
75+
76+
=cut
77+
78+
sub analyzePGcode ($code) {
79+
# default flags for presence of features in a PG problem
80+
my $features = {
81+
metadata => { DBsubject => 0, DBchapter => 0, DBsection => 0, KEYWORDS => 0 },
82+
good => {
83+
PGML => 0,
84+
solution => 0,
85+
hint => 0,
86+
scaffold => 0,
87+
custom_checker => 0,
88+
multianswer => 0,
89+
answer_hints => 0,
90+
nicetable => 0,
91+
},
92+
bad => {
93+
BEGIN_TEXT => 0,
94+
beginproblem => 0,
95+
oldtable => 0,
96+
num_cmp => 0,
97+
str_cmp => 0,
98+
fun_cmp => 0,
99+
context_texstrings => 0,
100+
multiple_loadmacros => 0,
101+
showPartialCorrect => 0,
102+
old_multiple_choice => 0,
103+
lines_below_enddocument => 0,
104+
},
105+
deprecated_macros => [],
106+
macros => []
107+
};
108+
109+
# Get a list of all deprecated macros.
110+
my $all_deprecated_macros = getDeprecatedMacros(curfile->dirname->dirname->dirname->dirname);
111+
112+
# determine if the loadMacros has been parsed.
113+
my $loadmacros_parsed = 0;
114+
115+
my @pglines = split /\n/, $code;
116+
my $line = '';
117+
while (1) {
118+
$line = shift @pglines;
119+
# print Dumper $line;
120+
last unless defined($line); # end of the file.
121+
next if $line =~ /^\s*$/; # skip any blank lines.
122+
123+
# Determine if some of the metadata tags are present.
124+
for (qw(DBsubject DBchapter DBsection KEYWORDS)) {
125+
$features->{metadata}{$_} = 1 if $line =~ /$_\(/i;
126+
}
127+
128+
# Skip any full-line comments.
129+
next if $line =~ /^\s*#/;
130+
131+
$features->{good}{solution} = 1 if $line =~ /BEGIN_(PGML_)?SOLUTION/;
132+
$features->{good}{hint} = 1 if $line =~ /BEGIN_(PGML_)?HINT/;
133+
134+
# Analyze the loadMacros info.
135+
if ($line =~ /loadMacros\(/) {
136+
$features->{bad}{multiple_loadmacros} = 1 if $loadmacros_parsed == 1;
137+
$loadmacros_parsed = 1;
138+
# Parse the macros, which may be on multiple rows.
139+
my $macros = $line;
140+
while ($line && $line !~ /\);\s*$/) {
141+
$line = shift @pglines;
142+
143+
# Strip any comments at the end of lines.
144+
$line =~ s/(.*)#.*/$1/;
145+
$macros .= $line;
146+
}
147+
# Split by commas and pull out the quotes.
148+
# TODO: handle cases with loadMacros(qw/macro1.pl macro2.pl/);
149+
my @macros = map {s/['"\s]//gr} split(/\s*,\s*/, $macros =~ s/loadMacros\((.*)\)\;$/$1/r);
150+
$features->{macros} = \@macros;
151+
for my $macro (@macros) {
152+
push(@{ $features->{deprecated_macros} }, $macro) if (grep { $macro eq $_ } @$all_deprecated_macros);
153+
}
154+
} elsif ($line =~ /BEGIN_PGML(_SOLUTION|_HINT)?/) {
155+
$features->{good}{PGML} = 1;
156+
my @pgml_lines;
157+
while (1) {
158+
$line = shift @pglines;
159+
last if $line =~ /END_PGML(_SOLUTON|_HINT)?/;
160+
push(@pgml_lines, $line);
161+
}
162+
163+
my $pgml_features = analyzePGMLBlock(@pgml_lines);
164+
$features->{bad}{missing_alt_tag} = 1 if $pgml_features->{missing_alt_tag};
165+
}
166+
167+
if ($line =~ /ENDDOCUMENT/) { # scan if there are any lines below the ENDDOCUMENT
168+
169+
do {
170+
$line = shift @pglines;
171+
last unless defined($line);
172+
$features->{bad}{lines_below_enddocument} = 1 if $line !~ /^\s*$/;
173+
} while (defined($line));
174+
}
175+
176+
# Check for bad features.
177+
$features->{bad}{beginproblem} = 1 if $line =~ /beginproblem\(\)/;
178+
$features->{bad}{BEGIN_TEXT} = 1 if $line =~ /(BEGIN_(TEXT|HINT|SOLUTION))|EV[23]/;
179+
$features->{bad}{context_texstrings} = 1 if $line =~ /->(texStrings|normalStrings)/;
180+
for (qw(num str fun)) {
181+
$features->{bad}{ $_ . '_cmp' } = 1 if $line =~ /${_}_cmp\(/;
182+
}
183+
$features->{bad}{oldtable} = 1 if $line =~ /BeginTable/i;
184+
$features->{bad}{showPartialCorrect} = 1 if $line =~ /\$showPartialCorrectAnswers\s=\s1/;
185+
$features->{bad}{old_multiple_choice} = 1
186+
if $line =~ /new_checkbox_multiple_choice/
187+
|| $line =~ /new_match_list/
188+
|| $line =~ /new_select_list/
189+
|| $line =~ /new_multiple_choice/
190+
|| $line =~ /qa\s\(/;
191+
192+
# check for good features
193+
$features->{good}{scaffold} = 1 if $line =~ /Scaffold::Begin/;
194+
$features->{good}{answer_hints} = 1 if $line =~ /AnswerHints/;
195+
$features->{good}{multianswer} = 1 if $line =~ /MultiAnswer/;
196+
$features->{good}{custom_checker} = 1 if $line =~ /checker =>/;
197+
$features->{good}{nicetables} = 1 if $line =~ /DataTable|LayoutTable/;
198+
199+
}
200+
return $features;
201+
}
202+
203+
# Return a list of the macro filenames in the 'macros/deprecated' directory.
204+
sub getDeprecatedMacros ($pgroot) {
205+
return Mojo::File->new($pgroot)->child('macros/deprecated')->list->map(sub { $_->basename })->to_array;
206+
}
207+
208+
sub analyzePGfile ($file) {
209+
my $path = Mojo::File->new($file);
210+
die "The file: $file does not exist or is not readable" unless -r $path;
211+
212+
return analyzePGcode($path->slurp);
213+
}
214+
215+
# Parse a string that is a function in the form of "funct($arg1, $arg2, ..., param1 => val1, param2 => val2 , ...)"
216+
# A hashref of the form {_args = [$arg1, $arg2, ...], param1 => val1, param2 => val2} is returned.
217+
218+
sub parseFunctionString($string) {
219+
220+
my ($funct, $args);
221+
if ($string =~ /(\w+)\(\s*(.*)\)/) {
222+
($funct, $args) = ($1, $2);
223+
} else {
224+
return ();
225+
}
226+
227+
my @args = split(/,\s/, $args);
228+
229+
my %params = (_name => $funct, _args => []);
230+
for (@args) {
231+
if ($_ !~ /=>/) {
232+
push(@{ $params{_args} }, $_);
233+
} else {
234+
if ($_ =~ /(\w+)\s*=>\s*["']?([^"]*)["']?/) {
235+
my ($key, $value) = ($1, $2);
236+
$params{$key} = $value;
237+
}
238+
}
239+
}
240+
return %params;
241+
}
242+
243+
# Perform some analysis of a PGML block.
244+
245+
sub analyzePGMLBlock(@lines) {
246+
my $pgml_features = {};
247+
248+
while (1) {
249+
my $line = shift @lines;
250+
last unless defined($line);
251+
252+
# If there is a perl block analyze [@ @]
253+
if ($line =~ /\[@/) {
254+
my $perl_line = $line;
255+
while ($perl_line !~ /@\]/) {
256+
$line = shift @lines;
257+
$perl_line .= $line;
258+
}
259+
my ($perlcode) = $perl_line =~ /\[@\s*(.*)\s*@\]/;
260+
261+
my %funct_info = parseFunctionString($perlcode);
262+
if (%funct_info && $funct_info{_name} =~ /image/) {
263+
if (defined($funct_info{extra_html_tags}) && $funct_info{extra_html_tags} !~ /alt/) {
264+
$pgml_features->{missing_alt_tag} = 1;
265+
}
266+
}
267+
268+
} elsif (my ($alt_text) = $line =~ /\[!(.*)!\]/) {
269+
$pgml_features->{missing_alt_tag} = 1 if $alt_text =~ /^\s$/;
270+
}
271+
272+
}
273+
return $pgml_features;
274+
}

0 commit comments

Comments
 (0)