# BEGIN BPS TAGGED BLOCK {{{
# COPYRIGHT:
# 
# This software is Copyright (c) 2003-2006 Best Practical Solutions, LLC
#                                          <clkao@bestpractical.com>
# 
# (Except where explicitly superseded by other copyright notices)
# 
# 
# LICENSE:
# 
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of either:
# 
#   a) Version 2 of the GNU General Public License.  You should have
#      received a copy of the GNU General Public License along with this
#      program.  If not, write to the Free Software Foundation, Inc., 51
#      Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit
#      their web page on the internet at
#      http://www.gnu.org/copyleft/gpl.html.
# 
#   b) Version 1 of Perl's "Artistic License".  You should have received
#      a copy of the Artistic License with this package, in the file
#      named "ARTISTIC".  The license is also available at
#      http://opensource.org/licenses/artistic-license.php.
# 
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# CONTRIBUTION SUBMISSION POLICY:
# 
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of the
# GNU General Public License and is only of importance to you if you
# choose to contribute your changes and enhancements to the community
# by submitting them to Best Practical Solutions, LLC.)
# 
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with SVK,
# to Best Practical Solutions, LLC, you confirm that you are the
# copyright holder for those contributions and you grant Best Practical
# Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free,
# perpetual, license to use, copy, create derivative works based on
# those contributions, and sublicense and distribute those contributions
# and any derivatives thereof.
# 
# END BPS TAGGED BLOCK }}}
package SVK::Editor::Merge;
use strict;
use SVK::Version;  our $VERSION = $SVK::VERSION;

use base 'SVK::Editor';
use SVK::I18N;
use SVK::Logger;
use autouse 'SVK::Util'
    => qw( slurp_fh md5_fh tmpfile devnull abs2rel );

__PACKAGE__->mk_accessors(qw(inspector notify storage));

use Class::Autouse qw(SVK::Inspector::Root SVK::Notify
		      Data::Hierarchy IO::Digest);

use constant FH => 0;
use constant FILENAME => 1;
use constant CHECKSUM => 2;

=head1 NAME

SVK::Editor::Merge - An editor that does merges for the storage editor

=head1 SYNOPSIS

  $editor = SVK::Editor::Merge->new
    ( anchor => $anchor,
      base_anchor => $base_anchor,
      base_root => $fs->revision_root ($arg{fromrev}),
      target => $target,
      storage => $storage_editor,
      %cb,
    );


=head1 DESCRIPTION

Given the base root and callbacks for local tree, SVK::Editor::Merge
forwards the incoming editor calls to the storage editor for modifying
the local tree, and merges the tree delta and text delta
transparently.

=head1 PARAMETERS

=head2 options for base and target tree

=over

=item anchor

The anchor of the target tree.

=item target

The target path component of the target tree.

=item base_anchor

The anchor of the base tree.

=item base_root

The root object of the base tree.

=item storage

The editor that will receive the merged callbacks.

=item allow_conflicts

Close the edito instead of abort when there are conflicts.

=item open_nonexist

open the directory even if cb_exist failed. This is for use in
conjunction with L<SVK::Editor::Rename> for the case that a descendent
exists but its parent does not.

=item inspector

The inspector reflecting the target of the merge.

=back

=head2 callbacks for local tree

Since the merger needs to have information about the local tree, some
callbacks must be supplied.

=over

=item cb_rev

Check the revision of the given path.

=item cb_conflict

Called when a conflict is detected.

=item cb_prop_merged

Called when properties are merged without changes, that is, the C<g>
status.

=item cb_merged

Called right before closing the top directory with storage editor,
root baton, and pool.

=item cb_closed

Called after each file close call.

=back

=cut

use Digest::MD5 qw(md5_hex);
use File::Compare ();

sub new {
    my $class = shift;

    my $self = $class->SUPER::new(ref $_[0] ? @_ :{@_});

    if ($self->storage->can('rename_check')) {
	my $editor = $self->storage;
	$self->inspector_translate
	    (sub { $_[0] = $editor->rename_check($_[0])});

	my $flush = $self->notify->{cb_flush};
	$self->notify->{cb_flush} = sub {
	    my ($path, $st) = @_;
	    my $newpath = $self->storage->rename_check($path);
	    $flush->($path, $st, $path eq $newpath ? undef : $newpath) };
    }

    return $self;
}

