# 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::Patch;
use strict;
use SVK::I18N;
use SVK::Util qw( read_file write_file );
use SVK::Version;  our $VERSION = $SVK::VERSION;
use SVK::Logger;

=head1 NAME

SVK::Patch - Class representing a patch to be applied

=head1 SYNOPSIS

 # Using SVK::Patch
 $patch = SVK::Patch->load ($file, $xd, $depotname);
 $patch->view;
 # update patch for target
 $patch->update;
 # regenerate patch from source branch
 $patch->regen;

 # apply the patch to designated target
 $patch->apply ($check_only);
 # apply to arbitrary target
 $patch->apply_to ($target, $storage, %cb);

 # Creating SVK::Patch
 $patch = SVK::Patch->new ('my patch', $xd, $depotname, $src, $dst);
 $editor = $patch->editor
 # feed things to $editor
 $patch->store ($file);

=head1 DESCRIPTION

SVK::Patch represents tree delta and assorted meta data, such as merge
info and anchor for the patch to be applied.

=cut

use SVK::Editor::Patch;
use SVK::Merge;
use SVK::Editor::Diff;
use SVK::Target::Universal;
use FreezeThaw qw(freeze thaw);
use MIME::Base64;
use Compress::Zlib;

=head1 METHODS

=head2 new

Create a SVK::Patch object.

=cut

sub new {
    my ($class, $name, $xd, $depotname, $src, $dst) = @_;
    my $self = bless { name   => $name,
		       level  => 0,
		       _xd    => $xd,
		       _source => $src,
		       _target => $dst }, $class;
    $self->{_depot} = $self->{_xd}->find_depot($depotname);
    $self->{source} = $self->{_source}->universal if $self->{_source};
    $self->{target} = $self->{_target}->universal;
    return $self;
}

=head2 load

Load a SVK::Patch object from file.

=cut

sub load {
    my ($class, $file, $xd, $depot) = @_;

    my $content = do {
        open my $fh, "< $file" or die loc("cannot open %1: %2\n", $file, $!);

        # Normalize all line endings to LF
        binmode($fh, ":eol(LF)");

        # Serialized patches always begins with a block marker.
        # We need the \nVersion: to not trip over inlined block makers.
        # This is safe because unidiff can't have lines beginning with 'V'.
        local $/ = "==== BEGIN SVK PATCH BLOCK ====\nVersion:"; <$fh>;

        # Now we ignore header paragraph.
        $/ = ""; <$fh>;
        # Slurp everything up to the '=' of the end marker.
        $/ = "\n="; <$fh>;
    };

    die loc("Cannot find a patch block in %1.\n", $file) unless $content;
    chop $content; # remove the final '='. look, a use of chop()!

    my ($self) = thaw (uncompress (decode_base64 ( $content ) ) );
    $self->{_xd} = $xd;
    $self->{_depot} = $self->{_xd}->find_depot($depot);

    my $not_applicable;

    for (qw/source target/) {
	next unless $self->{$_};
	my $tmp = $self->{"_$_"} = $self->{$_}->local($self->{_depot}) or next;
	$tmp = $tmp->new->refresh_revision;
	if (wantarray) {
	    eval { $tmp->normalize };
	    $not_applicable = $@
		if $@;
	} else {
	    $tmp->normalize;
	}
	$self->{"_${_}_updated"} = 1
	    if $tmp->{revision} > $self->{"_$_"}->revision;
    }
    return wantarray ? ($self, $not_applicable) : $self;
}

=head2 store

Store a SVK::Patch object to file.

=cut

sub store {
    my ($self, $file) = @_;
    my $store = bless {map {m/^_/ ? () : ($_ => $self->{$_})} keys %$self}, ref ($self);

    local $ENV{SVKDIFF} = '';
    $self->view(\(my $output));

    write_file(
        $file, join("\n", 
            $output,
            '==== BEGIN SVK PATCH BLOCK ====',
            "Version: svk $SVK::VERSION ($^O)",
            '',
            encode_base64(compress (freeze ($store))).
            '==== END SVK PATCH BLOCK ====',
            ''
        )
    );
}

=head2 editor

Return the SVK::Editor::Patch object for feeding editor calls to, or
driving other editors.

=cut

sub editor {
    my ($self) = @_;
    $self->{editor} ||= SVK::Editor::Patch->new;
}

sub _path_attribute_text {
    my ($self, $type, $no_label) = @_;
    # XXX: check if source / target is updated
    my ($local, $m, $updated);
    if (my $target = $self->{"_$type"}) {
	if ($target->repos->fs->get_uuid eq $self->{$type}{uuid}) {
	    ++$local;
	}
	else {
	    $m= $target->is_mirrored or die;
	}
    }
    my $label = $no_label ? '' : join(
	' ', '',
	($local ? '[local]' : ()),
	($m? '[mirrored]' : ()),
	($self->{"_${type}_updated"} ? '[updated]' : ())
    );
    $label .= "\n        (".$m->url.")" if $m;
    return $label;
}

