package SVK::Merge;
use strict;
use SVK::Util qw(HAS_SVN_MIRROR find_svm_source find_local_mirror is_executable traverse_history);
use SVK::I18N;
use SVK::Editor::Merge;
use SVK::Editor::Rename;
use SVK::Editor::Translate;

=head1 NAME

SVK::Merge - Merge context class

=head1 SYNOPSIS

  use SVK::Merge;

  SVK::Merge->auto (repos => $repos, src => $src, dst => $dst)->run ($editor, %cb);

=head1 DESCRIPTION

The C<SVK::Merge> class is for representing merge contexts, mainly
including what delta is used for this merge, and what target the delta
applies to.

Given the 3 L<SVK::Target> objects:

=over

=item src

=item dst

=item base

=back

C<SVK::Merge> will be applying I<delta> (C<base>, C<src>) to C<dst>.

=head1 CONSTRUCTORS

=head2 new

Takes parameters the usual way.

=head2 auto

Like new, but the C<base> object will be found automatically as the
nearest ancestor of C<src> and C<dst>.

=head1 METHODS

=over

=cut

sub new {
    my ($class, @arg) = @_;
    my $self = bless {}, $class;
    %$self = @arg;
    return $self;
}

sub auto {
    my $self = new (@_);
    @{$self}{qw/base fromrev/} = $self->find_merge_base (@{$self}{qw/src dst/});
    return $self;
}

sub _is_merge_from {
    my ($self, $path, $target, $rev) = @_;
    my $fs = $self->{repos}->fs;
    my $u = $target->universal;
    my $resource = join (':', $u->{uuid}, $u->{path});
    local $@;
    my ($merge, $pmerge) =
	map {SVK::Merge::Info->new (eval { $fs->revision_root ($_)->node_prop
					       ($path, 'svk:merge') })->{$resource}{rev} || 0}
	    ($rev, $rev-1);
    return ($merge != $pmerge);
}

sub _next_is_merge {
    my ($self, $repos, $path, $rev, $checkfrom) = @_;
    return if $rev == $checkfrom;
    my $fs = $repos->fs;
    my $nextrev;

    (traverse_history (
        root     => $fs->revision_root ($checkfrom),
        path     => $path,
        cross    => 0,
        callback => sub {
            return 0 if ($_[1] == $rev); # last
            $nextrev = $_[1];
            return 1;
        }
    ) == 0) or return;

    return unless $nextrev;

    my ($merge, $pmerge) =
	map {$fs->revision_root ($_)->node_prop ($path, 'svk:merge') || ''}
	    ($nextrev, $rev);
    return if $merge eq $pmerge;
    return ($nextrev, $merge);
}

sub find_merge_base {
    my ($self, $src, $dst) = @_;
    my $repos = $self->{repos};
    my $fs = $repos->fs;
    my $yrev = $fs->youngest_rev;
    my ($srcinfo, $dstinfo) = map {$self->find_merge_sources ($_)} ($src, $dst);
    my ($basepath, $baserev, $baseentry);
    for (grep {exists $srcinfo->{$_} && exists $dstinfo->{$_}}
	 (sort keys %{ { %$srcinfo, %$dstinfo } })) {
	my ($path) = m/:(.*)$/;
	my $rev = $srcinfo->{$_} < $dstinfo->{$_} ? $srcinfo->{$_} : $dstinfo->{$_};
	# XXX: should compare revprop svn:date instead, for old dead branch being newly synced back
	($basepath, $baserev, $baseentry) = ($path, $rev, $_)
	    if !$basepath || $rev > $baserev;
    }

    return ($src->new (revision => $self->{baserev}), $self->{baserev})
        if $self->{baserev};

    unless ($basepath) {
	return ($src->new (path => '/', revision => 0), 0)
	    if $self->{baseless};
	die loc("Can't find merge base for %1 and %2\n", $src->path, $dst->path);
    }

    # XXX: document this, cf t/07smerge-foreign.t
    if ($basepath ne $src->path && $basepath ne $dst->path) {
	my ($fromrev, $torev) = ($srcinfo->{$baseentry}, $dstinfo->{$baseentry});
	($fromrev, $torev) = ($torev, $fromrev) if $torev < $fromrev;
	if (my ($mrev, $merge) =
	    $self->_next_is_merge ($repos, $basepath, $fromrev, $torev)) {
	    my $minfo = SVK::Merge::Info->new ($merge);
	    my $root = $fs->revision_root ($yrev);
	    my ($srcinfo, $dstinfo) = map { SVK::Merge::Info->new ($root->node_prop ($_->path, 'svk:merge')) }
		($src, $dst);
	    $baserev = $mrev
		if $minfo->subset_of ($srcinfo) && $minfo->subset_of ($dstinfo);
	}
    }

    my $base = $src->new (path => $basepath, revision => $baserev, targets => undef);
    $base->anchorify if exists $src->{targets}[0];
    return ($base, $dstinfo->{$fs->get_uuid.':'.$src->path} ||
	    ($basepath eq $src->path ? $baserev : 0));
}

