package SVK::Command::Checkout;
use strict;
use SVK::Version;  our $VERSION = $SVK::VERSION;

use base qw( SVK::Command::Update );
use SVK::XD;
use SVK::I18N;
use SVK::Util qw( get_anchor abs_path move_path splitdir $SEP get_encoding abs_path_noexist );
use File::Path;

sub options {
    ($_[0]->SUPER::options,
     'l|list' => 'list',
     'd|delete|detach' => 'detach',
     'purge' => 'purge',
     'export' => 'export',
     'relocate' => 'relocate');
}

sub parse_arg {
    my ($self, @arg) = @_;

    return if $#arg < 0 || $#arg > 1;

    my ($src, $dst) = @arg;
    $dst = '' unless defined $dst;

    my $depotpath = $self->arg_uri_maybe
	($src,
	 eval { $self->arg_co_maybe ($dst, 'Checkout destination') }
	 ? "path '$dst' is already a checkout" : undef);
    die loc("don't know where to checkout %1\n", $src) unless length ($dst) || $depotpath->{path} ne '/';

    $dst =~ s|/$|| if length $dst;
    $dst = (splitdir($depotpath->{path}))[-1]
        if !length($dst) or $dst =~ /^\.?$/;

    return ($depotpath, $dst);
}

sub lock {
    my ($self, $src, $dst) = @_;
    my $abs_path = abs_path_noexist ($dst) or return;
    $self->{xd}->lock ($abs_path);
}

sub run {
    my ($self, $target, $report) = @_;

    if (-e $report) {
	my $copath = abs_path($report);
	my ($entry, @where) = $self->{xd}{checkout}->get($copath);

        return $self->SUPER::run ($target->new(report => $report, copath => $copath))
	    if exists $entry->{depotpath} && $entry->{depotpath} eq $target->{depotpath};
	die loc("Checkout path %1 already exists.\n", $report);
    }
    else {
	# Cwd is annoying, returning undef for paths whose parent.
	# we can't just mkdir -p $report because it might be a file,
	# so let C::Update take care about it.
	my ($anchor) = get_anchor (0, $report);
	if (length $anchor && !-e $anchor) {
	    mkpath [$anchor] or
		die loc ("Can't create checkout path %1: %2\n", $anchor, $!);
	}
    }

    # abs_path doesn't work until the parent is created.
    my $copath = abs_path ($report);
    my ($entry, @where) = $self->{xd}{checkout}->get ($copath);

    die loc("Overlapping checkout path is not supported (%1); use 'svk checkout --detach' to remove it first.\n", $where[0])
	if exists $entry->{depotpath} && $#where > 0;

    $self->{xd}{checkout}->store_recursively ( $copath,
					       { depotpath => $target->{depotpath},
						 encoding => get_encoding,
						 revision => 0,
						 '.schedule' => undef,
						 '.newprop' => undef,
						 '.deleted' => undef,
						 '.conflict' => undef,
					       });
    $self->{rev} = $target->{repos}->fs->youngest_rev unless defined $self->{rev};

    $self->SUPER::run ($target->new (report => $report,
				     copath => $copath));
    $self->rebless ('checkout::detach')->run ($copath)
	if $self->{export};

    return;
}

sub _find_copath {
    my ($self, $path) = @_;
    my $abs_path = abs_path_noexist($path);
    my $map = $self->{xd}{checkout}{hash};

    # Check if this is a checkout path
    return $abs_path if defined $abs_path and $map->{$abs_path};

    # Find all copaths that matches this depotpath
    return sort grep {
        defined $map->{$_}{depotpath}
            and $map->{$_}{depotpath} eq $path
    } keys %$map;
}

package SVK::Command::Checkout::list;
use base qw( SVK::Command::Checkout );
use SVK::I18N;

sub parse_arg { undef }

sub lock {}

sub run {
    my ($self) = @_;
    my $map = $self->{xd}{checkout}{hash};
    my $fmt = "%1s %-30s\t%-s\n";
    printf $fmt, ' ', loc('Depot Path'), loc('Path');
    print '=' x 72, "\n";
    print sort(map sprintf($fmt, -e $_ ? ' ' : '?', $map->{$_}{depotpath}, $_), grep $map->{$_}{depotpath}, keys %$map);
    return;
}

