Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.

errdb.pl 2.9KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108
  1. #!/usr/bin/perl -w
  2. =head1 NAME
  3. errdb.pl
  4. =head1 SYNOPSIS
  5. errdb.pl [options] ../../src/bin/errors
  6. Options:
  7. -d,--database=db Specify path to errors.db
  8. -h,--help Display brief help message
  9. -v,--verbose Increase verbosity
  10. -q,--quiet Decrease verbosity
  11. =cut
  12. use Getopt::Long;
  13. use Pod::Usage;
  14. use DBI;
  15. use strict;
  16. use warnings;
  17. # Parse command-line options
  18. my $verbosity = 0;
  19. my $errdb = "errors.db";
  20. Getopt::Long::Configure ( 'bundling', 'auto_abbrev' );
  21. GetOptions (
  22. 'database|d=s' => sub { shift; $errdb = shift; },
  23. 'verbose|v+' => sub { $verbosity++; },
  24. 'quiet|q+' => sub { $verbosity--; },
  25. 'help|h' => sub { pod2usage ( 1 ); },
  26. ) or die "Could not parse command-line options\n";
  27. pod2usage ( 1 ) unless @ARGV >= 1;
  28. # Open database
  29. my $dbh = DBI->connect ( "dbi:SQLite:dbname=".$errdb, "", "",
  30. { RaiseError => 1, PrintError => 0 } );
  31. $dbh->begin_work();
  32. # Create errors table if necessary
  33. eval {
  34. $dbh->selectall_arrayref ( "SELECT * FROM errors LIMIT 1" );
  35. };
  36. if ( $@ ) {
  37. print "Creating errors table\n" if $verbosity >= 1;
  38. $dbh->do ( "CREATE TABLE errors (".
  39. " errno char(8) NOT NULL,".
  40. " description text NOT NULL,".
  41. " PRIMARY KEY ( errno ) )" );
  42. }
  43. # Create xrefs table if necessary
  44. eval {
  45. $dbh->selectall_arrayref ( "SELECT * FROM xrefs LIMIT 1" );
  46. };
  47. if ( $@ ) {
  48. print "Creating xrefs table\n" if $verbosity >= 1;
  49. $dbh->do ( "CREATE TABLE xrefs (".
  50. " errno char(8) NOT NULL,".
  51. " filename text NOT NULL,".
  52. " line integer NOT NULL,".
  53. " UNIQUE ( errno, filename, line ),".
  54. " FOREIGN KEY ( errno ) REFERENCES errors ( errno ) )" );
  55. $dbh->do ( "CREATE INDEX xrefs_errno ON xrefs ( errno )" );
  56. }
  57. # Parse input file(s)
  58. my $errors = {};
  59. my $xrefs = {};
  60. while ( <> ) {
  61. chomp;
  62. ( my $errno, my $filename, my $line, my $description ) = split ( /\t/ );
  63. $errors->{$errno} = $description;
  64. $xrefs->{$errno} ||= {};
  65. $xrefs->{$errno}->{$filename} ||= {};
  66. $xrefs->{$errno}->{$filename}->{$line} ||= 1;
  67. }
  68. # Ensure all errors are present in database
  69. my $error_update =
  70. $dbh->prepare ( "UPDATE errors SET description = ? WHERE errno = ?" );
  71. my $error_insert = $dbh->prepare ( "INSERT INTO errors VALUES ( ?, ? )" );
  72. while ( ( my $errno, my $description ) = each %$errors ) {
  73. print "Error ".$errno." is \"".$description."\"\n" if $verbosity >= 2;
  74. if ( $error_update->execute ( $description, $errno ) == 0 ) {
  75. $error_insert->execute ( $errno, $description );
  76. }
  77. }
  78. # Replace xrefs in database
  79. $dbh->do ( "DELETE FROM xrefs" );
  80. my $xref_insert = $dbh->prepare ( "INSERT INTO xrefs VALUES ( ?, ?, ? )" );
  81. while ( ( my $errno, my $xref_errno ) = each %$xrefs ) {
  82. while ( ( my $filename, my $xref_filename ) = each %$xref_errno ) {
  83. foreach my $line ( keys %$xref_filename ) {
  84. print "Error ".$errno." is used at ".$filename." line ".$line."\n"
  85. if $verbosity >= 2;
  86. $xref_insert->execute ( $errno, $filename, $line );
  87. }
  88. }
  89. }
  90. # Close database
  91. $dbh->commit();
  92. $dbh->disconnect();