#!/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 = <ZLOG>) {
    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);

