Annotation of qemu/roms/ipxe/contrib/errdb/errdb.pl, revision 1.1.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();

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.