Return to errdb.pl CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / ipxe / contrib / errdb

Annotation of qemu/roms/ipxe/contrib/errdb/errdb.pl, revision 1.1

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.