view release on metacpan or  search on metacpan

t/91-locks-are-local.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use lib 't/lib';
use TestGit qw( require_git_c );
require_git_c();
use File::Temp qw( tempdir );
use App::karr::Git;
use App::karr::Lock;
use App::karr::Task;
use App::karr::BoardStore;
use App::karr::Cmd::Unlock;

# Ticket #93: task locks lived at refs/karr/tasks/N/lock -- inside the namespace
# karr pushes.
#
# A lock means "this process, in this clone, is mid-pick right now". It says
# nothing a second clone can act on: it cannot tell whether the holder is still
# alive, and has no way to find out. But any sync that fired while one was held
# published it, the next clone to pull inherited it, and it then blocked that
# clone's picks until somebody ran `karr unlock`. Board backups snapshotted it
# too.
#
# The fix is not better release timing -- it is that no refspec can reach the
# refs at all: they live under refs/karr-local/ now.
#
# What must NOT change with them: refs/karr/log/* (the activity log) and every
# other board ref are board state and must keep syncing. Only the locks are
# process-local.

sub task {
    my ( $id, $title ) = @_;
    return App::karr::Task->new(
        id => $id, title => $title, status => 'todo',
        priority => 'high', class => 'standard', body => '',
    );
}

# A bare origin plus two clones of it, each with a board identity.
sub two_clones {
    my $work = tempdir( CLEANUP => 1 );
    system( 'git', 'init', '-q', '--bare', "$work/origin.git" );
    for my $name (qw( a b )) {
        system("git clone -q '$work/origin.git' '$work/$name' 2>/dev/null");
        system( 'git', '-C', "$work/$name", 'config', 'user.email', "$name\@karr.test" );
        system( 'git', '-C', "$work/$name", 'config', 'user.name',  "agent-$name" );
    }

    my $a = App::karr::Git->new( dir => "$work/a" );
    $a->write_ref( 'refs/karr/config', "board:\n  name: demo\n" );
    $a->write_ref( 'refs/karr/log/user/a%40karr.test', "{}\n" );
    $a->save_task_ref( task( 1, 'One' ) );
    return ( $work, $a, App::karr::Git->new( dir => "$work/b" ) );
}

sub run_execute {
    my ( $cmd, @args ) = @_;
    my $out = '';
    my $err = do {
        local $@;
        eval {
            local *STDOUT;
            open STDOUT, '>', \$out or die $!;
            $cmd->execute( \@args, [] );
        };
        $@;
    };
    return ( $err, $out );
}

sub origin_refs {
    my ($work) = @_;
    my @refs =
      `git -C '$work/origin.git' for-each-ref --format='%(refname)' 'refs/'`;
    chomp @refs;
    return [ sort @refs ];
}

subtest 'a lock ref is not in the board namespace at all' => sub {