view release on metacpan or  search on metacpan

docs/superpowers/plans/2026-04-06-response-writer.md  view on Meta::CPAN

}

subtest 'on_close callbacks fire when writer closes' => sub {
    my ($res, $sent) = make_response();
    my @fired;

    $res->stream(async sub {
        my ($writer) = @_;
        $writer->on_close(sub { push @fired, 'first' });
        $writer->on_close(sub { push @fired, 'second' });
        await $writer->write("data");
        await $writer->close;
    })->get;

    is \@fired, ['first', 'second'], 'on_close callbacks fire in registration order';
};

subtest 'on_close via constructor' => sub {
    my ($res, $sent) = make_response();
    my @fired;

    $res->stream(async sub {
        my ($writer) = @_;
        # We can't pass on_close via stream() currently, but we can test
        # that on_close added before any writes still fires
        $writer->on_close(sub { push @fired, 'cleanup' });
        await $writer->write("data");
        await $writer->close;
    })->get;

    is \@fired, ['cleanup'], 'on_close registered early still fires';
};

subtest 'is_closed returns correct state' => sub {
    my ($res, $sent) = make_response();

    $res->stream(async sub {
        my ($writer) = @_;
        is $writer->is_closed, 0, 'not closed initially';
        await $writer->write("data");
        is $writer->is_closed, 0, 'not closed after write';
        await $writer->close;
        is $writer->is_closed, 1, 'closed after close';
    })->get;
};

done_testing;
```

- [ ] **Step 2: Run test to verify it fails**

Run: `bash -c 'source ~/perl5/perlbrew/etc/bashrc && perlbrew use perl-5.40.0@default && RELEASE_TESTING=1 prove -l t/response-writer.t'`

Expected: FAIL — `on_close` method doesn't exist, `is_closed` method doesn't exist

- [ ] **Step 3: Implement `on_close`, `is_closed` on Writer**

In `lib/PAGI/Response.pm`, replace the entire `PAGI::Response::Writer` package (lines 1091-1132) with:

```perl
# Writer class for streaming responses
package PAGI::Response::Writer {
    use strict;
    use warnings;
    use Future::AsyncAwait;
    use Carp qw(croak);

    sub new {
        my ($class, $send, %opts) = @_;
        my $self = bless {
            send          => $send,
            bytes_written => 0,
            closed        => 0,
            _on_close     => [],
        }, $class;
        push @{$self->{_on_close}}, $opts{on_close} if $opts{on_close};
        return $self;
    }

    async sub write {
        my ($self, $chunk) = @_;
        return Future->fail('Writer already closed') if $self->{closed};
        $self->{bytes_written} += length($chunk // '');
        await $self->{send}->({
            type => 'http.response.body',
            body => $chunk,
            more => 1,
        });
    }

    async sub close {
        my ($self) = @_;
        return if $self->{closed};
        $self->{closed} = 1;
        await $self->{send}->({
            type => 'http.response.body',
            body => '',
            more => 0,
        });
        $_->() for @{$self->{_on_close}};
    }

    sub on_close {
        my ($self, $cb) = @_;
        push @{$self->{_on_close}}, $cb;
        return $self;
    }

    sub is_closed { $_[0]->{closed} }

    sub bytes_written { $_[0]->{bytes_written} }
}
```

- [ ] **Step 4: Run test to verify it passes**

Run: `bash -c 'source ~/perl5/perlbrew/etc/bashrc && perlbrew use perl-5.40.0@default && RELEASE_TESTING=1 prove -l t/response-writer.t'`

Expected: PASS

- [ ] **Step 5: Run existing response tests for regressions**

docs/superpowers/plans/2026-04-06-response-writer.md  view on Meta::CPAN

subtest 'writer() prevents double send' => sub {
    my ($res, $sent) = make_response();

    $res->writer->get;

    like dies { $res->writer->get }, qr/already sent/i, 'second writer() croaks';
};

subtest 'writer() chains with response methods' => sub {
    my ($res, $sent) = make_response();

    my $writer = $res
        ->status(201)
        ->content_type('application/x-ndjson')
        ->header('X-Stream' => 'true')
        ->writer
        ->get;

    is $sent->[0]{status}, 201, 'status from chain';
    my %headers = map { $_->[0] => $_->[1] } @{$sent->[0]{headers}};
    is $headers{'content-type'}, 'application/x-ndjson', 'content-type from chain';
    is $headers{'x-stream'}, 'true', 'custom header from chain';
};
```

- [ ] **Step 2: Run test to verify it fails**

Run: `bash -c 'source ~/perl5/perlbrew/etc/bashrc && perlbrew use perl-5.40.0@default && RELEASE_TESTING=1 prove -l t/response-writer.t'`

Expected: FAIL — `Can't locate object method "writer"`

- [ ] **Step 3: Implement `writer()` on Response**

In `lib/PAGI/Response.pm`, add the `writer` method after the `stream` method (around line 993):

```perl
async sub writer {
    my ($self, %opts) = @_;
    $self->_mark_sent;

    # Send headers
    await $self->{send}->({
        type    => 'http.response.start',
        status  => $self->status,
        headers => $self->{_headers},
    });

    return PAGI::Response::Writer->new($self->{send}, %opts);
}
```

- [ ] **Step 4: Run test to verify it passes**

Run: `bash -c 'source ~/perl5/perlbrew/etc/bashrc && perlbrew use perl-5.40.0@default && RELEASE_TESTING=1 prove -l t/response-writer.t'`

Expected: PASS

- [ ] **Step 5: Run all response tests**

Run: `bash -c 'source ~/perl5/perlbrew/etc/bashrc && perlbrew use perl-5.40.0@default && RELEASE_TESTING=1 prove -l t/response.t t/response-writer.t t/02-streaming.t'`

Expected: PASS

- [ ] **Step 6: Commit**

```bash
git add lib/PAGI/Response.pm t/response-writer.t
git commit -m "feat: add push-style writer() method to PAGI::Response"
```

---

## Task 4: `on_close` Fires on Auto-Close from `stream()`

### Files
- Modify: `t/response-writer.t`

- [ ] **Step 1: Write test — `on_close` fires when `stream()` auto-closes the writer**

Append to `t/response-writer.t` (before `done_testing`):

```perl
subtest 'on_close fires on stream() auto-close' => sub {
    my ($res, $sent) = make_response();
    my @fired;

    $res->stream(async sub {
        my ($writer) = @_;
        $writer->on_close(sub { push @fired, 'auto' });
        await $writer->write("data");
        # Do NOT call $writer->close — let stream() auto-close
    })->get;

    is \@fired, ['auto'], 'on_close fires when stream() auto-closes writer';
};

subtest 'on_close fires only once even with explicit + auto close' => sub {
    my ($res, $sent) = make_response();
    my $count = 0;

    $res->stream(async sub {
        my ($writer) = @_;
        $writer->on_close(sub { $count++ });
        await $writer->write("data");
        await $writer->close;
        # stream() will also try to close, but close() is idempotent
    })->get;

    is $count, 1, 'on_close fires exactly once (close is idempotent)';
};
```

- [ ] **Step 2: Run test to verify it passes**

Run: `bash -c 'source ~/perl5/perlbrew/etc/bashrc && perlbrew use perl-5.40.0@default && RELEASE_TESTING=1 prove -l t/response-writer.t'`

Expected: PASS — `stream()` calls `$writer->close()` at the end (line 992 of Response.pm), and `close()` fires `on_close` callbacks. The idempotent guard in `close()` prevents double-firing.

- [ ] **Step 3: Commit**