errors-migrate.pl 2.47 KB
Newer Older
Kevin Atkinson's avatar
 
Kevin Atkinson committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
#!/usr/bin/perl -w

use strict;

use DBI;

my $database = 'tbdb';
my $username = 'root';
my $passwd = '';

my $dbh = DBI->connect("DBI:mysql:database=$database", $username, $passwd);

my $sth = $dbh->prepare("select * from scripts");
$sth->execute;
my %script_map;
my @script_map;
while ((my $ref = $sth->fetchrow_arrayref)) {
   $script_map{$ref->[1]} = $ref->[0];
   $script_map[$ref->[0]] = $ref->[1];
}
$script_map{unknown} = 0;
$script_map[0] = 'unknown';

$sth = $dbh->prepare("select stamp,session,exptidx,mesg from log where type = 'thecause' order by session");
$sth->execute;

my $sth2 = $dbh->prepare("select script_name,cause,type from log natural join scripts where session = ? and relevant order by seq desc");

my $ins = $dbh->prepare("insert into errors (session,stamp,exptidx,script,cause,confidence,mesg) values (?,?,?,?,?,?,?)");

my $ready = 0;

while ((my $ref = $sth->fetchrow_arrayref)) {
  my ($stamp,$session,$exptidx,$mesg) = @$ref;
  my $script = "unknown";
  my $cause = "unknown";
  my $confidence = 0.0;
  local $_ = $mesg;
  if (/^\d+: ([^:]+)/) {
    $script = $1;
  } else {
    if (s/\nCause: (\S+)\nConfidence: (\S+)$//) {
      $cause = $1;
      $confidence = $2;
    }
    s/^  //gm;
    $mesg = $_;
    ($_) = split /\n\s*\n/;
    if (/\(([^\)]+)\)$/ && defined $script_map{$1}) {
      $script = $1;
    } else {
      warn "Unable to find script in: $_\n" unless /No clue as to what went wrong/;
    }
    $sth2->execute($session);
    my @rel;
    while ((my $r = $sth2->fetchrow_hashref)) {
      push @rel, {%$r};
    }

    if (@rel) {

      warn "Script name mismatch: $rel[0]{script_name} ne $script in: $_\n" 
	if $rel[0]{script_name} ne $script;

      $script = $rel[0]{script_name};

      my $conf = 0.5;
      if ($script =~ /^(assign|parse)/) {
	$conf = 0.9;
      } elsif ($script =~ /^(os_setup)/) {
	$conf = 0.2;
      }

      my $t = '';
      my $c = '';
      foreach (@rel) {
	$ready = 1 if $_->{cause} && $_->{cause} ne 'unknown';
	if (!$c && $_->{cause}) {
	  $c = $_->{cause};
	  $t = $_->{type};
	} elsif ($_->{cause} &&
		 $_->{type} eq $t && $_->{cause} ne $c) {
	  $c = 'unknown';
	}
      }
      $c = 'unknown' unless $c;

      if ($cause eq 'unknown' && $ready) {
	$cause = $c;
	$confidence = $conf;
      } elsif ($cause ne 'unknown') {
	warn "Cause mismatch" unless $cause eq $c;
	warn "Confidence mismatched" unless $conf == $confidence;
      }
    }
  }

  $ins->execute($session,$stamp,$exptidx,$script_map{$script},$cause,$confidence,$mesg);
}