sub cb_for_root {
    my ($class, $root, $anchor, $base_rev) = @_;
    # XXX $root and $anchor are actually SVK::Path
    my $inspector = SVK::Inspector::Root->new({
        root => $root, 
        anchor => $anchor, 
    });

    return (
        inspector => $inspector,
        cb_rev => sub { $base_rev },
    );
}

sub inspector_translate {
    my ($self, $translate) = @_;
    # XXX: should do a real clone and then push
    $self->inspector($self->inspector->new($self->inspector));
    $self->inspector->path_translations([]);
    $self->inspector->push_translation($translate);
    for (qw/cb_conflict/) {
        my $sub = $self->{$_};
        next unless $sub;
        $self->{$_} = sub { my $path = shift; $translate->($path);
			    unshift @_, $path; goto &$sub };
    }
}

sub copy_info {
    my ($self, $src_from, $src_fromrev, $dst_from, $dst_fromrev) = @_;
    $self->{copy_info}{$src_from}{$src_fromrev} = [$dst_from, $dst_fromrev];
}

sub set_target_revision {
    my ($self, $revision) = @_;
    $self->{revision} = $revision;
    $self->{storage}->set_target_revision ($revision);
}

sub open_root {
    my ($self, $baserev) = @_;
    $self->{baserev} = $baserev;
    $self->{notify} ||= SVK::Notify->new_with_report ($self->{report}, $self->{target});
    $self->{storage_baton}{''} =
	$self->{storage}->open_root ($self->{cb_rev}->($self->{target}||''));
    $self->{notify}->node_status ('', '');

    my $ticket = $self->{ticket};
    $self->{dh} = Data::Hierarchy->new;
    $self->{cb_merged} =
	sub { my ($editor, $baton, $type, $pool) = @_;
	      my $func = "change_${type}_prop";
	      $editor->$func ($baton, 'svk:merge', $ticket->(), $pool);
	  } if $ticket;

    return '';
}

sub add_file {
    my ($self, $path, $pdir, @arg) = @_;
    return unless defined $pdir;
    my $pool = pop @arg;
    # a replaced node shouldn't be checked with cb_exist
    my $touched = $self->{notify}->node_status($path);
    if (!$self->{added}{$pdir} && !$touched &&
	(my $kind = $self->inspector->exist($path, $pool))) {
	unless ($kind == $SVN::Node::file) {
	    $self->{notify}->flush ($path) ;
	    return undef;
	}
	$self->{info}{$path}{addmerge} = 1;
	$self->{info}{$path}{open} = [$pdir, -1];
	$self->{info}{$path}{fpool} = $pool;
	if (defined $arg[0]) {
	    warn "===> add merge with history... very bad";
	}
	$self->{cb_add_merged}->($path) if $self->{cb_add_merged};
    }
    else {
	++$self->{changes};
	$self->{added}{$path} = 1;
	$self->{notify}->node_status ($path, $touched ? 'R' : 'A');
	if (defined $arg[0]) {
	    $self->{notify}->hist_status ($path, '+');
	    @arg = $self->resolve_copy($path, @arg);
	    $self->{info}{$path}{baseinfo} = [$self->_resolve_base($path)];
	    $self->{info}{$path}{fpool} = $pool;
	}
	$self->{storage_baton}{$path} =
	    $self->{storage}->add_file ($path, $self->{storage_baton}{$pdir}, @arg, $pool);
	$pool->default if $pool && $pool->can ('default');
	# XXX: fpool is used for testing if the file is open rather than add,
	# so use another field to hold it.
	$self->{info}{$path}{hold_pool} = $pool;
    }
    return $path;
}

sub _resolve_base {
    my ($self, $path, $orig) = @_;
    my ($entry) = $self->{dh}->get("/$path");
    return unless $entry->{copyanchor};
    $entry = $self->{dh}->get($entry->{copyanchor})
	unless $entry->{copyanchor} eq "/$path";
    my $key = $orig ? 'orig_copyfrom' : 'copyfrom';
    return (abs2rel("/$path",
		    $entry->{copyanchor} => $entry->{".$key"}, '/'),
	    $entry->{".${key}_rev"});
}

sub open_file {
    my ($self, $path, $pdir, $rev, $pool) = @_;
    # modified but rm locally - tag for conflict?
    my ($basepath, $fromrev) = $self->_resolve_base($path);
    $basepath = $path unless defined $basepath;
    if (defined $pdir && $self->inspector->exist($basepath, $pool) == $SVN::Node::file) {
	$self->{info}{$path}{baseinfo} = [$basepath, $fromrev]
	    if defined $fromrev;
	$self->{info}{$path}{open} = [$pdir, $rev];
	$self->{info}{$path}{fpool} = $pool;
	$self->{notify}->node_status ($path, '');
	$pool->default if $pool && $pool->can ('default');
	return $path;
    }
    ++$self->{skipped};
    $self->{notify}->flush ($path);
    return undef;
}

