|
@@ -0,0 +1,108 @@
|
|
1
|
+#!/usr/bin/perl -w
|
|
2
|
+
|
|
3
|
+=head1 NAME
|
|
4
|
+
|
|
5
|
+errdb.pl
|
|
6
|
+
|
|
7
|
+=head1 SYNOPSIS
|
|
8
|
+
|
|
9
|
+errdb.pl [options] ../../src/bin/errors
|
|
10
|
+
|
|
11
|
+Options:
|
|
12
|
+
|
|
13
|
+ -d,--database=db Specify path to errors.db
|
|
14
|
+ -h,--help Display brief help message
|
|
15
|
+ -v,--verbose Increase verbosity
|
|
16
|
+ -q,--quiet Decrease verbosity
|
|
17
|
+
|
|
18
|
+=cut
|
|
19
|
+
|
|
20
|
+use Getopt::Long;
|
|
21
|
+use Pod::Usage;
|
|
22
|
+use DBI;
|
|
23
|
+use strict;
|
|
24
|
+use warnings;
|
|
25
|
+
|
|
26
|
+# Parse command-line options
|
|
27
|
+my $verbosity = 0;
|
|
28
|
+my $errdb = "errors.db";
|
|
29
|
+Getopt::Long::Configure ( 'bundling', 'auto_abbrev' );
|
|
30
|
+GetOptions (
|
|
31
|
+ 'database|d=s' => sub { shift; $errdb = shift; },
|
|
32
|
+ 'verbose|v+' => sub { $verbosity++; },
|
|
33
|
+ 'quiet|q+' => sub { $verbosity--; },
|
|
34
|
+ 'help|h' => sub { pod2usage ( 1 ); },
|
|
35
|
+) or die "Could not parse command-line options\n";
|
|
36
|
+pod2usage ( 1 ) unless @ARGV >= 1;
|
|
37
|
+
|
|
38
|
+# Open database
|
|
39
|
+my $dbh = DBI->connect ( "dbi:SQLite:dbname=".$errdb, "", "",
|
|
40
|
+ { RaiseError => 1, PrintError => 0 } );
|
|
41
|
+$dbh->begin_work();
|
|
42
|
+
|
|
43
|
+# Create errors table if necessary
|
|
44
|
+eval {
|
|
45
|
+ $dbh->selectall_arrayref ( "SELECT * FROM errors LIMIT 1" );
|
|
46
|
+};
|
|
47
|
+if ( $@ ) {
|
|
48
|
+ print "Creating errors table\n" if $verbosity >= 1;
|
|
49
|
+ $dbh->do ( "CREATE TABLE errors (".
|
|
50
|
+ " errno char(8) NOT NULL,".
|
|
51
|
+ " description text NOT NULL,".
|
|
52
|
+ " PRIMARY KEY ( errno ) )" );
|
|
53
|
+}
|
|
54
|
+
|
|
55
|
+# Create xrefs table if necessary
|
|
56
|
+eval {
|
|
57
|
+ $dbh->selectall_arrayref ( "SELECT * FROM xrefs LIMIT 1" );
|
|
58
|
+};
|
|
59
|
+if ( $@ ) {
|
|
60
|
+ print "Creating xrefs table\n" if $verbosity >= 1;
|
|
61
|
+ $dbh->do ( "CREATE TABLE xrefs (".
|
|
62
|
+ " errno char(8) NOT NULL,".
|
|
63
|
+ " filename text NOT NULL,".
|
|
64
|
+ " line integer NOT NULL,".
|
|
65
|
+ " UNIQUE ( errno, filename, line ),".
|
|
66
|
+ " FOREIGN KEY ( errno ) REFERENCES errors ( errno ) )" );
|
|
67
|
+ $dbh->do ( "CREATE INDEX xrefs_errno ON xrefs ( errno )" );
|
|
68
|
+}
|
|
69
|
+
|
|
70
|
+# Parse input file(s)
|
|
71
|
+my $errors = {};
|
|
72
|
+my $xrefs = {};
|
|
73
|
+while ( <> ) {
|
|
74
|
+ chomp;
|
|
75
|
+ ( my $errno, my $filename, my $line, my $description ) = split ( /\t/ );
|
|
76
|
+ $errors->{$errno} = $description;
|
|
77
|
+ $xrefs->{$errno} ||= {};
|
|
78
|
+ $xrefs->{$errno}->{$filename} ||= {};
|
|
79
|
+ $xrefs->{$errno}->{$filename}->{$line} ||= 1;
|
|
80
|
+}
|
|
81
|
+
|
|
82
|
+# Ensure all errors are present in database
|
|
83
|
+my $error_update =
|
|
84
|
+ $dbh->prepare ( "UPDATE errors SET description = ? WHERE errno = ?" );
|
|
85
|
+my $error_insert = $dbh->prepare ( "INSERT INTO errors VALUES ( ?, ? )" );
|
|
86
|
+while ( ( my $errno, my $description ) = each %$errors ) {
|
|
87
|
+ print "Error ".$errno." is \"".$description."\"\n" if $verbosity >= 2;
|
|
88
|
+ if ( $error_update->execute ( $description, $errno ) == 0 ) {
|
|
89
|
+ $error_insert->execute ( $errno, $description );
|
|
90
|
+ }
|
|
91
|
+}
|
|
92
|
+
|
|
93
|
+# Replace xrefs in database
|
|
94
|
+$dbh->do ( "DELETE FROM xrefs" );
|
|
95
|
+my $xref_insert = $dbh->prepare ( "INSERT INTO xrefs VALUES ( ?, ?, ? )" );
|
|
96
|
+while ( ( my $errno, my $xref_errno ) = each %$xrefs ) {
|
|
97
|
+ while ( ( my $filename, my $xref_filename ) = each %$xref_errno ) {
|
|
98
|
+ foreach my $line ( keys %$xref_filename ) {
|
|
99
|
+ print "Error ".$errno." is used at ".$filename." line ".$line."\n"
|
|
100
|
+ if $verbosity >= 2;
|
|
101
|
+ $xref_insert->execute ( $errno, $filename, $line );
|
|
102
|
+ }
|
|
103
|
+ }
|
|
104
|
+}
|
|
105
|
+
|
|
106
|
+# Close database
|
|
107
|
+$dbh->commit();
|
|
108
|
+$dbh->disconnect();
|