# 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::Path::Checkout;
use strict;
use SVK::Version;  our $VERSION = $SVK::VERSION;

use base 'SVK::Accessor';

use SVK::Path;

__PACKAGE__->mk_shared_accessors(qw(xd));
__PACKAGE__->mk_clonable_accessors(qw(report source copath_anchor copath_target));
__PACKAGE__->mk_accessors(qw(_pool _inspector));

use Class::Autouse qw(SVK::Editor::XD SVK::Root::Checkout);

use autouse 'SVK::Util' => qw( get_anchor catfile abs2rel get_encoder to_native );

=head1 NAME

SVK::Path::Checkout - SVK path class associating a checkout

=head1 SYNOPSIS

 See below

=head1 DESCRIPTION

The class represents a node in svk depot, associated with a checkout
copy.

=cut

sub real_new {
    my $class = shift;
    my $self = $class->SUPER::real_new(@_);
    unless (ref $self->report) {
	$self->report($self->_to_pclass($self->report))
	    if defined $self->report && length $self->report;
    }
    return $self;
}

sub root {
    my $self = shift;
    my $root = SVK::Root::Checkout->new({ path => $self });
    # XXX: It might not always be the case that we hold svk::path object
    # when using the root.
    use Scalar::Util 'weaken';
    weaken $root->{path};
    return $root;
}

sub _mkpath {
    my ($root, $path) = @_;
    my @path = ();
    for my $dir (File::Spec::Unix->splitdir($path)) {
	push @path, $dir;
	next unless length $dir;
	my $cur = File::Spec::Unix->catdir(@path);
	$root->make_dir($cur)
	    unless $root->check_path($cur);
    }
}

sub create_xd_root {
    my $self = shift;
    my $copath = $self->copath($self->copath_target);

    my (undef, $coroot) = $self->xd->{checkout}->get($copath, 1);
    Carp::cluck $copath.YAML::Syck::Dump($self->xd->{checkout}) unless $coroot;
    my @paths = $self->xd->{checkout}->find($coroot, {revision => qr'.*'});

    my $tmp = $self->_to_pclass($copath)->relative($coroot)->as_foreign('Unix')->absolute('/');
    $tmp = '' if $tmp eq '/';

    my $coroot_path = $self->path;
    $coroot_path =~ s/\Q$tmp\E$// or return $self->source->root;
    $coroot_path = '/' unless length $coroot_path;

    my $base_root = $self->source->root;
    return $base_root if $#paths <= 0;

    my $pool = SVN::Pool->new;
    my ($root, $base_rev);
    for (@paths) {
	$pool->clear;
	my $cinfo = $self->xd->{checkout}->get($_);
	my $path = abs2rel($_, $coroot => $coroot_path, '/');
	unless ($root) {
	    $root = $base_root->txn_root($self->pool);;
	    if ($base_root->revision_root_revision == 0) {
		# for interrupted checkout, the anchor will be at rev 0
		_mkpath($root, $path);
		$base_rev = 0;
	    }
	    else {
		$base_rev = $base_root->node_created_rev($path, $pool);
	    }
	    next;
	}
	my $parent = Path::Class::File->new_foreign('Unix', $path)->parent;
	if ($base_rev ==0 && !$root->check_path("$parent", $pool)) {
	    _mkpath($root, "$parent");
	}
	next if $cinfo->{revision} == $root->node_created_rev("$parent", $pool);
	my ($fromroot, $frompath) = $base_root->get_revision_root($path, $cinfo->{revision}, $pool);
	$root->delete($path, $pool)
	    if eval { $root->check_path ($path, $pool) != $SVN::Node::none };
	unless ($cinfo->{'.deleted'}) {
	    if ($frompath eq $path) {
		SVN::Fs::revision_link( $fromroot->root,
					$root->root, $path, $pool );
	    }
	    else {
		SVN::Fs::copy( $fromroot->root, $frompath,
			       $root->root, $path, $pool );
	    }
	}
    }
    return $root;
}

=head2 copath

Return the checkout path of the target, optionally with additional
path component.

=cut

my $_copath_catsplit = $^O eq 'MSWin32' ? \&catfile :
sub { defined $_[0] && length $_[0] ? "$_[0]/$_[1]" : "$_[1]" };

sub copath {
    my $self = shift;
    my $copath = ref($self) ? $self->copath_anchor : shift;
    my $paths = shift;
    return $copath unless defined $paths && length $paths;
    return $_copath_catsplit->($copath, $paths);
}

sub report { __PACKAGE__->make_accessor('report')->(@_) }

sub report_copath {
    my ($self, $copath) = @_;
    my $report = length($self->report) ? $self->report : undef;
    my $rel = abs2rel( $copath, $self->copath_anchor => $report );
    # XXX: abs2rel from F::S already does this.  tweak S::U abs2rel
    # and usage properly
    return length $rel ? $rel : '.';
}

sub copath_targets {
    my $self = shift;
    return $self->copath unless exists $self->source->{targets}[0];
    my $enc = get_encoder;
    return map { $self->copath($_) }
        map {my $t = $_; to_native($t, 'path', $enc); $t }
            @{$self->source->{targets}};
}

sub contains_copath {
    my ($self, $copath) = @_;
    foreach my $base ($self->copath_targets) {
	if ($copath ne abs2rel( $copath, $base) ) {
	    return 1;
	}
    }
    return 0;
}