sub ensure_open {
    my ($self, $path) = @_;
    return unless $self->{info}{$path}{open};
    my ($pdir, $rev, $pool) = (@{$self->{info}{$path}{open}},
			       $self->{info}{$path}{fpool});
    $self->{storage_baton}{$path} ||=
	$self->{storage}->open_file ($path, $self->{storage_baton}{$pdir},
				     $self->{cb_rev}->($path), $pool);
    ++$self->{changes};
    delete $self->{info}{$path}{open};
}

sub ensure_close {
    my ($self, $path, $checksum, $pool) = @_;

    $self->cleanup_fh ($self->{info}{$path}{fh});
    $self->{notify}->flush ($path, 1);
    $self->{cb_closed}->($path, $checksum, $pool)
        if $self->{cb_closed};

    if ($path eq $self->{target} && $self->{changes} && $self->{cb_merged}) {
	$self->ensure_open ($path);
	$self->{cb_merged}->($self->{storage}, $self->{storage_baton}{$path}, 'file', $pool);
    }

    if (my $baton = $self->{storage_baton}{$path}) {
	$self->{storage}->close_file ($baton, $checksum, $pool);
	delete $self->{storage_baton}{$path};
    }

    delete $self->{info}{$path};
}

sub node_conflict {
    my ($self, $path) = @_;
    $self->{cb_conflict}->($path) if $self->{cb_conflict};
    ++$self->{conflicts};
    $self->{notify}->node_status ($path, 'C');
}

sub cleanup_fh {
    my ($self, $fh) = @_;
    for (qw/base new local/) {
	close $fh->{$_}[FH]
	    if $fh->{$_}[FH];
    }
}

sub prepare_fh {
    my ($self, $fh, $eol) = @_;
    for my $name (qw/base new local/) {
	my $entry = $fh->{$name};
	next unless $entry->[FH];
	# if there's eol translation required, we can't use the
	# prepared tmp files.
	if ($entry->[FILENAME]) {
	    next unless $eol;
	    # reopen the tmp file, since apply_textdelta closes it
	    open $entry->[FH], $entry->[FILENAME];
	}
	my $tmp = [tmpfile("$name-"), $entry->[CHECKSUM]];
	binmode $tmp->[FH], $eol if $eol;
	slurp_fh ($entry->[FH], $tmp->[FH]);
	close $entry->[FH];
	$entry = $fh->{$name} = $tmp;
	seek $entry->[FH], 0, 0;
    }
}

sub _retrieve_base
{
    my ($self, $path, $pool) = @_;
    my @base = tmpfile('base-');

    my ($basepath, $fromrev) = $self->{info}{$path}{baseinfo} ?
	$self->_resolve_base($path, 1)
      : ($path);
    my $root = $fromrev ? $self->{base_root}->fs->revision_root($fromrev, $pool)
	: $self->{base_root};
    $basepath = "$self->{base_anchor}/$path"
	if $basepath !~ m{^/} && $self->{base_anchor};
    slurp_fh ($root->file_contents ($basepath, $pool), $base[FH]);
    seek $base[FH], 0, 0;
    return @base;
}

sub apply_textdelta {
    my ($self, $path, $checksum, $ppool) = @_;
    return unless $path;

    my $info = $self->{info}{$path};
    my ($basepath, $fromrev) = $info->{baseinfo} ? @{$info->{baseinfo}} : ($path);
    my $fh = $info->{fh} = {};
    my $pool = $info->{fpool};
    if ($pool && ($fh->{local} = $self->inspector->localmod($basepath, $checksum || '', $pool))) {
	# retrieve base
	unless ($info->{addmerge}) {
	    $fh->{base} = [$self->_retrieve_base($path, $pool)];
	}
	# get new
	$fh->{new} = [tmpfile('new-')];
	return [SVN::TxDelta::apply ($fh->{base}[FH], $fh->{new}[FH], undef, undef, $pool)];
    }
    $self->{notify}->node_status ($path, 'U')
	unless $self->{notify}->node_status ($path);

    $self->ensure_open ($path);

    my $handle = $self->{storage}->apply_textdelta ($self->{storage_baton}{$path},
						    $checksum, $ppool);

    if ($self->{storage_has_unwritable} && !$handle) {
	delete $self->{notify}{status}{$path};
	$self->{notify}->flush ($path);
    }
    return $handle;
}

