package TestModperl::printf;

use strict;
use warnings FATAL => 'all';

use Apache2::RequestIO ();
use Apache2::RequestRec ();
use APR::Table ();

use Apache2::Const -compile => qw(OK);

sub handler {
    my $r = shift;

    my $tests = 4;

    $r->printf("1..%d\n", $tests);

    # ok 1
    $r->printf("ok");
    $r->printf(" %d\n", 1);

    # ok 2
    my $fmt = "%s%s %d\n";
    $r->printf($fmt, qw(o k), 2);

    # ok 3
    my @a = ("ok %d%c", 3, ord("\n"));
    $r->PRINTF(@a);

    # ok 4 (gets input from the fixup handler via notes)
    {
        my $note = $r->notes->get("fixup") || '';
        my $ok = $note =~ 
            /\$r->printf can't be called before the response phase/;
        $r->print("not ") unless $ok;
        $r->print("ok 4\n");
        $r->print("# either fixup was successful at printing to the\n",
                  "# client (which shouldn't happen before the\n",
                  "# response phase), or the note was lost/never set\n")
            unless $ok;
        $r->notes->clear;
    }

    Apache2::Const::OK;
}

sub fixup {
    my $r = shift;

    # it's not possible to send a response body before the response
    # phase
    eval { $r->printf("whatever") };
    $r->notes->set(fixup => "$@") if $@;

    Apache2::Const::OK;
}

1;
__END__
PerlModule TestModperl::printf
PerlFixupHandler TestModperl::printf::fixup