view release on metacpan or  search on metacpan

t/07.accept.t  view on Meta::CPAN

    }

    # Wildcard higher q than specific -> wildcard wins (first supported)
    {
        local $Apache2::API::Headers::AcceptCommon::MATCH_PRIORITY_0_01_STYLE = 0;
        my $ac = Apache2::API::Headers::Accept->new( '*/*;q=1.0, application/json;q=0.9', debug => $DEBUG );
        is(
            $ac->match( [ 'image/png', 'text/html', 'application/json' ] ),
            'image/png',
            'Higher q wildcard chooses first supported'
        );
    }
};

subtest 'preferences consistency' => sub
{
    my $ac = Apache2::API::Headers::Accept->new( 'text/plain;q=0.4, text/html;q=0.9, application/json', debug => $DEBUG );
    my $prefs = $ac->preferences;
    isa_ok( $prefs, 'ARRAY', 'Accept::preferences returns arrayref (first call)' );
    my $prefs2 = $ac->preferences;
    isa_ok( $prefs2, 'ARRAY', 'Accept::preferences returns arrayref (cached path)' );
    is_deeply( $prefs2, $prefs, 'Accept::preferences cached == initial' );
};

subtest 'mismatch priority mode' => sub
{
    # In legacy mode, at equal q, priority follows the OFFER list rather than header order.
    {
        local $Apache2::API::Headers::Accept::MATCH_PRIORITY_0_01_STYLE = 1;
        my $ac = Apache2::API::Headers::Accept->new( 'text/html;q=0.8, application/json;q=0.8', debug => $DEBUG );
        is(
            $ac->match( [ 'application/json', 'text/html' ] ),
            'application/json',
            'Legacy mode: equal q favors offer order (json first)'
        );
    }

    {
        local $Apache2::API::Headers::Accept::MATCH_PRIORITY_0_01_STYLE = 0;
        my $ac = Apache2::API::Headers::Accept->new( 'text/html;q=0.8, application/json;q=0.8', debug => $DEBUG );
        # In >= 0.02 mode, we iterate by client preference (sorted by q, stable on header order).
        is(
            $ac->match( [ 'application/json', 'text/html' ] ),
            'text/html',
            'Modern mode: equal q favors header order (text/html first in header)'
        );
    }

    # Legacy mode: equal q, prefer offer order BUT do not let wildcard preempt a specific match
    {
        local $Apache2::API::Headers::AcceptCommon::MATCH_PRIORITY_0_01_STYLE = 1;
        my $ac = Apache2::API::Headers::Accept->new( '*/*;q=0.8, application/json;q=0.8', debug => $DEBUG );
        is(
            $ac->match( [ 'application/json', 'text/html' ] ),
            'application/json',
            'Legacy mode: equal q with wildcard present still allows specific to win'
        );
    }
};

subtest 'threads' => sub
{
    SKIP:
    {
        if( !HAS_THREADS )
        {
            skip( 'Threads not available', 3 );
        }
        require threads;
        my @threads = map
        {
            threads->create(sub
            {
                my $tid = threads->tid();
                diag( "Thread $tid parsing 'Accept' header value" ) if( $DEBUG );
                my $accept = Apache2::API::Headers::Accept->new( 'text/html;q=0.9', debug => $DEBUG );
                if( !defined( $accept ) )
                {
                    diag( "Thread $tid failed to parse header: ", Apache2::API::Headers::Accept->error ) if( $DEBUG );
                    return(0);
                }
                return( is( $accept->match( ['text/html'] ), 'text/html', "Thread $_: match" ) ? 1 : 0 );
            });
        } 1..5;
        my $success = 1;
        for my $thr ( @threads )
        {
            $success &&= $thr->join;
        }
        ok( $success, 'All threads tests passed successfully' );
    };
};

done_testing();

__END__