sub _merge_text_change {
    my ($self, $fh, $label, $pool) = @_;
    my $diff = SVN::Core::diff_file_diff3
	(map {$fh->{$_}[FILENAME]} qw/base local new/);
    my $mfh = tmpfile ('merged-');
    my $marker = time.int(rand(100000));
    my $ylabel
        = ref($self->{inspector}) eq 'SVK::Inspector::Compat'
        ? $label
        : $label . ' (' . $self->{inspector}->{anchor}.')'
        ;
    my $tlabel = $label . ' (' . $self->{anchor}.')';
    SVN::Core::diff_file_output_merge
	    ( $mfh, $diff,
	      (map {
		  $fh->{$_}[FILENAME]
	      } qw/base local new/),
	      "==== ORIGINAL VERSION $label $marker",
	      ">>>> YOUR VERSION $ylabel $marker",
	      "<<<< $marker",
	      "==== THEIR VERSION $tlabel $marker",
	      1, 0, $pool);

    my $conflict = SVN::Core::diff_contains_conflicts ($diff);
    $conflict ||= $self->{tree_conflict};
    if (my $resolve = $self->{resolve}) {
	$resolve->run
	    ( fh              => $fh,
	      mfh             => $mfh,
	      path            => $label,
	      marker          => $marker,
	      # Do not run resolve for diffs with no conflicts
	      ($conflict ? (has_conflict => 1) : ()),
            );
	$conflict = 0 if $resolve->{merged};
	my $mfn = $resolve->{merged} || $resolve->{conflict};
	open $mfh, '<:raw', $mfn or die "Cannot read $mfn: $!" if $mfn;
    }
    seek $mfh, 0, 0; # for skipped
    return ($conflict, $mfh);
}

sub _overwrite_local_file {
    my ($self, $fh, $path, $nfh, $pool) = @_;
    # XXX: document why this is like this
    my $storagebase = $fh->{local};
    my $info = $self->{info}{$path};
    my ($basepath, $fromrev) = $info->{baseinfo} ? @{$info->{baseinfo}} : ($path);

    if ($fromrev) {
	my $sbroot = $self->{base_root}->fs->revision_root($fromrev, $pool);
	$storagebase->[FH] = $sbroot->file_contents($basepath, $pool);
	$storagebase->[CHECKSUM] = $sbroot->file_md5_checksum($basepath, $pool);
    }

    my $handle = $self->{storage}->
	apply_textdelta ($self->{storage_baton}{$path},
			 $storagebase->[CHECKSUM], $pool);

    if ($handle && $#{$handle} >= 0) {
	if ($self->{send_fulltext}) {
	    SVN::TxDelta::send_stream ($nfh, @$handle, $pool);
	}
	else {
	    seek $storagebase->[FH], 0, 0 unless $fromrev; # don't seek for sb
	    my $txstream = SVN::TxDelta::new($fh->{local}[FH], $nfh, $pool);
	    SVN::TxDelta::send_txstream ($txstream, @$handle, $pool);
	}
	return 1;
    }

    if ($self->{storage_has_unwritable}) {
	delete $self->{notify}{status}{$path};
	$self->{notify}->flush ($path);
	return 0;
    }
    return 1;
}

sub _merge_file_unchanged {
    my ($self, $path, $checksum, $pool) = @_;
    ++$self->{changes} unless $self->{g_merge_no_a_change};
    $self->{notify}->node_status ($path, 'g');
    $self->ensure_close ($path, $checksum, $pool);
    return;
}

