|
2 | 2 |
|
3 | 3 | =head1 NAME
|
4 | 4 |
|
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. |
6 | 6 |
|
7 | 7 | =head1 SYNOPSIS
|
8 | 8 |
|
9 | 9 | pg-critic.pl [options] file1 file2 ...
|
10 | 10 |
|
11 | 11 | Options:
|
12 | 12 |
|
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. |
22 | 24 |
|
23 | 25 | =head1 DESCRIPTION
|
24 | 26 |
|
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. |
36 | 31 |
|
37 | 32 | =cut
|
38 | 33 |
|
39 |
| -use strict; |
40 |
| -use warnings; |
41 |
| -use experimental 'signatures'; |
42 |
| -use feature 'say'; |
| 34 | +use Mojo::Base -signatures; |
43 | 35 |
|
44 |
| -use Mojo::File qw(curfile); |
45 |
| -use Mojo::Util qw(dumper); |
| 36 | +use Mojo::File qw(curfile path); |
46 | 37 | use Mojo::JSON qw(encode_json);
|
47 | 38 | use Getopt::Long;
|
48 | 39 | use Pod::Usage;
|
49 | 40 |
|
50 | 41 | use lib curfile->dirname->dirname . '/lib';
|
51 | 42 |
|
52 |
| -use WeBWorK::PG::PGProblemCritic qw(analyzePGfile); |
| 43 | +use WeBWorK::PG::Critic qw(critiquePGFile); |
53 | 44 |
|
54 |
| -my ($verbose, $show_score, $details, $show_help) = (0, 1, 0, 0); |
55 |
| -my ($format, $filename) = ('text', ''); |
56 | 45 | 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 |
63 | 51 | );
|
64 |
| -pod2usage(2) if $show_help || !$show_score; |
| 52 | +pod2usage(2) if $show_help; |
65 | 53 |
|
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'; |
68 | 55 |
|
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); |
76 | 57 |
|
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 | +} |
117 | 66 |
|
118 |
| -sub scoreProblem ($prob) { |
| 67 | +sub scoreProblem (@violations) { |
119 | 68 | 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 | + } |
124 | 78 | return $score;
|
125 | 79 | }
|
126 | 80 |
|
127 |
| -my @scores; |
| 81 | +my @results; |
128 | 82 |
|
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); |
136 | 85 |
|
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; |
147 | 93 | }
|
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); |
151 | 140 | }
|
152 | 141 |
|
153 | 142 | 1;
|
0 commit comments