#!/usr/bin/perl

use strict;
use warnings;
use SVN::Client;
use SVN::Wc;
use Data::Dumper qw(Dumper);
use File::Spec;
use File::Temp qw(tempfile);
use Cwd qw(abs_path getcwd);
use FindBin qw($Bin);
use lib "$Bin";
use BlameUI::Console;

@ARGV == 2 or die "Usage: $0 path [lineno]\n";
our $SVN = getSVN();
our $URL_BASE;
main(@ARGV);

sub main {
  my($path, $lineNo) = @_;
  my $rev;

  $path =~ s/\@(\d+)$//;
  $rev = $1;
  if($path =~ m!^/! or $path =~ m!://!) {
    $rev ||= 'HEAD';
  } else {
    $path = fixRelativePath($path);
    $rev ||= 'WORKING';
  }

  my($urlPath);
  my $info = $SVN->info($path,
                        $rev,
                        $rev,
                        sub {
                          my($path, $info) = @_;
                          $rev = $info->rev();
                          $urlPath = $info->URL();
                          $URL_BASE = $info->repos_root_URL();
                        },
                        0);

  my($blameRev, $blameLine) = findChange($urlPath,
                                         $rev,
                                         $lineNo);
  die "Line $lineNo doesn't exist in $urlPath\@$rev\n" unless $blameRev;

  my $oldPath = $urlPath;
  my $oldRev = $blameRev - 1;
  my $newPath = $urlPath;
  my $newRev = $blameRev;
  $lineNo = $blameLine;
  my $setParams = sub {
    ($lineNo, $oldPath, $oldRev, $newPath, $newRev) = @_;
  };
  my $getParams = sub {
    ($lineNo, $oldPath, $oldRev, $newPath, $newRev);
  };

  my($currUI, @oldData);
  @oldData = $getParams->();

  while(1) {
    my @newData;
    eval {
      @newData =
        showChange($lineNo, $oldPath, $oldRev, $newPath, $newRev);
    };
    if($@) {
      die "$@\n" unless $currUI;
      $currUI->showError($@);
      $setParams->(@oldData);
      next;
    }
    last unless @newData;
    $currUI = shift @newData;
    @oldData = $getParams->();

    if(@newData == 1) {
      # Just a new line number
      $newPath = $oldPath;
      eval {
        ($blameRev, $blameLine) = findChange($oldPath,
                                             $oldRev,
                                             $newData[0]);
      };
      if($@) {
        $currUI->showError($@);
        $setParams->(@oldData);
        next;
      }
      ($lineNo, $oldRev, $newRev) = ($blameLine, $blameRev - 1, $blameRev);
    } else {
      $setParams->(@newData);
    }
  }
}

sub findChange {
  my($path, $rev, $lineNo) = @_;

  my $blame = getBlame($path, $rev);
  my $changeRev = getBlameRevForLine($blame, $lineNo);
  return unless $changeRev;
  my $preChangeRev = $changeRev - 1;

  # We know the line number in the current revision.
  # Find the line number in the blame revision.
  my $diff = getDiff($path, $preChangeRev, $path, $rev);
  my $diffData = parseDiff($diff);
  my $oldLineNo = findChangeToLine($diffData, $lineNo);

  ($changeRev, $oldLineNo);
}

sub showChange {
  my($lineNo, $oldPath, $oldRev, $newPath, $newRev) = @_;

  # Get the diff data for the blame revision.
  my $diff = getDiff($oldPath, $oldRev, $newPath, $newRev);
  my $diffData = $diff ? parseDiff($diff) : {};
  my($logData, $copyURL, $copyRev) = getLogData($newPath, $newRev);
  $diffData->{log} = $logData;
  my $ui = BlameUI::Console->new(
                                 $URL_BASE,
                                 $diffData,
                                 $oldPath,
                                 $oldRev,
                                 $newPath,
                                 $newRev,
                                 $copyURL,
                                 $copyRev,
                                );

  return ($ui, $ui->showDiff($lineNo));
}


sub getSVN {
  my @auth = (SVN::Client::get_simple_provider(),
              SVN::Client::get_username_provider());
  return SVN::Client->new(auth => \@auth);
}

sub fixRelativePath {
  my($pathstring) = @_;
  my $cwd = getcwd();
  my $canonpath = abs_path($pathstring);
  $canonpath =~ s!^\Q$cwd\E/?!! or die
    "'$canonpath' is not inside '$cwd'!\n";
  $canonpath;
}

sub getBlame {
  my($path, $revision) = @_;
  my @ret;
  $SVN->blame($path,
             0,
             $revision,
             sub {
               my($line_no, $revision, $author, $date, $line) = @_;
               # These line numbers are 0-based, we want 1-based.
               push @ret, [$line_no + 1, $revision, $author, $line];
             });
  \@ret;
}

sub getDiff {
  my($oldPath, $oldRev, $newPath, $newRev, @diff_opts) = @_;

  my($outfh, $outfn) = tempfile();
  my($errfh, $errfn) = tempfile();
  eval {
    $SVN->diff(\@diff_opts,
               $oldPath, $oldRev,
               $newPath, $newRev,
               0, 1, 0,
               $outfh, $errfh);
  };
  if($@) {
    if($@ =~ /^Filesystem has no item:/) {
      unlink($outfn, $errfn);
      return {};
    } else {
      die "Couldn't diff $oldPath:$oldRev vs. $newPath:$newRev:\n$@\n";
    }
  }
  $outfh->close();
  $errfh->close();

  local $/ = undef;
  open(ERRFH, $errfn) or die "Couldn't open errfn '$errfn': $!\n";
  my $errstr = <ERRFH>;
  close(ERRFH);
  if($errstr) {
    die "Couldn't diff $$oldPath:$oldRev vs. $newPath:$newRev:\n$errstr\n";
  }

  open(OUTFH, $outfn) or die "Couldn't open outfn '$outfn': $!\n";
  my $outstr = <OUTFH>;
  close(OUTFH);
  unlink($errfn, $outfn);

  $outstr;
};

