Login
Clean up some self-compliance issues now that MagicNumbers
[gknop/Perl-Critic.git] / examples / loadanalysisdb
CommitLineData
81f23a94
ES
1#!/usr/bin/perl
2
3##############################################################################
4# $URL$
5# $Date$
6# $Author$
7# $Revision$
81f23a94
ES
8##############################################################################
9
daa9dc42 10## no critic (ErrorHandling::RequireUseOfExceptions)
81f23a94
ES
11use 5.008001;
12use strict;
13use warnings;
14
ee0fa298 15use version; our $VERSION = qv('1.002');
81f23a94
ES
16
17use Carp qw{ croak };
18use English qw{ -no_match_vars };
19use Readonly;
20
21use DBI qw{ :sql_types };
22use File::Spec qw{ };
23use Perl6::Say;
24
25use Perl::Critic::Utils qw{ all_perl_files policy_short_name $EMPTY };
26use Perl::Critic;
27
28
29if ( ! @ARGV ) {
30 die qq{usage: loadanalysisdb path [...]\n};
31}
32
33main();
34
35exit 0;
36
37
38sub main {
39 say 'Connecting to database.';
40 say;
41
42 my $database_connection = connect_to_database();
43 my $insert_statement = prepare_insert_statement($database_connection);
44
45 foreach my $path ( @ARGV ) {
46 say "Looking at $path.";
47
48 my @files = all_perl_files($path);
49 say 'Analyzing ', scalar @files, ' files.';
50
51 load( \@files, File::Spec->canonpath($path), $insert_statement );
52
53 say; say;
54 }
55
56 say 'Disconnecting from database.';
57 say;
58
59 close_insert_statement($insert_statement);
60 # Need to do this or DBI emits warning at disconnect
61 $insert_statement = undef;
62
63 disconnect_from_database($database_connection);
64
65 say 'Done.';
66 say;
67
68 return;
69}
70
71
72sub load {
73 my ( $files, $path, $insert_statement ) = @_;
74
75 # Force reporting level to be really strict, just so that the database
76 # has everything.
77 my $critic = Perl::Critic->new( -severity => 1 );
78
79 foreach my $file ( @{$files} ) {
80 my $relative_path;
81
82 if ($file eq $path) {
83 $relative_path = $file;
84 } else {
85 my $absolute_path_length = ( length $path ) + 1;
86
87 $relative_path = substr $file, $absolute_path_length;
88 }
89
90 say "Processing $relative_path.";
91
92 foreach my $violation ( $critic->critique($file) ) {
93 my ($line, $column) = @{ $violation->location() };
94
95 execute_insert_statement(
96 $insert_statement,
97 $relative_path,
98 $line,
99 $column,
100 $violation->severity(),
101 policy_short_name( $violation->policy() ),
102 $violation->explanation(),
103 $violation->source(),
104 );
105 }
106 }
107
108 return;
109}
110
111
112sub connect_to_database {
113 my $database_file_name = 'perl_critic_analysis.sqlite';
114
115 my $database_connection =
116 DBI->connect(
117 "dbi:SQLite:dbname=$database_file_name",
118 $EMPTY, # login
119 $EMPTY, # password
120 {
121 AutoCommit => 1, # In real life, this should be 0
122 RaiseError => 1,
123 }
124 );
125
126 defined $database_connection or
127 croak "Could not connect to $database_file_name.";
128
129 return $database_connection;
130}
131
132
133sub prepare_insert_statement {
134 my ( $database_connection ) = @_;
135
136 my $insert_statement =
137 $database_connection->prepare(<<'END_SQL');
138 INSERT INTO
139 violation
140 (
141 file_path,
142 line_number,
143 column_number,
144 severity,
145 policy,
146 explanation,
147 source_code
148 )
149 VALUES
150 (?, ?, ?, ?, ?, ?, ?)
151END_SQL
152
153
154 # The following values are bogus-- these statements are simply to tell
155 # the driver what the parameter types are so that we can use execute()
156 # without calling bind_param() each time. See "Binding Values Without
379bd376 157 # bind_param()" on pages 126-7 of "Programming the Perl DBI".
29e94807
ES
158
159 ## no critic (ProhibitMagicNumbers)
81f23a94
ES
160 $insert_statement->bind_param( 1, 'x', SQL_VARCHAR);
161 $insert_statement->bind_param( 2, 1, SQL_INTEGER);
162 $insert_statement->bind_param( 3, 1, SQL_INTEGER);
163 $insert_statement->bind_param( 4, 1, SQL_INTEGER);
164 $insert_statement->bind_param( 5, 'x', SQL_VARCHAR);
165 $insert_statement->bind_param( 6, 'x', SQL_VARCHAR);
29e94807
ES
166 $insert_statement->bind_param( 7, 'x', SQL_VARCHAR);
167 ## use critic
81f23a94
ES
168
169 return $insert_statement;
170}
171
172
c6e19b74 173sub execute_insert_statement { ##no critic(ProhibitManyArgs)
81f23a94
ES
174 my (
175 $statement,
176 $file_path,
177 $line_number,
178 $column_number,
179 $severity,
180 $policy,
181 $explanation,
182 $source_code,
183 )
184 = @_;
185
186 $statement->execute(
187 $file_path,
188 $line_number,
189 $column_number,
190 $severity,
191 $policy,
192 $explanation,
193 $source_code,
194 );
195
196 return;
197}
198
199
200sub close_insert_statement {
201 my ( $insert_statement ) = @_;
202
203 $insert_statement->finish();
204
205 return;
206}
207
208sub disconnect_from_database {
209 my ( $database_connection ) = @_;
210
211 $database_connection->disconnect();
212
213 return;
214}
215
216
217__END__
218
219=pod
220
ee0fa298
ES
221=for stopwords SQLite analyses
222
81f23a94
ES
223=head1 NAME
224
225C<loadanalysisdb> - Critique a body of code and load the results into a database for later processing.
226
227
228=head1 USAGE
229
230 loadanalysisdb path [...]
231
232
233=head1 DESCRIPTION
234
235Scan a body of code and, rather than emit the results in a textual format, put
236them into a database so that analyses can be made.
237
379bd376
ES
238This example doesn't put anything into the database that isn't available from
239L<Perl::Critic::Violation> in order to keep the code easier to understand. In
240a full application of the idea presented here, one might want to include the
241current date and a distribution name in the database so that progress on
242cleaning up a code corpus can be tracked.
81f23a94
ES
243
244Note the explanation attribute of L<Perl::Critic::Violation> is constant for
245most policies, but some of them do provide more specific diagnostics of the
246code in question.
247
248
249=head1 REQUIRED ARGUMENTS
250
251A list of paths to files and directories to find code in.
252
253
254=head1 OPTIONS
255
256None.
257
258
259=head1 DIAGNOSTICS
260
261Errors from L<DBI>.
262
263
264=head1 EXIT STATUS
265
2660
267
268
269=head1 CONFIGURATION
270
271None.
272
273
274=head1 DEPENDENCIES
275
276L<Perl::Critic>
277L<DBD::SQLite>
278L<Perl6::Say>
279L<Readonly>
280
281An SQLite database named "perl_critic_analysis.sqlite" with the following
282schema:
283
284 CREATE TABLE violation (
285 file_path VARCHAR(1024),
286 line_number INTEGER,
287 column_number INTEGER,
288 severity INTEGER,
289 policy VARCHAR(512),
290 explanation TEXT,
291 source_code TEXT
292 )
293
294
295=head1 INCOMPATIBILITIES
296
297None reported.
298
299
300=head1 BUGS AND LIMITATIONS
301
302This is an example program and thus does minimal error handling.
303
304
305=head1 AUTHOR
306
307Elliot Shank C<< <perl@galumph.com> >>
308
309
ee0fa298 310=head1 COPYRIGHT
81f23a94
ES
311
312Copyright (c) 2006-2007, Elliot Shank C<< <perl@galumph.com> >>. All rights
313reserved.
314
315This module is free software; you can redistribute it and/or modify it under
316the same terms as Perl itself. See L<perlartistic>.
317
318
319=head1 DISCLAIMER OF WARRANTY
320
321BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
322SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
323STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
324SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
325INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
326FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
327PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
328YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
329
330IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
331COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
332SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES,
333INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
334OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
335LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
336THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER
337SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
338POSSIBILITY OF SUCH DAMAGES.
339
340=cut
341
342# Local Variables:
343# mode: cperl
344# cperl-indent-level: 4
345# fill-column: 78
346# indent-tabs-mode: nil
347# c-indentation-style: bsd
348# End:
349# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab :