|
|
1.1 root 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();
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.