sub merge_info {
    my ($self, $target) = @_;
    return SVK::Merge::Info->new
	( $self->{xd}->get_props
	  ($target->root ($self->{xd}), $target->path,
	   $target->copath ($target->{copath_target}))->{'svk:merge'} );
}

sub find_merge_sources {
    my ($self, $target, $verbatim, $noself) = @_;
    my $pool = SVN::Pool->new_default;
    my $info = $self->merge_info ($target->new);
    $info->add_target ($target) unless $noself;

    my $minfo = $verbatim ? $info->verbatim : $info->resolve ($target->{repos});
    return $minfo if $verbatim;

    my %ancestors = $self->copy_ancestors ($target->{repos}, $target->path, $target->{revision}, 1);
    for (sort keys %ancestors) {
	my $rev = $ancestors{$_};
	$minfo->{$_} = $rev
	    unless $minfo->{$_} && $minfo->{$_} > $rev;
    }

    return $minfo;
}

sub copy_ancestors {
    my ($self, $repos, $path, $rev, $nokeep) = @_;
    my $fs = $repos->fs;
    my $root = $fs->revision_root ($rev);
    $rev = $root->node_created_rev ($path);

    my ($found, $hitrev, $source) = (0, 0, '');
    my $myuuid = $fs->get_uuid ();
    my ($hpath, $hrev);

    defined( traverse_history (
        root     => $root,
        path     => $path,
        cross    => 1,
        callback => sub {
            ($hpath, $hrev) = @_;

            if ($hpath ne $path) {
                $found = 1;
                return 0; # last
            }

            $source = $fs->revision_prop ($hrev, "svk:copied_from:$path");
            return 1 if !defined $source;

	    $hitrev = $hrev;
            return 0 if !$source; # last

	    my $uuid;
	    ($uuid, $hpath, $hrev) = split /:/, $source;

	    if ($uuid ne $myuuid) {
		my ($m, $mpath);
		if (HAS_SVN_MIRROR &&
		    (($m, $mpath) = SVN::Mirror::has_local ($repos, "$uuid:$path"))) {
		    ($hpath, $hrev) = ($m->{target_path}, $m->find_local_rev ($hrev));
		    # XXX: WTF? need test suite for this
		    $hpath =~ s/\Q$mpath\E$//;
		}
		else {
		    return undef; # last and return ()
		}
            }

	    $found = 1;
            return 0; # last
        }
    ) ) or return ();

    $source = '' unless $found;
    if (!$found || $hitrev != $hrev) {
	$fs->change_rev_prop ($hitrev, "svk:copied_from:$path", undef)
	    unless $hitrev || $fs->revision_prop ($hitrev, "svk:copied_from_keep:$path");
	$source ||= join (':', $myuuid, $hpath, $hrev) if $found;
	if ($hitrev != $rev) {
	    $fs->change_rev_prop ($rev, "svk:copied_from:$path", $source);
	    $fs->change_rev_prop ($rev, "svk:copied_from_keep:$path", 'yes')
		unless $nokeep;
	}
    }
    return () unless $found;
    return ("$myuuid:$hpath" => $hrev, $self->copy_ancestors ($repos, $hpath, $hrev));
}

sub get_new_ticket {
    my ($self, $srcinfo) = @_;
    my $dstinfo = $self->merge_info ($self->{dst});
    # We want the ticket representing src, but not dst.
    my $newinfo = $dstinfo->union ($srcinfo)->del_target ($self->{dst});
    for (sort keys %$newinfo) {
	print loc("New merge ticket: %1:%2\n", $_, $newinfo->{$_}{rev})
	    if !$dstinfo->{$_} || $newinfo->{$_}{rev} > $dstinfo->{$_}{rev};
    }
    return $newinfo->as_string;
}

