view release on metacpan or  search on metacpan

lib/App/karr/ActivityLog.pm  view on Meta::CPAN

        return 0;
    }

    my $line = json_encode(\%entry);
    # Read-modify-write appended to the log ref used unguarded write_ref; two
    # concurrent writers both read the same existing content, both wrote their
    # append, and the loser overwrote the winner -- ticket #156: a task is
    # saved, its log entry is dropped, and the log starts lying about what
    # happened. read_ref_with_oid + write_ref_cas inside retry_contended turns
    # the race into a textbook CAS that backs off and re-reads on contention.
    # retry_contended treats an empty return as "lost the race, try again";
    # write_ref_cas returns 0 on contention, so we map that to () here.
    #
    # What the CAS is taken against is the *newest segment*, re-resolved on
    # every attempt: rotation is as much a lost race as an append is, and a
    # writer that cached the segment it saw before backing off would append to
    # a segment another writer has already sealed.
    return try {
        $self->git->retry_contended( "log entry to $ref", sub {
            my ( $segment, $current_oid, $current ) = $self->_active_segment;

            # Rotate before the append, never after, so no segment is ever
            # written past the cap and no entry is written twice. A full
            # segment is simply left where it is -- immutable from here on --
            # and the entry opens the next one guarded with expected_old =>
            # undef, i.e. "only if that ref does not exist yet". Two writers
            # rotating at the same moment therefore cannot clobber each other:
            # the loser gets 0, re-reads, and appends to the segment the winner
            # opened. An entry bigger than the whole cap still lands, in a
            # segment of its own, rather than looping forever.
            if ( length($current)
                && length($current) + 1 + length($line) > $self->segment_max_bytes )
            {
                $segment = $self->_segment_ref( $self->_segment_index($segment) + 1 );
                ( $current_oid, $current ) = ( undef, '' );
            }

            my $new = length $current ? "$current\n$line" : $line;
            return $self->git->write_ref_cas( $segment, $new, $current_oid ) ? 1 : ();
        } );
    } catch {
        warn "karr: activity log write to '$ref' failed: $_";
        0;
    };
}


sub entries {
    my ($self) = @_;
    return map { $self->_entries_from($_) }
        ( $self->_legacy_refs, $self->_segment_refs );
}

sub _entries_from {
    my ( $self, $ref ) = @_;
    my $content = $self->git->read_ref($ref);
    return () unless defined $content && length $content;
    my @entries;
    for my $line (split /\n/, $content) {
        next unless length $line;
        my $decoded = eval { json_decode($line) };
        push @entries, $self->git->maybe_repair_legacy($decoded) if $decoded;
    }
    return @entries;
}


sub last_entry {
    my ($self) = @_;
    for my $ref ( reverse( $self->_legacy_refs, $self->_segment_refs ) ) {
        my @entries = $self->_entries_from($ref);
        return $entries[-1] if @entries;
    }
    return undef;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::karr::ActivityLog - Activity log writer for karr board operations

=head1 VERSION

version 0.600

=head1 SYNOPSIS

    use App::karr::ActivityLog;
    use App::karr::Git;

    my $git = App::karr::Git->new(dir => '.');
    my $log = App::karr::ActivityLog->new(git => $git, role => 'agent');

    $log->log_entry(
        agent   => 'agent-fox',
        action  => 'pick',
        task_id => 5,
        detail  => 'in-progress',
    );

=head1 DESCRIPTION

Writes append-style JSON log entries to C<refs/karr/log/E<lt>identityE<gt>>
refs. Each entry receives an automatic timestamp if not provided.

The identity is C<E<lt>roleE<gt>/E<lt>emailE<gt>>: the Git user email
percent-encoded into a ref name and qualified by a B<role> (C<user> or
C<agent>). The role disambiguates a human and an AI agent that share one Git
config. It defaults to the C<KARR_ROLE> environment variable, or C<user>.

=head2 Identity encoding

Git's ref-name grammar is far narrower than what a mail address may contain,
so each component is percent-encoded (L</identity>, L</decode_identity>).
C<[A-Za-z0-9._-]> survives literally to keep the common address readable; every

lib/App/karr/ActivityLog.pm  view on Meta::CPAN

=head2 segment_max_bytes

How large (in characters) the active log segment may grow before the next entry
opens a new one; 8192 by default. Set explicitly only by the tests, which have
to see rotation without writing the thousands of entries the real cap needs.

=head1 METHODS

=head2 identity

    my $id = $log->identity;   # e.g. "agent/getty%40conflict.industries"

The percent-encoded C<E<lt>roleE<gt>/E<lt>emailE<gt>> string keying this
actor's log. Always a legal pair of git ref components; see
L</decode_identity> for the inverse.

=head2 decode_identity

    my ($role, $email) = App::karr::ActivityLog->decode_identity($id);

Turns an encoded identity -- the part of a C<refs/karr/log/*> ref name below
C<refs/karr/log/> -- back into the role and mail address it was built from.

=head2 owns_ref

    next if $log->owns_ref($ref);

True when C<$ref> is one of this identity's log refs under the current naming
scheme -- segment 0 (C<refs/karr/log/>L</identity>) or any of its rotated
segments. Refs left behind by the pre-#75 schemes are not claimed;
the internal C<_legacy_refs> is what reads those.

C<karr context> uses this to leave the invoking identity's own entries out of
the cross-agent activity it summarises: comparing against L</identity> alone
would have counted every rotated segment as somebody else's log the moment one
identity's history outgrew a single ref.

=head2 log_entry

    $log->log_entry(
        agent   => 'agent-fox',
        action  => 'pick',
        task_id => 5,
        detail  => 'in-progress',
        ts      => '2026-05-15T10:00:00Z',  # optional, auto-generated
    );

Writes a JSON log line to this identity's newest log segment, opening the next
one when that segment has reached L</segment_max_bytes> (see
L</Segments>). The first segment is C<refs/karr/log/E<lt>roleE<gt>/E<lt>encoded_emailE<gt>>.

Returns the result of L<Git/write_ref_cas>, or C<0> after warning if the entry
could not be written. It never dies: by the time a command logs, it has
already written the task the entry describes, so a failure here must not take
the command down with a half-applied mutation behind it (#75).

=head2 entries

    my @entries = $log->entries;

Returns the decoded log entries for this identity, oldest first. Refs written
under the pre-#75 naming schemes are read first and merged in ahead of the
current ref, which is also their chronological order: a board stops being
written under an old scheme the moment it is touched by a karr that knows the
new one. The current scheme's segments (L</Segments>) follow in segment order,
which is chronological for the same reason: only the newest segment is ever
appended to.

=head2 last_entry

    my $entry = $log->last_entry;

The most recent decoded log entry for this identity, or C<undef> if none.

Reads the refs newest-first and stops at the first one that yields an entry, so
on a segmented log this is one small ref read rather than the whole history --
the point of L</Segments> being lost if the cheap write path were paid for with
an expensive read of the last line.

=head1 SUPPORT

=head2 Issues

Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/karr/issues>.

=head2 IRC

Join C<#langertha> on C<irc.perl.org> or message Getty directly.

=head1 CONTRIBUTING

Contributions are welcome! Please fork the repository and submit a pull request.

=head1 AUTHOR

Torsten Raudssus <getty@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut