contrib/errdb/errdb.pl

   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();