summaryrefslogtreecommitdiffstats
path: root/contrib/errdb/errdb.pl
blob: 6423d83476c56900ce48e7a2d349cfaf881fd747 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
#!/usr/bin/perl -w

=head1 NAME

errdb.pl

=head1 SYNOPSIS

errdb.pl [options] ../../src/bin/errors

Options:

    -d,--database=db	Specify path to errors.db
    -h,--help		Display brief help message
    -v,--verbose	Increase verbosity
    -q,--quiet		Decrease verbosity

=cut

use Getopt::Long;
use Pod::Usage;
use DBI;
use strict;
use warnings;

# Parse command-line options
my $verbosity = 0;
my $errdb = "errors.db";
Getopt::Long::Configure ( 'bundling', 'auto_abbrev' );
GetOptions (
  'database|d=s' => sub { shift; $errdb = shift; },
  'verbose|v+' => sub { $verbosity++; },
  'quiet|q+' => sub { $verbosity--; },
  'help|h' => sub { pod2usage ( 1 ); },
) or die "Could not parse command-line options\n";
pod2usage ( 1 ) unless @ARGV >= 1;

# Open database
my $dbh = DBI->connect ( "dbi:SQLite:dbname=".$errdb, "", "",
			 { RaiseError => 1, PrintError => 0 } );
$dbh->begin_work();

# Create errors table if necessary
eval {
  $dbh->selectall_arrayref ( "SELECT * FROM errors LIMIT 1" );
};
if ( $@ ) {
  print "Creating errors table\n" if $verbosity >= 1;
  $dbh->do ( "CREATE TABLE errors (".
	     " errno char(8) NOT NULL,".
	     " description text NOT NULL,".
	     " PRIMARY KEY ( errno ) )" );
}

# Create xrefs table if necessary
eval {
  $dbh->selectall_arrayref ( "SELECT * FROM xrefs LIMIT 1" );
};
if ( $@ ) {
  print "Creating xrefs table\n" if $verbosity >= 1;
  $dbh->do ( "CREATE TABLE xrefs (".
	     " errno char(8) NOT NULL,".
	     " filename text NOT NULL,".
	     " line integer NOT NULL,".
	     " UNIQUE ( errno, filename, line ),".
	     " FOREIGN KEY ( errno ) REFERENCES errors ( errno ) )" );
  $dbh->do ( "CREATE INDEX xrefs_errno ON xrefs ( errno )" );
}

# Parse input file(s)
my $errors = {};
my $xrefs = {};
while ( <> ) {
  chomp;
  ( my $errno, my $filename, my $line, my $description ) = split ( /\t/ );
  $errno = substr ( $errno, 0, 6 ) unless $errno =~ /^7f/;
  $errors->{$errno} = $description;
  $xrefs->{$errno} ||= {};
  $xrefs->{$errno}->{$filename} ||= {};
  $xrefs->{$errno}->{$filename}->{$line} ||= 1;
}

# Ensure all errors are present in database
my $error_update =
    $dbh->prepare ( "UPDATE errors SET description = ? WHERE errno = ?" );
my $error_insert = $dbh->prepare ( "INSERT INTO errors VALUES ( ?, ? )" );
while ( ( my $errno, my $description ) = each %$errors ) {
  print "Error ".$errno." is \"".$description."\"\n" if $verbosity >= 2;
  if ( $error_update->execute ( $description, $errno ) == 0 ) {
    $error_insert->execute ( $errno, $description );
  }
}

# Replace xrefs in database
$dbh->do ( "DELETE FROM xrefs" );
my $xref_insert = $dbh->prepare ( "INSERT INTO xrefs VALUES ( ?, ?, ? )" );
while ( ( my $errno, my $xref_errno ) = each %$xrefs ) {
  while ( ( my $filename, my $xref_filename ) = each %$xref_errno ) {
    foreach my $line ( keys %$xref_filename ) {
      print "Error ".$errno." is used at ".$filename." line ".$line."\n"
	  if $verbosity >= 2;
      $xref_insert->execute ( $errno, $filename, $line );
    }
  }
}

# Close database
$dbh->commit();
$dbh->disconnect();