#!/usr/bin/perl

use strict;
use warnings;
use DateTime;
use Digest::SHA1 qw(sha1_hex);
use Data::Dumper;

my $attdirbase     = '/home/nathan/dump/trac-bak/files/attachments';
my $atttargetdir   = '/var/www/bugzilla/data/attachments';
my $wikibase       = '/var/www/nethack-stuff/tracwikidump';
my $commenthistory = 0;

my $epoch = DateTime->new( year => 1970, month => 1, day => 1, hour => 0);
do "db_mysql.pl";

print "Enter Trac DB password:\n";
my $tracpw = <STDIN>; chomp $tracpw;
print "Enter Bugzilla DB password:\n";
my $bugspw = <STDIN>; chomp $bugspw;

$dbconfig::host = 'localhost';
sub bz {
  my ($function) = @_;
  local $dbconfig::database = 'bugs';
  local $dbconfig::user     = 'bugs';
  local $dbconfig::password = $bugspw;
  return $function->();
}
sub trac {
  my ($function) = @_;
  local $dbconfig::database = 'Trac';
  local $dbconfig::user     = 'tracdb';
  local $dbconfig::password = $tracpw;
  return $function->();
}

my @ticket  = trac(sub { getrecord('ticket'); });
my @component = bz(sub { getrecord('components')});
my @severity  = bz(sub { getrecord('bug_severity')});

my @att = map {
  my $a = $_;
  my ($basefn, $ext) = $$a{filename} =~ /(.*?)([.]\w+)?$/;
  $$a{hashedfn} = sha1_hex($basefn) . $ext;
  $a;
} trac(sub {getrecord('attachment'); });

print "Found " . @ticket . " tickets.\n";

my %versionmap = (
                  "4.3tip"        => "master branch",
                  "4.3beta1"      => "4.3 beta1",
                  "4.3beta2"      => "4.3 beta2",
                  "3.5leak"       => "unspecified",
                  ""              => "unspecified",
                  "fourk-4.3.0.1" => "4.3.0.1",
                 );
my %milestonemap = (
                    "NULL"                  => "untriaged",
                    "4.4 Release"           => "4.4",
                    "4.3 maintenance"       => "4.3 maintenance",
                    "The Far-Flung Future"  => "The Far Flung Future",
                    "4.3 beta 1"            => "4.3 beta 1",
                    "4.3 beta 2"            => "4.3 beta 2",
                    "4.3 beta 3"            => "4.3 beta 3",
                    "",                     => "untriaged",
                   );
my %statusmap = (
                 new      =>  'UNCONFIRMED',
                 assigned =>  'CONFIRMED',
                 accepted =>  'IN_PROGRESS',
                 closed   =>  'RESOLVED',
                 # Trac doesn't have a VERIFIED
                reopened =>  'REOPENED',
                );
my %resolutionmap = (
                     NULL       => 1,
                     ""         => 1,
                     fixed      => 2,
                     invalid    => 3,
                     wontfix    => 4,
                     duplicate  => 5,
                     worksforme => 6,
                    );