sub descend {
    my ($self, $entry) = @_;
    $self->source->descend($entry);

    to_native($entry, 'path');
    $self->copath_anchor(catfile($self->copath_anchor, $entry));

    $self->report( catfile($self->report, $entry) );
    return $self;
}

sub anchorify {
    my ($self) = @_;
    $self->source->anchorify;
    # XXX: waiting for new path::class
    # $self->copath_anchor($self->_to_pclass($self->copath_anchor))
    #     unless ref($self->copath_anchor);
    # $self->copath_target($self->copath_anchor->basename);
    # $self->copath_anchor($self->copath_anchor->parent);
    my ($copath_anchor, $copath_target) = get_anchor(1, $self->copath_anchor);
    $self->copath_anchor($copath_anchor);
    $self->copath_target($copath_target);

    if (defined $self->report) {
	$self->report($self->_to_pclass($self->report))
	    unless ref($self->report);
	$self->report($self->report->parent);
    }

}

sub _get_inspector {
    my $self = shift;
    return SVK::Inspector::Root->new
	({ root => $self->root,
	   anchor => $self->path_anchor,
	   _pool => $self->pool,
	 });
}

sub as_depotpath {
    my $self = shift;
    return $self->source->new( defined $_[0] ? (revision => $_[0]) : () );
}

sub refresh_revision {
    my $self = shift;
    $self->source->refresh_revision;
    $self->_inspector(undef);
    return $self;
}

# XXX:
for my $pass_through (qw/pool inspector _to_pclass dump copy_ancestors _copy_ancestors nearest_copy is_merged_from/) {
    no strict 'refs';
    no warnings 'once';
    *{$pass_through} = *{'SVK::Path::'.$pass_through};
}

for my $proxy (qw/same_repos same_source is_mirrored normalize path universal contains_mirror depot depotpath depotname related_to copied_from search_revision merged_from revision repos path_anchor path_target repospath as_url/) {
    no strict 'refs';
    *{$proxy} = sub { my $self = shift;
		      Carp::confess unless $self->source;
		      $self->source->$proxy(@_);
		  };
}

sub for_checkout_delta {
    my $self = shift;
    my $source = $self->source;
    return ( copath => $self->copath,
	     path => $source->path_anchor,
	     targets => $source->{targets},
	     repos => $source->repos,
	     repospath => $source->repospath,
	     report => $self->report,
	   )
}

=head2 get_editor

Returns the L<SVK::Editor::XD> object, L<SVK::Inspector>, and the callback 
hash used by L<SVK::Editor::Merge>

=cut

sub get_editor {
    my ($self, %arg) = @_;
    my ($copath, $path, $spath) = ($self->copath_anchor, $self->path_anchor, $arg{store_path});
    $spath = $path unless defined $spath;
    my $encoding = $self->xd->{checkout}->get($copath)->{encoding};
    $path = '' if $path eq '/';
    $spath = '' if $spath eq '/';
    $encoding = Encode::find_encoding($encoding) if $encoding;
    $arg{get_path} = sub { $_[0] = "$path/$_[0]" };
    $arg{get_store_path} = sub { $_[0] = "$spath/$_[0]" };
    my $xdroot = $self->create_xd_root;
    $arg{oldroot} ||= $xdroot;
    $arg{newroot} ||= $xdroot;
    my $storage = SVK::Editor::XD->new (%arg,
					get_copath =>
            sub { to_native ($_[0], 'path', $encoding) if $encoding;
                  $_[0] = $self->copath($_[0]) },
					repos => $self->repos,
					target => $self->path_target,
					xd => $self->xd);
    my $inspector = $self->inspector;

    return ($storage, $inspector,
        cb_rev => sub {
            my ($path) = @_;
            my $copath;
            ($path,$copath) = $self->_get_paths($path);
            return $self->xd->{checkout}->get($copath)->{revision};
        },

        cb_conflict => sub {
            my ($path) = @_;
            my $copath;
            ($path, $copath) = $self->_get_paths($path);
            $self->xd->{checkout}->store ($copath, {'.conflict' => 1})
                unless $arg{check_only};
        },
        cb_add_merged => sub { 
            return if $arg{check_only};
            my ($path) = @_;
            my $copath;
            ($path, $copath) = $self->_get_paths($path);
            my $entry = $self->xd->{checkout}->get($copath);
            $self->xd->{checkout}->store( $copath, { '.schedule' => undef } );
	},
        cb_prop_merged => sub { 
            return if $arg{check_only};
            my ($path, $name) = @_;
            my $copath;
            ($path, $copath) = $self->_get_paths($path);
            my $entry = $self->xd->{checkout}->get ($copath);
            warn $entry unless ref $entry eq 'HASH';
            my $prop = $entry->{'.newprop'};
            delete $prop->{$name};
            $self->xd->{checkout}->store ($copath, {'.newprop' => $prop,
                         keys %$prop ? () :
                         ('.schedule' => undef)}
                        );
        });

}

sub _get_paths {
    my ($self, $path) = @_;
    $path = $self->inspector->translate($path);
    my $copath = $self->copath($path);
    $path = length $path ? $self->path_anchor."/$path" : $self->path_anchor;

    return ($path, $copath);
}

sub prev {
    my $self = shift;
    return $self->source;
}

=head1 SEE ALSO

L<SVK::Path>

=cut

1;