sub log {
    my ($self, $verbatim) = @_;
    open my $buf, '>', \ (my $tmp = '');
    no warnings 'uninitialized';
    use Sys::Hostname;
    my $print_rev = SVK::Command::Log::_log_remote_rev
	($self->{repos}, $self->{src}->path, $self->{remoterev},
	 '@'.($self->{host} || (split ('\.', hostname, 2))[0]));
    my $sep = $verbatim ? '' : ('-' x 70)."\n";
    my $cb_log = sub {
	SVK::Command::Log::_show_log
		(@_, $sep, $buf, 1, $print_rev)
		    unless $self->_is_merge_from ($self->{src}->path, $self->{dst}, $_[0]);
    };

    print $buf " $sep" if $sep;
    SVK::Command::Log::do_log (repos => $self->{repos}, path => $self->{src}->path,
			       fromrev => $self->{fromrev}+1, torev => $self->{src}{revision},
			       cb_log => $cb_log);
    return $tmp;
}

=item info

Return a string about how the merge is done.

=cut

sub info {
    my $self = shift;
    return loc("Auto-merging (%1, %2) %3 to %4 (base %5:%6).\n",
	       $self->{fromrev}, $self->{src}{revision}, $self->{src}->path,
	       $self->{dst}->path, $self->{base}->path, $self->{base}{revision});
}

sub _collect_renamed {
    my ($renamed, $pathref, $reverse, $rev, $root, $paths, $props) = @_;
    my $entries;
    my $path = $$pathref;
    for (keys %$paths) {
	my $entry = $paths->{$_};
	my $action = $SVK::Command::Log::chg->[$entry->change_kind];
	$entries->{$_} = [$action , $action eq 'D' ? (-1) : $root->copied_from ($_)];
	# anchor is copied
	if ($action eq 'A' && $entries->{$_}[1] != -1 &&
	    ($path eq $_ || "$_/" eq substr ($path, 0, length($_)+1))) {
	    $path =~ s/^\Q$_\E/$entries->{$_}[2]/;
	    $$pathref = $path;
	}
    }
    for (keys %$entries) {
	my $entry = $entries->{$_};
	my $from = $entry->[2] or next;
	if (exists $entries->{$from} && $entries->{$from}[0] eq 'D') {
	    s|^\Q$path\E/|| or next;
	    $from =~ s|^\Q$path\E/|| or next;
	    push @$renamed, $reverse ? [$from, $_] : [$_, $from];
	}
    }
}

sub track_rename {
    my ($self, $editor, $cb) = @_;

    my ($base) = $self->find_merge_base (@{$self}{qw/base dst/});
    my ($renamed, $path) = ([]);

    print "Collecting renames, this might take a while.\n";
    for (0..1) {
	my $target = $self->{('base', 'dst')[$_]};
	my $path = $target->path;
	SVK::Command::Log::do_log (repos => $self->{repos}, path => $path, verbose => 1,
				   torev => $base->{revision}+1, fromrev => $target->{revision},
				   cb_log => sub {_collect_renamed ($renamed, \$path, $_, @_)});
    }
    return $editor unless @$renamed;

    my $rename_editor = SVK::Editor::Rename->new (editor => $editor, rename_map => $renamed);
    SVK::Editor::Merge::cb_translate ($cb, sub {$_[0] = $rename_editor->rename_check ($_[0])});
    return $rename_editor;
}

=item run

Given the storage editor and L<SVK::Editor::Merge> callbacks, apply
the merge to the storage editor. Returns the number of conflicts.

=back

=cut