package SVK::Command::Checkout::relocate;
use base qw( SVK::Command::Checkout );
use SVK::Util qw( get_anchor abs_path move_path splitdir $SEP );
use SVK::I18N;

sub parse_arg {
    my ($self, @arg) = @_;
    die loc("Do you mean svk switch %1?\n", $arg[0]) if @arg == 1;
    return if @arg > 2;
    return @arg;
}

sub lock { ++$_[0]->{hold_giant} }

sub run {
    my ($self, $path, $report) = @_;

    my @copath = $self->_find_copath($path)
        or die loc("'%1' is not a checkout path.\n", $path);
    @copath == 1
        or die loc("'%1' maps to multiple checkout paths.\n", $path);

    my $target = abs_path ($report);
    if (defined $target) {
        my ($entry, @where) = $self->{xd}{checkout}->get ($target);
        die loc("Overlapping checkout path is not supported (%1); use 'svk checkout --detach' to remove it first.\n", $where[0])
            if exists $entry->{depotpath};
    }

    # Manually relocate all paths
    my $map = $self->{xd}{checkout}{hash};

    my $abs_path = abs_path($path);
    if ($map->{$abs_path} and -d $abs_path) {
        move_path($path => $report);
        $target = abs_path ($report);
    }

    my $prefix = $copath[0].$SEP;
    my $length = length($copath[0]);
    foreach my $key (sort grep { index("$_$SEP", $prefix) == 0 } keys %$map) {
        $map->{$target . substr($key, $length)} = delete $map->{$key};
    }

    print loc("Checkout '%1' relocated to '%2'.\n", $path, $target);

    return;
}

package SVK::Command::Checkout::detach;
use base qw( SVK::Command::Checkout );
use SVK::I18N;

sub parse_arg {
    my ($self, @arg) = @_;
    return @arg ? @arg : '';
}

sub lock { ++$_[0]->{hold_giant} }

sub _remove_entry { (depotpath => undef, revision => undef, encoding => undef) }

sub run {
    my ($self, $path) = @_;

    my @copath = $self->_find_copath($path)
        or die loc("'%1' is not a checkout path.\n", $path);

    my $checkout = $self->{xd}{checkout};
    foreach my $copath (sort @copath) {
        $checkout->store_recursively ($copath, {_remove_entry, $self->_schedule_empty});
        print loc("Checkout path '%1' detached.\n", $copath);
    }

    return;
}

package SVK::Command::Checkout::purge;
use base qw( SVK::Command::Checkout );
use SVK::Util qw( get_prompt );
use SVK::I18N;

sub parse_arg { undef }

sub lock { ++$_[0]->{hold_giant} }

sub run {
    my ($self) = @_;
    my $map = $self->{xd}{checkout}{hash};

    $self->rebless('checkout::detach');

    for my $path (sort grep $map->{$_}{depotpath}, keys %$map) {
	next if -e $path;

	my $depotpath = $map->{$path}{depotpath};

	get_prompt(loc(
	    "Purge checkout of %1 to non-existing directory %2? (y/n) ",
	    $depotpath, $path
	), qr/^[YyNn]/) =~ /^[Yy]/ or next;
	
	# Recall that we are now an SVK::Command::Checkout::detach
	$self->run($path);
    } 
    
    return;
}

1;
__DATA__

=head1 NAME

SVK::Command::Checkout - Checkout the depotpath

=head1 SYNOPSIS

 checkout DEPOTPATH [PATH]
 checkout --list
 checkout --detach [DEPOTPATH | PATH]
 checkout --relocate DEPOTPATH|PATH PATH
 checkout --purge

=head1 OPTIONS

 -r [--revision] REV    : act on revision REV instead of the head revision
 -N [--non-recursive]   : do not descend recursively
 -l [--list]            : list checkout paths
 -d [--detach]          : mark a path as no longer checked out
 -q [--quiet]           : quiet mode
 --export               : export mode; checkout a detached copy
 --relocate             : relocate the checkout to another path
 --purge                : detach checkout directories which no longer exist

=head1 AUTHORS

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

=head1 COPYRIGHT

Copyright 2003-2005 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