sub close_file {
    my ($self, $path, $checksum, $pool) = @_;
    return unless $path;
    my $info = $self->{info}{$path};
    my $fh = $info->{fh};
    my $iod;

    my ($basepath, $fromrev) = $info->{baseinfo} ? @{$info->{baseinfo}} : ($path);
    no warnings 'uninitialized';
    my $storagebase_checksum = $fh->{local}[CHECKSUM];
    if ($fromrev) {
	$storagebase_checksum = $self->{base_root}->fs->revision_root
	    ($fromrev, $pool)->file_md5_checksum($basepath, $pool);
    }

    # let close_directory reports about its children
    if ($info->{fh}{new}) {

	$self->_merge_file_unchanged ($path, $checksum, $pool), return
	    if $checksum eq $storagebase_checksum;

	my $eol = $self->inspector->localprop($basepath, 'svn:eol-style', $pool);
	my $eol_layer = SVK::XD::get_eol_layer({'svn:eol-style' => $eol}, '>');
	$eol_layer = '' if $eol_layer eq ':raw';
	$self->prepare_fh ($fh, $eol_layer);
	# XXX: There used be a case that this explicit comparison is
	# needed, but i'm not sure anymore.
	$self->_merge_file_unchanged ($path, $checksum, $pool), return
	    if File::Compare::compare ($fh->{new}[FILENAME], $fh->{local}->[FILENAME]) == 0;

	$self->ensure_open ($path);
        if ($info->{addmerge}) {
            $fh->{base}[FILENAME] = devnull;
            open $fh->{base}[FH], '<', $fh->{base}[FILENAME];
        }
	my ($conflict, $mfh) = $self->_merge_text_change ($fh, $path, $pool);
	$self->{notify}->node_status ($path, $conflict ? 'C' : 'G');

	$eol_layer = SVK::XD::get_eol_layer({'svn:eol-style' => $eol}, '<');
	binmode $mfh, $eol_layer or die $! if $eol_layer;

	$iod = IO::Digest->new ($mfh, 'MD5');

	if ($self->_overwrite_local_file ($fh, $path, $mfh, $pool)) {
	    undef $fh->{base}[FILENAME] if $info->{addmerge};
	    $self->node_conflict ($path) if $conflict;
	}
	$self->cleanup_fh ($fh);
    }
    elsif ($info->{fpool}) {
	if (!$self->{notify}->node_status($path) || !exists $fh->{local} ) {
	    # open but without text edit, load local checksum
	    if ($basepath ne $path) {
		$checksum = $self->{base_root}->fs->revision_root($fromrev, $pool)->file_md5_checksum($basepath, $pool);
	    }
	    elsif (my $local = $self->inspector->localmod($basepath, $checksum, $pool)) {
		$checksum = $local->[CHECKSUM];
		close $local->[FH];
	    }
	}
    }

    $checksum = $iod->hexdigest if $iod;
    $self->ensure_close ($path, $checksum, $pool);
}

sub add_directory {
    my ($self, $path, $pdir, @arg) = @_;
    return undef unless defined $pdir;
    my $pool = pop @arg;
    my $touched = $self->{notify}->node_status($path);
    # This comes from R (D+A) where the D has conflict
    if ($touched && $touched eq 'C') {
	return undef;
    }
    # Don't bother calling cb_exist (which might be expensive if the parent is
    # already added.
    if (!$self->{added}{$pdir} && !$touched &&
	(my $kind = $self->inspector->exist($path, $pool))) {
	unless ($kind == $SVN::Node::dir) {
	    $self->{notify}->flush ($path) ;
	    return undef;
	}
	$self->{storage_baton}{$path} =
	    $self->{storage}->open_directory ($path, $self->{storage_baton}{$pdir},
					      $self->{cb_rev}->($path), $pool);
	$self->{notify}->node_status ($path, 'G');
	$self->{cb_add_merged}->($path) if $self->{cb_add_merged};
    }
    else {
	if (defined $arg[0]) {
	    @arg = $self->resolve_copy($path, @arg);
	}
	my $baton =
	    $self->{storage}->add_directory ($path, $self->{storage_baton}{$pdir},
					     @arg, $pool);
	unless (defined $baton) {
	    $self->{notify}->flush ($path);
	    return undef;
	}
	$self->{storage_baton}{$path} = $baton;
	$self->{added}{$path} = 1;
	$self->{notify}->hist_status ($path, '+')
	    if defined $arg[0];
	$self->{notify}->node_status ($path, $touched ? 'R' : 'A');
	$self->{notify}->flush ($path, 1);
    }
    ++$self->{changes};
    return $path;
}

sub resolve_copy {
    my ($self, $path, $from, $rev) = @_;
    die "unknown copy $from $rev for $path"
	unless exists $self->{copy_info}{$from}{$rev};
    my ($dstfrom, $dstrev) = @{$self->{copy_info}{$from}{$rev}};
    $self->{dh}->store("/$path", { copyanchor => "/$path",
				   '.copyfrom' => $dstfrom,
				   '.copyfrom_rev' => $dstrev,
				   '.orig_copyfrom' => $from,
				   '.orig_copyfrom_rev' => $rev,
				 });
    return $self->{cb_copyfrom}->($dstfrom, $dstrev)
	if $self->{cb_copyfrom};
    return ($dstfrom, $dstrev);
}

