feat: add build lifecycle — start_build, claim_test, complete_test, build_results

Closes the loop from test mapping to distributed CI coordination.

- Test::Mapper: start_build() queues tests for a build (given changed resources),
  claim_test() atomically claims one for a worker, complete_test() records the
  result, build_results() returns the full run summary.
- DB.pm: drop unused File::Slurper import; fix `run` VIEW which produced a
  cross-product between route/environment rows and test_for_build rows —
  simplified to a clean join over product/build/test.
- Makefile.PL: remove File::Slurper from PREREQ_PM.
- t/mapper.t: extended from 8 to 20 tests covering the full build lifecycle.
- Readme.md: rewritten from 3 lines to a proper module description with
  usage examples for all three phases (map, select, coordinate).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

Makefile.PL

@@ -8,10 +8,9 @@ WriteMakefile(
     LICENSE          => 'artistic_2',
     MIN_PERL_VERSION => '5.010',
     PREREQ_PM        => {
-        'DBI'           => 0,
-        'DBD::SQLite'   => 0,
-        'File::Touch'   => 0,
-        'File::Slurper' => 0,
+        'DBI'         => 0,
+        'DBD::SQLite' => 0,
+        'File::Touch' => 0,
     },
     TEST_REQUIRES => {
         'Test::More' => 0,

Readme.md

@@ -1,3 +1,112 @@
 # Test::Mapper
 
-Map tests to things tested
+**Selective acceptance test runner — only run what a change can break.**
+
+Acceptance tests are expensive. Running the full suite on every commit burns CI
+budget fast. `Test::Mapper` solves this by persisting a many-to-many mapping
+between source files and the acceptance tests that exercise them, then using that
+map to narrow each run to only the tests that could be affected.
+
+## The problem
+
+Unit and integration tests have a straightforward file-to-test mapping:
+`lib/Foo/Bar.pm` → `t/lib-Foo-Bar.t`. Acceptance tests don't. One acceptance
+test may exercise dozens of routes, loading dozens of source files. One source
+file may be exercised by dozens of acceptance tests. You can't derive this
+mapping mechanically — but the test *author* knows it, because they wrote the
+test to exercise specific routes/features.
+
+`Test::Mapper` gives the test author a place to record that knowledge once,
+and then uses it automatically on every CI run.
+
+## How it works
+
+1. **Map phase** (run once per test, update when routes change):
+
+   ```perl
+   use Test::Mapper;
+
+   my $mapper = Test::Mapper->new(
+       db          => '/var/lib/test-mapper/myapp.db',
+       product     => 'MyApp',
+       environment => $^O,
+   );
+
+   $mapper->map_test(
+       test      => 't/acceptance/login.t',
+       resources => [ 'lib/MyApp/Auth.pm', 'lib/MyApp/Session.pm' ],
+   );
+   ```
+
+2. **Select phase** (run on each CI build, after `git diff`):
+
+   ```perl
+   my @changed = qw(lib/MyApp/Auth.pm);   # from git diff HEAD~1
+
+   my @to_run = $mapper->tests_for_resources( resources => \@changed );
+   # => ('t/acceptance/login.t')
+   ```
+
+3. **Coordinate phase** (distributed CI: multiple workers, one build):
+
+   ```perl
+   my $build = $git_sha;
+
+   # Queue tests for this build
+   my @queued = $mapper->start_build(
+       build     => $build,
+       resources => \@changed,
+   );
+
+   # Each worker claims and runs one test atomically
+   for my $test ( $mapper->pending_tests( build => $build ) ) {
+       next unless $mapper->claim_test(
+           build  => $build,
+           test   => $test,
+           worker => "$$",
+       );
+       my $exit = system($^X, $test);
+       $mapper->complete_test(
+           build  => $build,
+           test   => $test,
+           result => $exit,
+       );
+   }
+
+   # Inspect results
+   my $results = $mapper->build_results( build => $build );
+   for my $r (@$results) {
+       printf "%s: %s\n", $r->{test_file}, $r->{result} == 0 ? 'PASS' : 'FAIL';
+   }
+   ```
+
+## Storage
+
+SQLite database, one per product (or shared across products — each is namespaced
+internally). WAL mode enabled for concurrent readers. Schema is applied
+idempotently on first connection, so no migration scripts are needed.
+
+## Installation
+
+```
+perl Makefile.PL
+make
+make test
+make install
+```
+
+Dependencies: `DBI`, `DBD::SQLite`, `File::Touch` (all on CPAN).
+
+## Concepts
+
+| Term        | Meaning |
+|-------------|---------|
+| product     | The application being tested (namespace key) |
+| environment | OS/platform string (e.g. `linux`, `MSWin32`) — resources may differ per platform |
+| resource    | A source file whose change may require tests to run |
+| build       | A build identifier (e.g. git SHA) used to coordinate a test run |
+| test        | An acceptance test filename |
+
+## License
+
+Artistic License 2.0. See `LICENSE`.

lib/Test/Mapper.pm

@@ -92,6 +92,31 @@ source filenames). Idempotent — safe to call on every analysis run.
 Given C<resources> (arrayref of changed filenames), return a list of test
 filenames that should be run.
 
+=head2 start_build(%args)
+
+Queue tests for a build. Required: C<build> (build identifier, e.g. a git SHA),
+C<resources> (arrayref of changed filenames). Returns a list of test filenames
+queued for this build.
+
+=head2 pending_tests(%args)
+
+Return unclaimed test filenames for a build. Required: C<build>.
+
+=head2 claim_test(%args)
+
+Atomically claim a test for a worker. Required: C<build>, C<test>, C<worker>.
+Returns 1 if claimed, 0 if already claimed by another worker.
+
+=head2 complete_test(%args)
+
+Record a test result. Required: C<build>, C<test>, C<result> (integer; 0=pass,
+non-zero=fail convention recommended). Sets finish timestamp automatically.
+
+=head2 build_results(%args)
+
+Return all results for a build as an arrayref of hashrefs, each with keys
+C<test_file>, C<run_by>, C<result>, C<start>, C<finish>. Required: C<build>.
+
 =cut
 
 use Test::Mapper::DB;
@@ -163,6 +188,131 @@ sub tests_for_resources {
     return @tests;
 }
 
+sub start_build {
+    my ( $self, %args ) = @_;
+    die "build is required"     unless $args{build};
+    die "resources is required" unless $args{resources};
+
+    my $dbh      = $self->{dbh};
+    my $build_id = $self->_ensure_build( $args{build} );
+    my $env_id   = $self->{_env_id};
+
+    return () unless @{ $args{resources} };
+
+    my $placeholders = join( ",", ("?") x scalar @{ $args{resources} } );
+    $dbh->do(
+        "INSERT OR IGNORE INTO test_for_build (build_id, test_id)
+         SELECT ?, tr.test_id
+         FROM to_run AS tr
+         WHERE tr.environment = (SELECT environment FROM environment WHERE id = ?)
+           AND tr.source_file IN ($placeholders)",
+        undef, $build_id, $env_id, @{ $args{resources} }
+    ) or die "Could not queue tests for build: " . $dbh->errstr;
+
+    my $sth = $dbh->prepare(
+        "SELECT t.filename
+         FROM test AS t
+         JOIN test_for_build AS tfb ON tfb.test_id = t.id
+         WHERE tfb.build_id = ?"
+    ) or die "Could not prepare query: " . $dbh->errstr;
+    $sth->execute($build_id) or die $sth->errstr;
+
+    my @tests;
+    while ( my ($filename) = $sth->fetchrow_array ) {
+        push @tests, $filename;
+    }
+    return @tests;
+}
+
+sub pending_tests {
+    my ( $self, %args ) = @_;
+    die "build is required" unless $args{build};
+
+    my $dbh = $self->{dbh};
+    my ($build_id) = $dbh->selectrow_array(
+        "SELECT id FROM build WHERE build=? AND product_id=?",
+        undef, $args{build}, $self->{_product_id}
+    );
+    return () unless $build_id;
+
+    my $sth = $dbh->prepare(
+        "SELECT t.filename
+         FROM test AS t
+         JOIN test_for_build AS tfb ON tfb.test_id = t.id
+         WHERE tfb.build_id = ? AND tfb.run_by IS NULL"
+    ) or die "Could not prepare query: " . $dbh->errstr;
+    $sth->execute($build_id) or die $sth->errstr;
+
+    my @tests;
+    while ( my ($filename) = $sth->fetchrow_array ) {
+        push @tests, $filename;
+    }
+    return @tests;
+}
+
+sub claim_test {
+    my ( $self, %args ) = @_;
+    die "build is required"  unless $args{build};
+    die "test is required"   unless $args{test};
+    die "worker is required" unless $args{worker};
+
+    my $dbh      = $self->{dbh};
+    my $build_id = $self->_build_id( $args{build} ) // return 0;
+    my $test_id  = $self->_test_id( $args{test} )   // return 0;
+
+    my $rows = $dbh->do(
+        "UPDATE test_for_build SET run_by=?
+         WHERE build_id=? AND test_id=? AND run_by IS NULL",
+        undef, $args{worker}, $build_id, $test_id
+    );
+    return ( $rows && $rows > 0 ) ? 1 : 0;
+}
+
+sub complete_test {
+    my ( $self, %args ) = @_;
+    die "build is required"  unless $args{build};
+    die "test is required"   unless $args{test};
+    die "result is required" unless defined $args{result};
+
+    my $dbh      = $self->{dbh};
+    my $build_id = $self->_build_id( $args{build} ) // die "Unknown build: $args{build}";
+    my $test_id  = $self->_test_id( $args{test} )   // die "Unknown test: $args{test}";
+
+    $dbh->do(
+        "UPDATE test_for_build SET result=?, finish=CURRENT_TIMESTAMP
+         WHERE build_id=? AND test_id=?",
+        undef, $args{result}, $build_id, $test_id
+    ) or die "Could not complete test: " . $dbh->errstr;
+    return;
+}
+
+sub build_results {
+    my ( $self, %args ) = @_;
+    die "build is required" unless $args{build};
+
+    my $dbh = $self->{dbh};
+    my $sth = $dbh->prepare(
+        "SELECT t.filename, tfb.run_by, tfb.result, tfb.start, tfb.finish
+         FROM test_for_build AS tfb
+         JOIN test  AS t ON t.id = tfb.test_id
+         JOIN build AS b ON b.id = tfb.build_id
+         WHERE b.build=? AND b.product_id=?"
+    ) or die "Could not prepare query: " . $dbh->errstr;
+    $sth->execute( $args{build}, $self->{_product_id} ) or die $sth->errstr;
+
+    my @results;
+    while ( my $row = $sth->fetchrow_hashref ) {
+        push @results, {
+            test_file => $row->{filename},
+            run_by    => $row->{run_by},
+            result    => $row->{result},
+            start     => $row->{start},
+            finish    => $row->{finish},
+        };
+    }
+    return \@results;
+}
+
 # ---- private helpers ----
 
 sub _ensure_product {
@@ -209,6 +359,38 @@ sub _ensure_test {
     return $id;
 }
 
+sub _ensure_build {
+    my ( $self, $build ) = @_;
+    my $dbh = $self->{dbh};
+    $dbh->do(
+        "INSERT OR IGNORE INTO build (build, product_id) VALUES (?, ?)",
+        undef, $build, $self->{_product_id}
+    ) or die $dbh->errstr;
+    my ($id) = $dbh->selectrow_array(
+        "SELECT id FROM build WHERE build=? AND product_id=?",
+        undef, $build, $self->{_product_id}
+    );
+    return $id;
+}
+
+sub _build_id {
+    my ( $self, $build ) = @_;
+    my ($id) = $self->{dbh}->selectrow_array(
+        "SELECT id FROM build WHERE build=? AND product_id=?",
+        undef, $build, $self->{_product_id}
+    );
+    return $id;
+}
+
+sub _test_id {
+    my ( $self, $filename ) = @_;
+    my ($id) = $self->{dbh}->selectrow_array(
+        "SELECT id FROM test WHERE filename=? AND product_id=?",
+        undef, $filename, $self->{_product_id}
+    );
+    return $id;
+}
+
 sub _ensure_resource {
     my ( $self, $filename ) = @_;
     my $dbh = $self->{dbh};

lib/Test/Mapper/DB.pm

@@ -5,7 +5,6 @@ use warnings;
 
 use DBI;
 use File::Touch;
-use File::Slurper qw{read_text};
 
 # ABSTRACT: Persistent storage for what test maps where for what build.
 
@@ -125,29 +124,20 @@ CREATE VIEW IF NOT EXISTS to_run AS
     JOIN environment AS e ON e.id = r.environment_id
 ;
 
--- Lifecycle:
--- Cron dumps rows into resource/tested_by, when time comes to run we grab the list of stuff:
--- SELECT test_file FROM to_run WHERE source_file IN (...) GROUP BY test_file;
--- We make a run
--- INSERT OR IGNORE INTO test_for_build (build_id, test_id) SELECT b.id, tr.test_id
---   FROM build AS b, to_run AS tr WHERE b.build='someSha' AND tr.source_file IN (...);
--- We run a test
--- UPDATE test_for_build SET run_by='processid:90210' WHERE build_id=? AND test_id=?;
--- It completes. The end.
--- UPDATE test_for_build SET result=1, finish=CURRENT_TIMESTAMP WHERE build_id=? AND test_id=?;
+-- Build run summary: what tests were queued/run/completed for each build.
+-- Use: SELECT * FROM run WHERE build='abc123' AND result IS NULL (unclaimed);
+--      SELECT * FROM run WHERE build='abc123' AND result IS NOT NULL (finished);
 CREATE VIEW IF NOT EXISTS run AS
     SELECT
         p.product,
-        e.environment,
         b.build,
-        r.route,
-        t.filename,
-        tb.run_by,
-        tb.result
-    FROM product AS p
-    JOIN build AS b ON p.id = b.product_id
-    JOIN test_for_build AS tb ON b.id = tb.build_id
-    JOIN environment AS e ON p.id = e.product_id
-    JOIN route AS r ON p.id = r.product_id
-    JOIN test AS t ON tb.test_id = t.id
+        t.filename  AS test_file,
+        tfb.run_by,
+        tfb.result,
+        tfb.start,
+        tfb.finish
+    FROM test_for_build AS tfb
+    JOIN build AS b ON b.id = tfb.build_id
+    JOIN test  AS t ON t.id = tfb.test_id
+    JOIN product AS p ON p.id = b.product_id
 ;

t/mapper.t

@@ -17,34 +17,30 @@ my $mapper = Test::Mapper->new(
 
 isa_ok( $mapper, 'Test::Mapper' );
 
-# Map a test to some resources
+# ---- map_test / tests_for_resources ----------------------------------------
+
 $mapper->map_test(
     test      => 't/acceptance/login.t',
     resources => [ 'lib/MyApp/Auth.pm', 'lib/MyApp/Session.pm' ],
 );
 
-# Map a second test to a partially overlapping set
 $mapper->map_test(
     test      => 't/acceptance/logout.t',
     resources => [ 'lib/MyApp/Session.pm' ],
 );
 
-# Resource that only login.t touches
 my @tests = $mapper->tests_for_resources( resources => ['lib/MyApp/Auth.pm'] );
 is( scalar @tests, 1, 'one test for Auth.pm' );
 is( $tests[0], 't/acceptance/login.t', 'correct test for Auth.pm' );
 
-# Resource shared by both tests
 my @shared = sort $mapper->tests_for_resources( resources => ['lib/MyApp/Session.pm'] );
 is( scalar @shared, 2, 'two tests for Session.pm' );
 is_deeply( \@shared, [ 't/acceptance/login.t', 't/acceptance/logout.t' ],
     'correct tests for Session.pm' );
 
-# Resource not mapped to anything
 my @none = $mapper->tests_for_resources( resources => ['lib/MyApp/Unknown.pm'] );
 is( scalar @none, 0, 'no tests for unmapped resource' );
 
-# Idempotency: mapping same test+resource again should not create duplicates
 $mapper->map_test(
     test      => 't/acceptance/login.t',
     resources => ['lib/MyApp/Auth.pm'],
@@ -52,4 +48,68 @@ $mapper->map_test(
 my @dedup = $mapper->tests_for_resources( resources => ['lib/MyApp/Auth.pm'] );
 is( scalar @dedup, 1, 'duplicate mapping is idempotent' );
 
+# ---- build lifecycle -------------------------------------------------------
+
+my $build = 'abc123';
+
+my @queued = $mapper->start_build(
+    build     => $build,
+    resources => ['lib/MyApp/Auth.pm'],
+);
+is( scalar @queued, 1, 'start_build queues one test for changed Auth.pm' );
+is( $queued[0], 't/acceptance/login.t', 'correct test queued' );
+
+my @pending = $mapper->pending_tests( build => $build );
+is( scalar @pending, 1, 'one pending test before any claims' );
+
+# claim_test returns 1 on success
+my $claimed = $mapper->claim_test(
+    build  => $build,
+    test   => 't/acceptance/login.t',
+    worker => 'worker-1',
+);
+is( $claimed, 1, 'claim_test succeeds first time' );
+
+# double-claim returns 0
+my $double = $mapper->claim_test(
+    build  => $build,
+    test   => 't/acceptance/login.t',
+    worker => 'worker-2',
+);
+is( $double, 0, 'claim_test fails when already claimed' );
+
+# no more pending after claim
+my @after_claim = $mapper->pending_tests( build => $build );
+is( scalar @after_claim, 0, 'no pending tests after claim' );
+
+# complete the test
+$mapper->complete_test(
+    build  => $build,
+    test   => 't/acceptance/login.t',
+    result => 0,
+);
+
+my $results = $mapper->build_results( build => $build );
+is( scalar @$results, 1, 'build_results returns one row' );
+is( $results->[0]{test_file}, 't/acceptance/login.t', 'correct test_file in result' );
+is( $results->[0]{result},    0,                      'result is 0 (pass)' );
+ok( defined $results->[0]{finish}, 'finish timestamp set after complete_test' );
+
+# ---- start_build is idempotent for same build+resources -------------------
+
+my @requeued = $mapper->start_build(
+    build     => $build,
+    resources => ['lib/MyApp/Auth.pm'],
+);
+my $results2 = $mapper->build_results( build => $build );
+is( scalar @$results2, 1, 'start_build idempotent — no duplicate rows' );
+
+# ---- empty resources list -------------------------------------------------
+
+my @empty_queued = $mapper->start_build(
+    build     => 'no-changes',
+    resources => [],
+);
+is( scalar @empty_queued, 0, 'start_build with empty resources returns empty list' );
+
 done_testing;