view release on metacpan or  search on metacpan

lib/SVK/Command.pm  view on Meta::CPAN

    return abs_path ($arg);
}

=head3 apply_revision($target)

Apply the given revision from command line to C<$target>.

=cut

sub apply_revision {
    my ($self, $target) = @_;
    $target = $target->source if $target->isa('SVK::Path::Checkout');
    return $target unless defined $self->{rev};

    return $target->seek_to( $self->resolve_revision($target, $self->{rev}) );
}

=head3 parse_revlist ()

Parse -c or -r to a list of [from, to] pairs.

=cut

sub parse_revlist {
    my ($self,$target) = @_;
    die loc("Revision required.\n") unless $self->{revspec} or $self->{chgspec};
    die loc("Can't assign --revision and --change at the same time.\n")
	if $self->{revspec} and $self->{chgspec};
    my ($fromrev, $torev);

    my @revlist = $self->resolve_chgspec($target);
    return @revlist if(@revlist);

    # revspec
    if (($fromrev, $torev) = $self->resolve_revspec($target)) {
	return ([$fromrev, $torev]);
    }
    else {
	die loc ("Revision spec must be N:M.\n");
    }
}

my %empty = map { ($_ => undef) } qw/.schedule .copyfrom .copyfrom_rev .newprop scheduleanchor/;
sub _schedule_empty { %empty };

=head3 lock_target ($target)

XXX Undocumented

=cut

sub lock_target {
    my $self = shift;
    for my $target (@_) {
	$self->{xd}->lock ($target->copath_anchor)
	    if $target->isa('SVK::Path::Checkout');
    }
}

=head3 lock_coroot ($target)

XXX Undocumented

=cut

sub lock_coroot {
    my $self = shift;
    my @tgt = map { $_->copath($_->{copath_target}) }
	grep { $_->isa('SVK::Path::Checkout') } @_;
    return unless @tgt;
    my %roots;
    for (@tgt) {
	my (undef, $coroot) = $self->{xd}{checkout}->get($_, 1);
	$roots{$coroot}++;
    }
    $self->{xd}->lock($_)
	for keys %roots;
}

=head3 brief_usage ($file)

Display an one-line brief usage of the command object.  Optionally, a file
could be given to extract the usage from the POD.

=cut

sub brief_usage {
    my ($self, $file) = @_;
    open my ($podfh), '<', ($file || $self->filename) or return;
    local $/=undef;
    my $buf = <$podfh>;
    if($buf =~ /^=head1\s+NAME\s*SVK::Command::(\w+ - .+)$/m) {
	$logger->info( "   ",loc(lcfirst($1)));
    }
    close $podfh;
}

=head3 filename

Return the filename for the command module.

=cut

sub filename {
    my $self = shift;
    my $fname = ref($self);
    $fname =~ s{::[a-z]+}{}; # subcommand
    $fname =~ s{::}{/}g;
    $INC{"$fname.pm"}
}

=head3 usage ($want_detail)

Display usage.  If C<$want_detail> is true, the C<DESCRIPTION>
section is displayed as well.

=cut

sub usage {
    my ($self, $want_detail) = @_;
    my $fname = $self->filename;
    my($cmd) = $fname =~ m{\W(\w+)\.pm$};
    my $parser = Pod::Simple::Text->new;
    my $buf;
    $parser->output_string(\$buf);
    $parser->parse_file($fname);

    $buf =~ s/SVK::Command::(\w+)/\l$1/g;
    $buf =~ s/^AUTHORS.*//sm;
    $buf =~ s/^DESCRIPTION.*//sm unless $want_detail;

    my $aliases = $cmd2alias{lc $cmd} || [];
    if( @$aliases ) {
        $buf .= "ALIASES\n\n";