sub open_directory {
    my ($self, $path, $pdir, $rev, @arg) = @_;
    my $pool = $arg[-1];

    unless ($self->{open_nonexist}) {
	return undef unless defined $pdir;

	my ($basepath, $fromrev) = $self->_resolve_base($path);
	$basepath = $path unless defined $basepath;

	unless ($self->inspector->exist($basepath, $pool) || $self->{open_nonexist}) {
	    ++$self->{skipped};
	    $self->{notify}->flush ($path);
	    return undef;
	}
    }
    $self->{notify}->node_status ($path, '');
    $self->{storage_baton}{$path} =
	$self->{storage}->open_directory ($path, $self->{storage_baton}{$pdir},
					  $self->{cb_rev}->($path), @arg);
    return $path;
}

sub close_directory {
    my ($self, $path, $pool) = @_;
    return unless defined $path;
    no warnings 'uninitialized';

    delete $self->{added}{$path};
    $self->{notify}->flush_dir ($path);

    my $baton = $self->{storage_baton}{$path};
    $self->{cb_merged}->($self->{storage}, $baton, 'dir', $pool)
	if $path eq $self->{target} && $self->{changes} && $self->{cb_merged};

    $self->{storage}->close_directory ($baton, $pool);
    delete $self->{storage_baton}{$path}
	unless $path eq '';
}

sub _merge_file_delete {
    my ($self, $path, $rpath, $pdir, $pool) = @_;

    my ($basepath, $fromrev) = $self->_resolve_base($path);
    $basepath = $path unless defined $basepath;
    
    my $no_base;
    my $md5 = $self->{base_root}->check_path ($rpath, $pool)?
        $self->{base_root}->file_md5_checksum ($rpath, $pool)
        : do { $no_base = 1; require Digest::MD5; Digest::MD5::md5_hex('') };

    return undef unless $self->inspector->localmod ($basepath, $md5, $pool);
    return {} unless $self->{resolve};

    my $fh = $self->{info}{$path}->{fh} || {};
    $fh->{base} ||= [$no_base? (tmpfile('base-')): ($self->_retrieve_base($path, $pool))];
    $fh->{new} = [tmpfile('new-')];
    $fh->{local} = [tmpfile('local-')];
    my ($tmp) = $self->inspector->localmod($basepath, '', $pool);
    slurp_fh ( $tmp->[FH], $fh->{local}[FH]);
    seek $fh->{local}[FH], 0, 0;
    $fh->{local}[CHECKSUM] = $tmp->[CHECKSUM];

    my ($conflict, $mfh) = $self->_merge_text_change( $fh, $path, $pool);
    if( $conflict ) {
	$self->clean_up($fh);
	return {};
    } elsif( !(stat($mfh))[7] ) {
	#delete file if merged size is 0
	$self->clean_up($fh);
	return undef;
    }
    seek $mfh, 0, 0;
    my $iod = IO::Digest->new ($mfh, 'MD5');

    $self->{info}{$path}{open} = [$pdir, -1];
    $self->{info}{$path}{fpool} = $pool;
    $self->ensure_open ($path);
    $self->_overwrite_local_file ($fh, $path, $mfh, $pool);
    ++$self->{changes};
    $self->ensure_close ($path, $iod->hexdigest, $pool);

    return 1;
}

