view release on metacpan or  search on metacpan

t/testcases/Web/WebBenchmark.pm  view on Meta::CPAN

package testcases::Web::WebBenchmark;
use strict;
use JSON;
use XAO::Utils;
use XAO::Objects;
use XAO::Projects;

use base qw(XAO::testcases::Web::base);

###############################################################################

sub test_all {
    my $self=shift;

    my $page=XAO::Objects->new(objname => 'Web::Page');
    my $benchmark=XAO::Objects->new(objname => 'Web::Benchmark');
    my $benchmark2=XAO::Objects->new(objname => 'Web::Benchmark');

    $benchmark->expand('mode' => 'system-start');

    $self->assert($page->benchmark_enabled(),
        "Benchmarking is not enabled after 'benchmark-start'");

    $benchmark->expand('mode' => 'system-stop');

    $self->assert(! $page->benchmark_enabled(),
        "Benchmarking is not disabled after 'benchmark-stop'");

    $benchmark->expand('mode' => 'system-start');

    $self->assert($page->benchmark_enabled(),
        "Benchmarking is not enabled after 'benchmark-start' (2)");

    $page->expand(template => 'blah');

    $benchmark->expand('mode' => 'enter', tag => 'test');

    for(1..10) {
        $page->expand(path => '/bits/system-test', 'xao.cacheable' => 1, TEST => 'foo', RUN => ($_ <= 5 ? $_ : 'X'));
        $page->expand(path => '/bits/complex-template', RUN => ($_ <= 5 ? $_ : 'X'));
        $page->expand(path => '/bits/test-recurring', RUN => ($_ <= 5 ? $_ : 'X'));
        $page->clipboard->put('test_clipboard' => $_ * 10);
        $page->expand(path => '/bits/test-non-cacheable', FOO => ($_ <= 5 ? 'A' : 'B'));
    }

    for(1..20) {
        $page->expand(path => '/bits/complex-template');
    }

    $benchmark2->expand('mode' => 'leave', tag => 'test');

    my $stats=$page->benchmark_stats();

    ### dprint "STATS: ".to_json($stats,{pretty => 1, utf8 => 1, canonical => 1});

    $self->assert(ref $stats eq 'HASH',
        "Expected to get a HASH from benchmark_stats()");

    my $stats2=XAO::Objects->new(objname => 'Web::Action')->benchmark_stats();

    $self->assert(ref $stats2 eq 'HASH',
        "Expected to get a HASH from benchmark_stats()");

    my $json1=to_json($stats,{ canonical => 1 });
    my $json2=to_json($stats2,{ canonical => 1 });

    $self->assert($json1 eq $json2,
        "Expected to get identical stats from two web objects ($json1 != $json2)");

    my %counts=(
        'test'                      => [ 1,  1,  1, 0 ],
        'p:/bits/system-test'       => [ 10, 6,  1, 1 ],
        'p:/bits/complex-template'  => [ 30, 7,  1, 0 ],
        'p:/bits/test-recurring'    => [ 20, 7,  1, 0 ],
        'p:/bits/test-non-cacheable'=> [ 10, 2,  0, 0 ],
    );

    foreach my $tag (keys %counts) {
        my $tag_stats=$page->benchmark_stats($tag);

        $json1=to_json({ $tag => $stats->{$tag}},{ canonical => 1 });
        $json2=to_json($tag_stats,{ canonical => 1 });

        $self->assert($json1 eq $json2,
            "Expected tag-specific stats ($json2) be the same as global value ($json1)");

        my $tagdata=$stats->{$tag};

        my $count=$tagdata->{'count'} || 0;
        $self->assert($count == $counts{$tag}->[0],
            "Expected '$tag' count to be $counts{$tag}->[0], got $count");

        $self->assert(defined $tagdata->{'average'} && $tagdata->{'average'} >= 0,
            "Expected 'average' for '$tag' to be positive");

        $self->assert(defined $tagdata->{'median'} && $tagdata->{'median'} >= 0,
            "Expected 'median' for '$tag' to be positive");

        $self->assert(ref $tagdata->{'last'} eq 'ARRAY',
            "Expected 'last' for '$tag' to be an array");

        $self->assert(scalar(@{$tagdata->{'last'}}) > 0,