for my $t (@ticket) {
  my $prio = undef; {
    if ($$t{type} =~ /YANI/i) {
      $prio = 'YANI';
    } elsif ($$t{type} =~ /enhancement/i) {
      $prio = 'Enhancement';
    } else {
      $prio = ucfirst $$t{priority};
    }
  }
  my ($comp)  = grep { $$_{name} eq $$t{component} } @component;
  my ($sev)   = grep { (lc $$_{value}) eq (lc $$t{severity})} @severity;
  my $bug = +{ bug_id           => $$t{id} };
  $$bug{priority}         = $prio;
  $$bug{creation_ts}      = timeconvert($$t{time});
  $$bug{delta_ts}         = timeconvert($$t{changetime});
  $$bug{lastdiffed}       = $$bug{delta_ts};
  $$bug{component_id}     = $$comp{id};
  $$bug{product_id}       = $$comp{product_id};
  $$bug{bug_severity}     = $$sev{value};
  $$bug{version}          = $versionmap{$$t{version}};
  $$bug{target_milestone} = ($$t{milestone}) ? $milestonemap{$$t{milestone}} : "";
  $$bug{bug_status}       = $statusmap{$$t{status}};
  if (exists $$t{resolution} and defined $$t{resolution}) {
    if (exists $resolutionmap{$$t{resolution}}) {
      if (defined $resolutionmap{$$t{resolution}}) {
        $$bug{resolution}       = $resolutionmap{$$t{resolution}};
      } else {
        die "Undefined mapping for resolution: $$t{resolution}\n";
      }
    } else {
      die "No mapping for resolution: $$t{resolution}\n";
    }
  } else {
    #warn "No resolution for ticket $$t{id}\n";
    $$bug{resolution} = $resolutionmap{""};
  }
  $$bug{short_desc}       = $$t{summary};

  my $bft = +{
              bug_id           => $$t{id},
              short_desc       => $$t{summary},
              comments         => $$t{description},
             };
  my $lng = +{
              bug_id           => $$t{id},
              bug_when         => $$bug{creation_ts},
              thetext          => $$t{description},
             };
  for my $u (+[ assigned_to => $$t{owner}],
             +[ reporter    => $$t{reporter}]) {
    my ($bzfield, $username) = @$u;
    my $author = userlookup($username);
    if ($author) {
      $$bug{$bzfield} = $$author{userid};
      if ($bzfield eq 'reporter') {
        $$lng{who} = $$author{userid};
      }
    }
  }
  if ($$t{version} =~ /fourk/i) {
    $$bug{product_id}       = 4;  # Fourk
    $$bug{component_id}     = 18; # Game Engine (provisionally)
    $$bug{target_milestone} = 18; # untriaged
  }
  my %subkeyword = ( # a little authority control here
                    "osx"      => 'Mac',
                    "spectate" => "watchmode",
                    "vanill"   => "vanilla",
                    "windows"  => "Windows",
                    "freebsd"  => "BSD",
                    "linux"    => "Linux",
                   );
  for my $kw (grep { $_ } map { chomp; $_ }
              split /[,]?\w+|[,]\w*/, $$t{keywords}) {
    $kw =~ s/\s+$//;
    $kw = $subkeyword{$kw} || $kw;
    if ($kw) {
      my ($rec) = bz(sub { findrecord('keyworddefs', 'name', $kw)});
      if (ref $rec) {
        my $kwid = $$rec{id};
        my ($assigned) = bz(sub { findrecord('keywords',
                                             'bug_id'    => $$t{id},
                                             'keywordid' => $kwid,
                                            )});
        if (not $assigned) {
          bz(sub { addrecord('keywords' +{
                                          bug_id    => $$t{id},
                                          keywordid => $kwid,
                                         })});
        }
      } else {
        warn "Discarding keyword: $kw\n";
      }
    }
  }
  my ($bugexists) = bz(sub{findrecord('bugs', 'bug_id', $$bug{bug_id})});
  if ($bugexists) {
    print "Bug $$bug{bug_id} already exists, skipping.\n";
  } else {
    bz(sub { addrecord('bugs', $bug)});
    my ($bftexists) = bz(sub{findrecord('bugs_fulltext', 'bug_id', $$bug{bug_id})});
    if ($bftexists) {
      warn "Bug $$bug{bug_id} fulltext record already exists, skipping.\n";
    } else {
      bz(sub{addrecord('bugs_fulltext', $bft)});
    }
    my ($lngexists) = bz(sub{findrecord('longdescs', 'bug_id', $$bug{bug_id})});
    if ($lngexists) {
      warn "Bug $$bug{bug_id} long description record already exists.\n";
    } else {
      bz(sub{addrecord('longdescs', $lng)})
    }
  }
  my $dirtwo = sha1_hex($$t{id});
  my ($dirone) = $dirtwo =~ /^(...)/;
  my $attdir = qq[$attdirbase/ticket/$dirone/$dirtwo];
  if (-e $attdir) {
    print "Found attachment directory for ticket $$t{id}: $attdir\n";
    for my $attfile (<$attdir/*>) {
      my ($attbasefn) = $attfile =~ m!$attdir/(.*)!;
      #my ($att) = grep { $$_{hashedfn} eq $attfile } @att;
      my ($att, @more) = grep { $$_{size} eq -s $attfile } @att;
      if ($att and not scalar @more) {
        #print "Found attachment record $$att{id} for file $attfile\n";
        # fields:  type, id, filename, size, time, description, author, ipnr
        my ($exists) = bz(sub{findrecord('attachments',
                                         bug_id      => $$t{id},
                                         filename    => $$att{filename},
                                         #description => $$t{description},
                                         #creation_ts => timeconvert($$att{time}),
                                        )});
        if (not $exists) {
          my ($mimetype, $ispatch) = guessmimetype($attfile);
          my $author = userlookup($$att{author});
          my $attrec = +{ bug_id            => $$t{id},
                          creation_ts       => timeconvert($$att{time}),
                          modification_time => timeconvert($$att{time}),
                          description       => $$att{description},
                          mimetype          => $mimetype,
                          ispatch           => ($ispatch || 0),
                          filename          => $$att{filename},
                          submitter_id      => $$author{userid},
                        };
          bz(sub{addrecord('attachments', $attrec)});
          my ($arec) = bz(sub{findrecord('attachments',
                                         bug_id      => $$t{id},
                                         filename    => $$att{filename},
                                         #creation_ts => timeconvert($$att{time}),
                                         #description => $$t{description},
                                        )});
          if ($arec) {
            my $hash = ($$arec{attach_id} % 100) + 100;
            $hash    =~ s/.*(\d\d)$/group.$1/;
            my $dir  = qq[$atttargetdir/$hash];
            mkdir $dir if not -d $dir;
            my $targetfn = qq[$dir/attachment.$$arec{attach_id}];
            if (not -e $targetfn) {
              system("cp", $attfile, $targetfn);
            }
          } else {
            warn "May have failed to create attachment record " . Dumper($attrec) . "\n";
          }
        }
      } elsif ($att) {
        my $n = 1 + scalar @more;
        print "Found $n candidates for the attachment record for file $attfile:\n";
        print "     " . (join ", ", map { $$_{id} } ($att, @more) ) . "\n";
      } else {
        warn "Did not find attachment record for file $attbasefn\n";
      }
    }
  }
}

# Comments will go in the longdescs table.

my %descr;
my %comment;
for my $tc (trac(sub {getrecord('ticket_change'); })) {
  # fields in tc:  ticket time author field oldvalue newvalue
  if ($$tc{field} eq 'description') {
    my $bugid = $$tc{ticket};
    $descr{$bugid}{thetext}  = $$tc{newvalue};
    $descr{$bugid}{bug_when} = timeconvert($$tc{time});
    my $who = userlookup($$tc{author});
    if ($who) {
      $descr{$bugid}{who} = $$who{userid};
    }
  } if ($$tc{field} =~ /_comment(\d+)/) {
    # User added or changed a comment.
    my $revnum = $1;
    my $cnum   = $$tc{time};
    my $bug    = $$tc{ticket};
    $comment{$bug}{$cnum}{bug_id}   ||= $bug;
    $comment{$bug}{$cnum}{bug_when}   = timeconvert($$tc{time});
    if ($$tc{newvalue} =~ /^\d{16,16}$/) {
      $comment{$bug}{$cnum}{bug_when} = timeconvert($$tc{newvalue});
      if ($commenthistory) {
        $comment{$bug}{$cnum}{thetext} .= qq[Revision $revnum: $$tc{oldvalue}\n];
      } else {
        $comment{$bug}{$cnum}{thetext}  = $$tc{oldvalue};
      }
    } elsif ($commenthistory) {
      $comment{$bug}{$cnum}{thetext} .= qq[Revision $revnum: $$tc{newvalue}\n];# [[[was $$tc{oldvalue}]]]];
    } else {
      $comment{$bug}{$cnum}{thetext}  = $$tc{newvalue};
    }
    my $user = userlookup($$tc{author});
    if ($user) {
      $comment{$bug}{$cnum}{who} = $$user{userid};
    }
  }
  # The following additional types of ticket_change are also recorded in the Trac database:
  #   comment, description, component, blocking, blockedby, resolution,
  #   version, keywords, status, milestone, severity, owner, priority,
  #   summary, type
  # Do we care about when any of those fields changed?
  # Eh, let's get the _current_ data migrated first anyhow.
}

#my $commentid;
for my $bugid (sort { $a cmp $b } keys %comment) {
  for my $cnum (sort { $a cmp $b } keys %{$comment{$bugid}}) {
    #$commentid++;
    #$comment{$bugid}{$cnum}{comment_id} = $commentid;
    my ($exists) = bz(sub {findrecord('longdescs',
                                      bug_id   => $bugid,
                                      bug_when => $comment{$bugid}{$cnum}{bug_when},
                                     );});
    if ($exists) {
      print "Bug $bugid Comment $cnum already exists.\n";
    } else {
      bz(sub{ addrecord('longdescs', $comment{$bugid}{$cnum})});
    }
  }
}

my $wikinum = 0;
if (-d $wikibase) {
  for my $article (trac(sub {getrecord('wiki')})) {
    $wikinum++;
    my $filename = (sprintf "%03d", $wikinum) . "_" . $$article{name};
    $filename =~ s/[^a-zA-Z0-9_]+/_/g;
    $filename .= ".tracwiki.txt";
    open TXT, ">", qq[$wikibase/$filename];
    print TXT $$article{text};
    close TXT;
  }
}

sub guessmimetype {
  # Right now, I only care about the forty or so attachments in the
  # NetHack 4 Trac data.
  my ($file) = @_;
  my ($ext) = $file =~ /[.]([^.]+)$/;
  $ext = lc $ext;
  if (($ext eq 'diff') or ($ext eq 'patch')) {
    return ('text/plain', 1);
  }
  if ($ext eq 'txt') {
    return 'text/plain';
  }
  if ($ext eq 'png') {
    return 'image/png';
  }
  if ($ext eq 'nhgame') {
    return 'application/octet-stream';
  }
  if ($ext eq 'bz2') {
    return 'application/bzip2';
  }
  if ($ext eq 'ods') {
    return 'application/vnd.oasis.opendocument.spreadsheet';
  }
  if ($ext eq 'pl') {
    return 'text/plain';
  }
  if ($ext eq 'zip') {
    return 'application/zip';
  }
  return 'application/octet-stream';
}

sub userlookup {
  my ($username) = @_;
  $username ||= 'anyone';
  my $fakeaddress = $username . '@' . 'trac';# . '.nethack4.org';
  my ($record) = bz(sub { findrecord('profiles', 'login_name', $fakeaddress) });
  if (not $record) {
    bz(sub { addrecord('profiles', +{ 'login_name' => $fakeaddress, }); });
    ($record) = bz(sub { findrecord('profiles', 'login_name', $fakeaddress) });
  }
  return $record;
}

sub timeconvert {
  my ($tractime) = @_;
  my $seconds = $tractime / 1000000;
  return DateTime::Format::ForDB($epoch->clone()->add( seconds => $seconds));
}