# return a hash for partial delete
# returns undef for deleting this
# returns 1 for merged delete (user changed content and we leave node)
# Note that empty hash means don't delete - conflict.
sub _check_delete_conflict {
    my ($self, $path, $rpath, $kind, $pdir, $pool) = @_;

    my $localkind = $self->inspector->exist ($path, $pool);

    # node doesn't exist in dst
    return undef unless $localkind;

    # deleting, but local node is of different type already
    # original node could be moved to different place
    # Editor::Rename should track the latter case
    # XXX: prompt for resolution
    return {} if $kind && $kind != $localkind;

    return $self->_merge_file_delete ($path, $rpath, $pdir, $pool) if $localkind == $SVN::Node::file;

    # TODO: checkouts may have unversioned files/dirs under the dir we are going to delete
    # we still has no interactive resolver for this
    return {} unless $localkind == $SVN::Node::dir;

    # it's dir...

    my $dirmodified = $self->inspector->dirdelta ($path, $self->{base_root}, $rpath);
    my $entries = $self->{base_root}->dir_entries ($rpath);

    my $baton = $self->{storage_baton}{$path} = $self->{storage}->open_directory (
        $path, $self->{storage_baton}{$pdir}, $self->{cb_rev}->($path), $pool
    );

    my $torm;
    for my $name (sort keys %$entries) {
	my ($cpath, $crpath) = ("$path/$name", "$rpath/$name");
        my $entry = $entries->{$name};

	if (my $mod = $dirmodified->{$name}) {
	    if ($mod eq 'D') {
                $torm->{$name} = undef;
	    }
            else {
                $torm->{$name} = $self->_check_delete_conflict ($cpath, $crpath, $entry->kind, $path, $pool);
            }
            delete $dirmodified->{$name};
	}
	else { # dir or unmodified file
            $torm->{$name} = $self->_check_delete_conflict
                ($cpath, $crpath, $entry->kind, $path, $pool);
	}
    }

    foreach my $node (keys %$dirmodified) {
        local $self->{tree_conflict} = 1;
        my ($cpath, $crpath) = ("$path/$node", "$rpath/$node");
        my $kind = $self->{base_root}->check_path ($crpath);
        $torm->{$node} = $self->_check_delete_conflict ($cpath, $crpath, $kind, $path, $pool);
    }

    $self->{storage}->close_directory ($baton, $pool);

    return $torm;
}

sub _partial_delete {
    my ($self, $torm, $path, $pbaton, $pool, $no_status) = @_;

    unless (ref $torm) {
        my $s;
        if ($torm && $torm == 1) {
            $s = 'G';
        } else {
            if ($self->inspector->exist($path, $pool)) {
                $self->{storage}->delete_entry (
                    $path, $self->{cb_rev}->($path), $pbaton, $pool
                );
            }
            $s = 'D';
        }
        $self->{notify}->node_status($path, $s) unless $no_status;
        return $s;
    } elsif (!keys %$torm) {
        $self->node_conflict($path) unless $no_status;
        return 'C';
    }
    # it's dir...

    my $baton = $self->{storage}->open_directory ($path, $pbaton, $self->{cb_rev}->($path), $pool);
    my $summary = '';
    my @children_stats;
    my $skip_children = 1;
    for (sort keys %$torm) {
	my $cpath = "$path/$_";
        # check that out
	my $status = $self->_partial_delete ($torm->{$_}, $cpath, $baton, SVN::Pool->new ($pool), 1);
        push @children_stats, [$cpath, $status];
        $skip_children = 0  unless $status eq 'D';
        $summary = 'C' if $status eq 'C';
        $summary = 'G' if !$summary && $status eq 'G';
    }
    $summary ||= 'D';
    $self->{storage}->close_directory ($baton, $pool);

    if ($summary eq 'D') {
        if ($self->inspector->exist($path, $pool)) {
            $self->{storage}->delete_entry ($path, $self->{cb_rev}->($path), $pbaton, $pool);
        }
        $self->{notify}->node_status ($path, 'D') unless $no_status;
    }
    elsif ($summary eq 'C') {
        $self->node_conflict ($path) unless $no_status;
    }
    elsif ($summary eq 'G') {
        $self->{notify}->node_status ($path, 'G') unless $no_status;
    }
    else { # really should be assert
        $self->node_conflict ($path) unless $no_status;
        $summary = 'C';
    }

    unless ($skip_children) {
        foreach (@children_stats) {
            if ($_->[1] ne 'C') {
                $self->{notify}->node_status (@$_);
            } else {
                $self->node_conflict ($_->[0]);
            }
        }
    }

    return $summary;
}

sub delete_entry {
    my ($self, $path, $revision, $pdir, @arg) = @_;
    no warnings 'uninitialized';
    my $pool = $arg[-1];
    $pool->default;
    my ($basepath, $fromrev) = $self->_resolve_base($path);
    $basepath = $path unless defined $basepath;

    return unless defined $pdir && $self->inspector->exist($basepath);
    my $rpath = $basepath =~ m{^/} ? $basepath :
	$self->{base_anchor} eq '/' ? "/$basepath" : "$self->{base_anchor}/$basepath";
    my $torm;

    # XXX: need txn-aware cb_*! for the case current path is from a
    # copy and to be deleted - Note this might have been done, exam it.
    {
	# XXX: this is too evil
	local $self->{base_root} = $self->{base_root}->fs->revision_root($fromrev) if $basepath ne $path;
	my $kind = $self->{base_root}->check_path ($rpath);
        $torm = $self->_check_delete_conflict ($path, $rpath, $kind, $pdir, @arg);
    }

    $self->_partial_delete ($torm, $path, $self->{storage_baton}{$pdir}, @arg);
    ++$self->{changes};
}