sub view {
    my ($self, $output) = @_;
    my $fs = $self->{_depot}->repos->fs;

    die loc("Target not local nor mirrored, unable to view patch.\n")
	unless $self->{_target};

    my $header = join("\n",
        "==== Patch <$self->{name}> level $self->{level}",
        "Source: ".($self->{source} ?
		    join(':', @{$self->{source}}{qw/uuid path rev/}).
		    $self->_path_attribute_text ('source', $output)
		    : '[No source]'),
        "Target: ".join(':', @{$self->{target}}{qw/uuid path rev/}).
                   $self->_path_attribute_text ('target', $output),
        "Log:", $self->{log}, ''
    );

    if ($output) {
        $$output .= $header;
    }
    else {
        print $header;
    }

    my $baseroot = $self->{_target}->root;
    my $anchor = $self->{_target}->path;
    $self->editor->drive
	( SVK::Editor::Diff->new
	  ( base_target => $self->{_target}, base_root => $baseroot,
	    llabel => "revision $self->{target}{rev}",
	    rlabel => "patch $self->{name} level $self->{level}",
	    external => $ENV{SVKDIFF},
            output => $output,
	  ));
}

sub apply {
    my ($self, $check_only) = @_;
    my $commit = SVK::Command->get_cmd ('commit', xd => $self->{_xd});
    my $target = $self->{_target}->new->refresh_revision;
    $commit->{message} = "Apply $self->{name}\@$self->{level}";
    $commit->{check_only} = $check_only;
    $self->apply_to ($target, $commit->get_editor ($target));
}

sub apply_to {
    my ($self, $target, $storage, %cb) = @_;
    my $base = $self->{_target}
	or die loc("Target not local nor mirrored, unable to test patch.\n");

    my $editor = SVK::Editor::Merge->new
	( base_anchor => $base->path,
	  base_root => $base->root,
	  storage => $storage,
	  anchor => $target->path,
	  target => '',
	  send_fulltext => !$cb{patch} && !$cb{mirror},
	  ($target->isa('SVK::Path::Checkout')
	      ? (notify => SVK::Notify->new_with_report
		    ($target->report, $target, 1))
	      : ()
	  ),
	  %cb,
	);
    $self->{editor}->drive ($editor);
    return $editor->{conflicts};
}

# XXX: update and regen are identical.  the only difference is soruce or target to be updated
sub update {
    my ($self) = @_;
    die loc("Target not local nor mirrored, unable to update patch.\n")
	unless $self->{_target};

    return unless $self->{_target_updated};
    my $target = $self->{_target}->new->refresh_revision;
    $target->normalize;
    my $patch = SVK::Editor::Patch->new;
    my $conflict;

    if ($conflict = $self->apply_to ($target, $patch, patch => 1,
				     SVK::Editor::Merge->cb_for_root
				     ($target->root, $target->path, $target->revision))) {

	$logger->error(loc("Conflicts."));
	return $conflict;
    }

    $self->{_target} = $target;
    $self->{target} = $target->universal;
    $self->{editor} = $patch;
    return 0;
}

sub regen {
    my ($self) = @_;
    my $target = $self->{_target}
	or die loc("Target not local nor mirrored, unable to regen patch.\n");
    unless ($self->{level} == 0 || $self->{_source_updated}) {
	$logger->warn(loc("Source of patch %1 not updated or not local, no need to regen patch.", $self->{name}));
	return;
    }
    my $source = $self->{_source}->new->refresh_revision;
    $source->normalize;
    my $merge = SVK::Merge->auto (repos => $self->{_depot}->repos, xd => $self->{_xd},
				  src => $source, dst => $target);
    my $conflict;
    my $patch = SVK::Editor::Patch->new;
    # XXX: handle empty
    unless ($conflict = $merge->run ($patch,
				     SVK::Editor::Merge->cb_for_root
				     ($target->root, $target->path, $target->revision))) {
	$self->{log} = $merge->log (1);
	++$self->{level};
	$self->{_source} = $source;
	$self->{source} = $source->universal;
	$self->{editor} = $patch;
	$self->ticket ($merge, $source, $target);
    }
    return $conflict;
}

=head2 ticket ($merge, $source, $target;

Associate the patch with ticket generated from C<$source> but excluding
duplicated ones from <$target>.

=cut

sub ticket {
    my ($self, $merge, $source, $target) = @_;
    $self->{ticket} =
	$merge->merge_info ($source)
	->add_target ($source)
	->del_target ($target)
        ->remove_duplicated ($merge->merge_info ($target))
	->as_string;
}

=head2 commit_editor

Returns a editor that finalize the patch object upon close_edit.

=cut

sub commit_editor {
    SVK::Patch::CommitEditor->new ( patch => $_[0], filename => $_[1]);
}

package SVK::Patch::CommitEditor;
use base qw(SVK::Editor::Patch);
use SVK::I18N;
use SVK::Logger;

sub close_edit {
    my $self = shift;
    $self->SUPER::close_edit (@_);
    my $patch = delete $self->{patch};
    my $filename = delete $self->{filename};
    $patch->{editor} = bless $self, 'SVK::Editor::Patch';
    ++$patch->{level};
    $patch->store ($filename);
    return if $filename eq '-';
    $logger->warn(loc ("Patch %1 created.", $patch->{name}));
}


1;