sub getBlameRevForLine {
  my($blame, $lineno) = @_;
  foreach (@$blame) {
    return $_->[1] if $_->[0] == $lineno;
  }
}

sub parseDiff {
  my($diff) = @_;

  my(@hunks, @old, @new, @mixed, $hunk);
  my($line_old, $line_new, $hunkline_old, $hunkline_new, $advance_old, $advance_new) = (0, 0, 0, 0, 0, 0);
  my @lines = split(/\n/, $diff);
  while(@lines) {
    my $line = shift @lines;
    if($line =~ /^\@\@\s+-(\d+),(\d+)\s+\+(\d+),(\d+)\s+\@\@$/) {
      my $diffLine = DiffLine->new(undef, undef, $line);
      push @old, $diffLine;
      push @new, $diffLine;
      push @mixed, $diffLine;

      $hunk = {
               start_old => $1,
               len_old => $2,
               start_new => $3,
               len_new => $4,
               lines_old => [],
               lines_new => [],
              };
      push @hunks, $hunk;
      $line_old = $hunk->{start_old};
      $line_new = $hunk->{start_new};
      $hunkline_old = 0;
      $hunkline_new = 0;

      while($hunkline_old < $hunk->{len_old} and
            $hunkline_new < $hunk->{len_new}) {
        my $hunkline = shift @lines;

        my $linetext = $hunkline;
        last unless $linetext;
        $linetext =~ s/^([ +-])// or die
          "Unexpected hunk line: $hunkline\n";

        my $linemode = $1;
        my($line_in_old, $line_in_new) = (0, 0);
        if($linemode eq " ") {
          $line_in_old = 1;
          $line_in_new = 1;
        } elsif($linemode eq "-") {
          $line_in_old = 1;
        } elsif($linemode eq "+") {
          $line_in_new = 1;
        }

        # If we have a diff like:
        #    foo
        #   -bar
        #   +baz
        #    buzz
        # then we want bar and baz to both be on line 2 of both old and new.
        # So, we can't advance either line counter until we see buzz.
        if($line_in_old) {
          $hunkline_old += $advance_old;
          $advance_old = 0;
        }
        if($line_in_new) {
          $hunkline_new += $advance_new;
          $advance_new = 0;
        }
        my $lineData = DiffLine->new($hunk->{start_old} + $hunkline_old,
                                     $hunk->{start_new} + $hunkline_new,
                                     $hunkline);
        if($line_in_old and $line_in_new) {
          $hunkline_old++;
          $hunkline_new++;
        } elsif($line_in_old) {
          $advance_old++;
        } elsif($line_in_new) {
          $advance_new++;
        }

        push @mixed, $lineData;
        if($line_in_old) {
          push @old, $lineData;
          push @{$hunk->{lines_old}}, $linetext;
        }
        if($line_in_new) {
          push @new, $lineData;
          push @{$hunk->{lines_new}}, $linetext;
        }
      }
    }
  }

  return {
          hunks => \@hunks,
          old => \@old,
          new => \@new,
          mixed => \@mixed
         };
}

sub findChangeToLine {
  my($diffData, $targetLineNo) = @_;

  foreach my $hunk (@{$diffData->{hunks}}) {
    if($targetLineNo > $hunk->{start_new} and
       $targetLineNo < ($hunk->{start_new} + $hunk->{len_new})) {

      return $hunk->{start_old};
    }
  }

  return;
}

sub getLogData {
  my($path, $rev) = @_;

  my @ret;
  my($copyfromPath, $copyfromRev);

  my $lineno = 1;
  my $emitLine = sub {
    my($fmt, @args) = @_;
    push @ret, DiffLine->new($lineno, $lineno, sprintf($fmt, @args));
    $lineno++;
  };
  $SVN->log($path,
            $rev,
            $rev,
            1,
            0,
            sub {
              my($paths, $crev, $auth, $date, $msg) = @_;

              $emitLine->("r%s | %s | %s", $crev, $auth, $date);
              if ($paths) {
                $emitLine->("Changed paths:");
                foreach my $path (sort keys %$paths) {
                  my $pathObj = $paths->{$path};
                  my $copyData = "";
                  if ($pathObj->copyfrom_path) {
                    $copyData = sprintf(" (from %s:%s)",
                                        $pathObj->copyfrom_path,
                                        $pathObj->copyfrom_rev);

                    if($pathObj->URL eq $path) {
                      $copyfromPath = $pathObj->copyfrom_path;
                      $copyfromRev = $pathObj->copyfrom_rev;
                    }
                  }
                  $emitLine->("   %s %s%s",
                              $pathObj->action,
                              $path,
                              $copyData);
                }

                $emitLine->("");
              }

              foreach my $line (split(/\n/, $msg)) {
                $emitLine->($line);
              }
            });

  (\@ret, $copyfromPath, $copyfromRev);
}


package DiffLine;

use strict;
use warnings;

sub new {
  my($class, $oldFileLine, $newFileLine, $lineText) = @_;
  $class = ref($class) || $class || __PACKAGE__;
  my $self = [$oldFileLine, $newFileLine, $lineText];
  bless $self, $class;
}

sub oldFileLine { shift->[0]; }
sub newFileLine { shift->[1]; }
sub lineText { shift->[2]; }