sub _prop_eq {
    my ($prop1, $prop2) = @_;
    return 0 if defined $prop1 xor defined $prop2;
    return defined $prop1 ? ($prop1 eq $prop2) : 1;
}

sub _merge_prop_content {
    my ($self, $path, $propname, $prop, $pool) = @_;

    if (my $resolver = $self->{prop_resolver}{$propname}) {
	return $resolver->($path, $prop, $pool);
    }

    if (_prop_eq (@{$prop}{qw/base local/})) {
	return ('U', $prop->{new});
    }
    elsif (_prop_eq (@{$prop}{qw/new local/})) {
	return ('g', $prop->{local});
    }

    my $fh = { map {
	my $tgt = defined $prop->{$_} ? \$prop->{$_} : devnull;
	open my $f, '<', $tgt;
	($_ => [$f, ref ($tgt) ? undef : $tgt]);
    } qw/base new local/ };
    $self->prepare_fh ($fh);

    my ($conflict, $mfh) = $self->_merge_text_change ($fh, loc ("Property %1 of %2", $propname, $path), $pool);
    if (!$conflict) {
	local $/;
	$mfh = <$mfh>;
    }
    return ($conflict ? 'C' : 'G', $mfh);
}

sub _merge_prop_change {
    my $self = shift;
    my $path = shift;
    my $pool;
    return unless defined $path;
    return if $_[0] =~ m/^svm:/;
    # special case the the root node that was actually been added
    if ($self->{added}{$path} or
	(!length ($path) and $self->{base_root}->is_revision_root
	 and $self->{base_root}->revision_root_revision == 0)) {
	$self->{notify}->prop_status ($path, 'U');
	return 1;
    }
    my $rpath = $self->{base_anchor} eq '/' ? "/$path" : "$self->{base_anchor}/$path";
    my $prop;
    $prop->{new} = $_[1];
    my ($basepath, $fromrev) = $self->{info}{$path}{baseinfo} ? @{$self->{info}{$path}{baseinfo}} : ($path);
    {
	local $@;
	$prop->{base} = eval { $self->{base_root}->node_prop ($rpath, $_[0], $pool) };
	$prop->{local} = $self->inspector->exist($basepath, $pool)
	    ? $self->inspector->localprop($basepath, $_[0], $pool) : undef;
    }
    # XXX: only known props should be auto-merged with default resolver
    $pool = pop @_ if ref ($_[-1]) =~ m/^(?:SVN::Pool|_p_apr_pool_t)$/;
    my ($status, $merged, $skipped) =
	$self->_merge_prop_content ($path, $_[0], $prop, $pool);

    return if $skipped;

    if ($status eq 'C') {
	$self->{cb_conflict}->($path, $_[0]) if $self->{cb_conflict};
	++$self->{conflicts};
    }
    elsif ($status eq 'g') {
	$self->{cb_prop_merged}->($path, $_[0])
	    if $self->{cb_prop_merged};
    }
    else {
	$_[1] = $merged;
    }
    $self->{notify}->prop_status ($path, $status);
    ++$self->{changes};
    return $status eq 'g' ? 0 : 1;
}

sub change_file_prop {
    my ($self, $path, @arg) = @_;
    $self->_merge_prop_change ($path, @arg) or return;
    $self->ensure_open ($path);
    $self->{storage}->change_file_prop ($self->{storage_baton}{$path}, @arg);
}

sub change_dir_prop {
    my ($self, $path, @arg) = @_;
    $self->_merge_prop_change ($path, @arg) or return;
    $self->{storage}->change_dir_prop ($self->{storage_baton}{$path}, @arg);
}

sub close_edit {
    my ($self, @arg) = @_;
    if ($self->{allow_conflicts} ||
	(defined $self->{storage_baton}{''} && !$self->{conflicts}) && $self->{changes}) {
	$self->{storage}->close_edit(@arg);
    }
    else {
	$logger->warn(loc("Empty merge.")) unless $self->{notify}{quiet};
	$self->{storage}->abort_edit(@arg);
    }
}

=head1 BUGS

=over

=item Tree merge

still very primitive, have to handle lots of cases

=back

=cut

1;