#!/usr/bin/perl use strict; use warnings; use YAML; use File::Basename; use Net::CouchDb; use Data::UUID; use DateTime::Format::Strptime; my $strp = DateTime::Format::Strptime->new(pattern => "%a %b %d %T %Y"); my $wiggle = DateTime::Duration->new( seconds => 10 ); my $realm = "ATHENA.MIT.EDU"; my $seq = 0; my $host = 'localhost'; my $port = 5984; my $whichdb = 'messages'; my $cdb = Net::CouchDb->new(host => $host, port => $port); my $db = $cdb->db($whichdb); my $uuid = Data::UUID->new; sub parse_log { my $class = shift; my $file = shift; open(ZLOG, $file) or die "Can't open $file: $!"; local $/ = "\n\n"; my $lasttime; my $in_zsig; my %msg; while (my $line = ) { if ($in_zsig) { $line =~ /^(.*?)(?:\s*<([\w\.]+(?:@[\w\.-]+)?)>)?\n\n$/s; $msg{zsig} .= $1; if ($2) { $msg{sender} = $2; $in_zsig = 0; } else { $msg{zsig} .= "\n\n"; $in_zsig = 1; } next; } if ($line =~ /^Class: (\S+) Instance: (.*?)(?: Opcode: ([^\n]+))?\nTime: (.*?) Host: (\S+)\nFrom: (.*?)(?: <([\w\.-]+(?:@[\w\.-]+)?)>)?\n\n$/s) { my $sent = $strp->parse_datetime($4); if (lc $1 ne lc $class and $class ne "weird") { warn "Quoting other class: $1 vs $class\n"; undef $sent; } elsif (defined $lasttime and not ($lasttime <= $sent->clone->add( seconds => 30))) { warn "Time warp: $lasttime then $sent\n"; } if ($sent) { $lasttime = $sent; process_msg(\%msg); %msg = (); @msg{qw/class instance opcode time host zsig sender/} = ($1, $2, $3, $sent->datetime, lc $5, $6, $7); unless ($7) { $msg{zsig} .= "\n\n"; $in_zsig = 1; } next; } } # warn "Possibly misparsed header: $line\n" # if exists $msg{body} and $line =~ /^Class:/; $line =~ s/\n\n$//; $msg{body} = (exists $msg{body} ? "$msg{body}\n\n$line" : $line); } process_msg(\%msg); } sub process_msg { my $msg = shift; return unless scalar keys %$msg; if($msg->{sender} !~ /@/) { $msg->{sender} .= '@'.$realm; } $msg->{type} = 'zephyr'; $msg->{seq} = $seq++; my $doc = Net::CouchDb::Document->new; while(my ($k, $v) = each %$msg) { $doc->$k = $v; } $doc->type = 'zephyr'; $doc->id = $uuid->create_str(); $db->put($doc); } my $file = shift; my $class = shift || basename($file); print "Parsing class $class from $file...\n"; parse_log($class, $file);