view release on metacpan or  search on metacpan

lib/App/karr/Cmd/Unlock.pm  view on Meta::CPAN

  usage_string => 'USAGE: karr unlock [ID[,ID,...]] [--all] [--json]',
);
use App::karr::Role::BoardAccess;
use App::karr::Role::Output;
use App::karr::Lock;

with 'App::karr::Role::BoardAccess', 'App::karr::Role::Output', 'App::karr::Role::ClaimTimeout';


option all => (
  is  => 'ro',
  doc => 'Break every lock on the board',
);

sub execute {
  my ($self, $args_ref, $chain_ref) = @_;

  $self->check_positional_args($args_ref, 1);

  # Pull first: a lock pushed by a command that died before it could release
  # one is on the remote, and this is the command for exactly that mess. The
  # guard is disarmed on the reporting path below, which writes nothing.
  my $guard = $self->sync_before;

  my $ec = $self->store->effective_config;
  my $lock = App::karr::Lock->new(
    git => $self->git,
    ttl => $self->_parse_timeout($ec->{lock_timeout},
                                 App::karr::Lock->DEFAULT_TTL),
  );

  my @pos = $self->positional_args($args_ref);
  my @held = $lock->locks;

  # No target: report only. Clearing a lock is destructive to whoever holds it,
  # so it takes an explicit id or --all.
  unless ($self->all || defined $pos[0]) {
    $guard->done;
    $self->_report(@held);
    return;
  }

  # break_lock clears both addresses a lock can have -- the current one and the
  # pre-#93 one inside refs/karr/* -- so a task holding one of each appears
  # twice in @held but must only be broken, and reported, once.
  my %seen;
  my @ids = $self->all
    ? grep { !$seen{$_}++ } map { $_->{task_id} } @held
    : $self->parse_ids($pos[0]);

  my @results;
  for my $id (@ids) {
    my ($ok, $owner) = $lock->break_lock($id);
    push @results, {
      id      => 0 + $id,
      broken  => $ok ? \1 : \0,
      ( $ok ? ( owner => $owner ) : () ),
    };
    next if $self->json;
    if ($ok) { printf "Broke lock on task %d (was held by %s)\n", $id, $owner }
    else     { printf "Task %d is not locked\n", $id }
  }

  $self->sync_after;

  $self->print_json_results(@results);
}

sub _report {
  my ($self, @held) = @_;

  if ($self->json) {
    $self->print_json([ map { { %$_,
      expired => $_->{expired} ? \1 : \0,
      legacy  => $_->{legacy}  ? \1 : \0,
    } } @held ]);
    return;
  }

  unless (@held) {
    print "No locks held.\n";
    return;
  }

  for my $l (@held) {
    printf "Task %-4d held by %s%s%s%s\n",
      $l->{task_id},
      $l->{owner},
      ( defined $l->{age} ? sprintf( ' for %s', _duration( $l->{age} ) ) : '' ),
      ( $l->{expired} ? ' [expired]' : '' ),
      # A lock still sitting in the board namespace was written by a karr older
      # than #93, or pulled from a remote that was given one. Nothing takes it
      # into account any more, and breaking it is how it finally goes away.
      ( $l->{legacy} ? ' [stray: pushed by an older karr, safe to break]' : '' );
  }
  print "\nBreak one with 'karr unlock ID', or all of them with 'karr unlock --all'.\n";
}

sub _duration {
  my ($secs) = @_;
  return "${secs}s" if $secs < 60;
  return int( $secs / 60 ) . 'm' if $secs < 3600;
  return int( $secs / 3600 ) . 'h';
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::karr::Cmd::Unlock - Show and break task pick locks

=head1 VERSION

version 0.500