view release on metacpan or  search on metacpan

lib/App/karr/Role/TaskMutation.pm  view on Meta::CPAN

    for my $id (@$ids) {
        my @out;
        my $err = do {
            local $@;
            eval { @out = $per_id->($id); 1 } ? undef : ( $@ || 'unknown error' );
        };

        if ( defined $err ) {
            die $err if App::karr::Error::is_usage_error($err);
            $failed++;
            my $line = App::karr::Error::clean_error($err);
            # A suggestion block (App::karr::Error/command_hint) belongs to the
            # STDERR text a person or an agent reads off the terminal, not to
            # the --json payload: `error` has been exactly one line for as long
            # as it has existed, and a reader of it is scripting this CLI
            # already and has no use for a shell line to copy (ticket k263).
            my ($json_line) = split /\n/, $line, 2;
            # The colon on the prose line is there to introduce the suggestion.
            # With the suggestion gone it introduces nothing, so it goes too.
            $json_line =~ s/:\z// unless $json_line eq $line;
            # The id is echoed as a number when it is one, so an agent reading
            # --json gets the same type it passed in -- and a non-numeric id
            # does not add "Argument isn't numeric" to the diagnosis of what is
            # already an error.
            push @results,
              { id => ( $id =~ /\A[0-9]+\z/ ? $id + 0 : $id ), error => $json_line };
            warn "$line\n" unless $self->json;
            next;
        }

        push @results, @out;
    }

    return ( \@results, $failed );
}


sub report_batch_failure {
    my ($self, $failed, $total) = @_;
    return 0 unless $failed;
    # After the successful ids are committed and pushed, never instead of them.
    # A die rather than an exit: bin/karr's handler turns it into the 1 the
    # contract calls for, and an in-process caller gets an exception instead of
    # having its interpreter shot out from under it.
    App::karr::Error::user_error( sprintf '%d of %d ids failed', $failed, $total );
}


# The canonical location of a task. BoardStore and App::karr::Git build the
# same string; this role needs it directly because it reads the OID and the
# content together (App::karr::Git::read_ref_with_oid), which is the pair a
# compare-and-swap has to guard against, and no BoardStore method hands both
# back.
sub _task_data_ref {
    my ($self, $id) = @_;
    return "refs/karr/tasks/$id/data";
}

# The one way a callback can say "there is nothing here to write". A
# package-lexical scalar ref, compared by address, because the callbacks on
# this path return whatever their last statement happened to evaluate to -- a
# title, a status, the result of a clearer -- and no value a caller can
# construct by accident is this one.
#
# The address is read with Scalar::Util::refaddr, which is how identity is
# asked in this distribution (App::karr::SyncGuard keys its registry of armed
# guards the same way). It also settles the overloading question instead of
# stepping around it: refaddr returns the address itself and never consults an
# overloaded `==`, so a blessed return value cannot be asked a comparison it
# would answer with an exception.
my $NO_CHANGE = \do { my $sentinel = 'no change' };

sub no_change { return $NO_CHANGE }


# One spelling of "this id names no card" for every command on the mutation
# path (ticket k264). update_task_guarded and delete_task_guarded raise it when
# the ref is gone; archive and delete raise the same off the unguarded pre-read
# they take before the guard (Cmd::Archive, Cmd::Delete), so move, edit, delete,
# archive and handoff can never disagree on the wording -- the drift k263 warned
# about when it unified "No karr board found" across five commands. The id is
# real and only `karr list --compact` follows it, carrying no placeholder, so
# the suggestion is always printed (the shape `karr needs` got in k263). The
# trailing newline is here so a `die` honours it and Carp appends no call site.
sub task_not_found {
    my ($self, $id) = @_;
    return "Task $id not found on this board:\n"
        . App::karr::Error::command_hint('list', '--compact') . "\n";
}


sub update_task_guarded {
    my ($self, $id, $mutate) = @_;
    my $git = $self->git;
    my $ref = $self->_task_data_ref($id);

    return $git->retry_contended( "task $id", sub {
        my ( $oid, $content ) = $git->read_ref_with_oid($ref);
        die $self->task_not_found($id) unless defined $oid && length $content;

        my $task = App::karr::Task->from_string( $content,
            repair_frontmatter => $git->board_is_legacy_encoded );

        my $verdict = $mutate->($task);

        # A callback that found nothing to change gets no write: `updated` is
        # stamped by the write (App::karr::BoardStore/save_task_cas) and the
        # activity log hangs off it, so a command that changed nothing and
        # wrote anyway moved the one field the foundation drain reads to tell a
        # stuck card from a worked one, and put an entry in the log for an
        # event that did not happen (#231). Returning the task rather than ()
        # ends the retry loop: () means "another agent got in first, read again",
        # and nothing here lost a race.
        return $task
          if ref $verdict
          && Scalar::Util::refaddr($verdict) == Scalar::Util::refaddr($NO_CHANGE);

        # Through the role's own door rather than straight at write_ref_cas:
        # BoardAccess::save_task is where the `updated` bump and the activity
        # log entry live for every command write, guarded or not, and reaching