sub run {
    my ($self, $storage, %cb) = @_;
    my ($base, $src) = @{$self}{qw/base src/};
    my $base_root = $self->{base_root} || $base->root ($self->{xd});
    # XXX: for merge editor; this should really be in SVK::Target
    my ($report, $target) = ($self->{report}, $src->{targets}[0] || '');
    my $dsttarget = $self->{dst}{targets}[0];
    if ($target && $dsttarget && $target ne $dsttarget) {
	my $translate = sub { $_[0] =~ s/^\Q$target\E/$dsttarget/ };
	$storage = SVK::Editor::Translate->new (_editor => [$storage],
						translate => $translate);
	SVK::Editor::Merge::cb_translate (\%cb, $translate);
    }
    $storage = SVK::Editor::Delay->new ($storage)
	unless $self->{nodelay};
    $storage = $self->track_rename ($storage, \%cb)
	if $self->{track_rename};
    my $is_copath = defined($self->{dst}{copath});
    my $notify = $self->{notify} || SVK::Notify->new_with_report
	($report, (defined $self->{target} ? $self->{target} : $target), $is_copath);
    if ($storage->can ('rename_check')) {
	my $flush = $notify->{cb_flush};
	$notify->{cb_flush} = sub {
	    my ($path, $st) = @_;
	    my $newpath = $storage->rename_check ($path);
	    $flush->($path, $st, $path eq $newpath ? undef : $newpath) };
    }
    my $editor = SVK::Editor::Merge->new
	( anchor => $src->{path},
	  base_anchor => $base->{path},
	  base_root => $base_root,
	  target => $target,
	  storage => $storage,
	  notify => $notify,
	  allow_conflicts => $is_copath,
	  resolve => $self->resolver,
	  open_nonexist => $self->{track_rename},
	  ticket => $self->{ticket} ?
	      sub { $self->get_new_ticket ($self->merge_info ($src)->add_target ($src)) } : undef,
	  %cb,
	);
    SVK::XD->depot_delta
	    ( oldroot => $base_root, newroot => $src->root,
	      oldpath => [$base->{path}, $base->{targets}[0] || ''],
	      newpath => $src->path,
	      no_recurse => $self->{no_recurse}, editor => $editor,
	    );
    print loc("%*(%1,conflict) found.\n", $editor->{conflicts}) if $editor->{conflicts};
    print loc("%*(%1,file) skipped, you might want to rerun merge with --track-rename.\n",
	      $editor->{skipped}) if $editor->{skipped} && !$self->{track_rename} && !$self->{auto};

    return $editor->{conflicts};
}

sub resolver {
    return undef if $_[0]->{check_only};
    require SVK::Resolve;
    return SVK::Resolve->new (action => $ENV{SVKRESOLVE},
			      external => $ENV{SVKMERGE});
}

package SVK::Merge::Info;

sub new {
    my ($class, $merge) = @_;

    my $minfo = { map { my ($uuid, $path, $rev) = m/(.*?):(.*):(\d+$)/;
			("$uuid:$path" => SVK::Target::Universal->new ($uuid, $path, $rev))
		    } split ("\n", $merge || '') };
    bless $minfo, $class;
    return $minfo;
}

sub add_target {
    my ($self, $target) = @_;
    $target = $target->universal
	if UNIVERSAL::isa ($target, 'SVK::Target');
    $self->{join(':', $target->{uuid}, $target->{path})} = $target;
    return $self;
}

sub del_target {
    my ($self, $target) = @_;
    $target = $target->universal
	if UNIVERSAL::isa ($target, 'SVK::Target');
    delete $self->{join(':', $target->{uuid}, $target->{path})};
    return $self;
}

sub subset_of {
    my ($self, $other) = @_;
    my $subset = 1;
    for (keys %$self) {
	return unless exists $other->{$_} && $self->{$_}{rev} <= $other->{$_}{rev};
    }
    return 1;
}

sub union {
    my ($self, $other) = @_;
    # bring merge history up to date as from source
    my $new = SVK::Merge::Info->new;
    for (keys %{ { %$self, %$other } }) {
	if ($self->{$_} && $other->{$_}) {
	    $new->{$_} = $self->{$_}{rev} > $other->{$_}{rev}
		? $self->{$_} : $other->{$_};
	}
	else {
	    $new->{$_} = $self->{$_} ? $self->{$_} : $other->{$_};
	}
    }
    return $new;
}

sub resolve {
    my ($self, $repos) = @_;
    my $uuid = $repos->fs->get_uuid;
    return { map { my $local = $self->{$_}->local ($repos);
		   $local ? ("$uuid:$local->{path}" => $local->{revision}) : ()
	       } keys %$self };
}

sub verbatim {
    my ($self) = @_;
    return { map { $_ => $self->{$_}{rev} } keys %$self };
}

sub as_string {
    my $self = shift;
    return join ("\n", map {"$_:$self->{$_}{rev}"} sort keys %$self);
}

=head1 TODO

Document the merge and ticket tracking mechanism.

=head1 SEE ALSO

L<SVK::Editor::Merge>, L<SVK::Command::Merge>, Star-merge from GNU Arch

=head1 AUTHORS

Chia-liang Kao E<lt>clkao@clkao.orgE<gt>

=head1 COPYRIGHT

Copyright 2003-2004 by Chia-liang Kao E<lt>clkao@clkao.orgE<gt>.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut

1;
