package Template::Benchmark::Engines::HTMLMason;

use warnings;
use strict;

use base qw/Template::Benchmark::Engine/;

use HTML::Mason;
use HTML::Mason::Interp;

use File::Spec;

our $VERSION = '1.09_01';

our %feature_syntaxes = (
    literal_text              =>
        join( "\n", ( join( ' ', ( 'foo' ) x 12 ) ) x 5 ),
    scalar_variable           =>
        '<% $ARGS{scalar_variable} %>',
    hash_variable_value       =>
        '<% $ARGS{hash_variable}->{hash_value_key} %>',
    array_variable_value      =>
        '<% $ARGS{array_variable}->[ 2 ] %>',
    deep_data_structure_value =>
        '<% $ARGS{this}->{is}{a}{very}{deep}{hash}{structure} %>',
    array_loop_value          =>
        '<%perl>foreach ( @{$ARGS{array_loop}} ) {</%perl>' .
        '<% $_ %>' .
        '<%perl>}</%perl>' . "\n",
    hash_loop_value           =>
        '<%perl>foreach ( sort( keys( %{$ARGS{hash_loop}} ) ) ) {</%perl>' .
        '<% $_ %>: <% $ARGS{hash_loop}->{$_} %>' .
        '<%perl>}</%perl>' . "\n",
    records_loop_value        =>
        '<%perl>foreach ( @{$ARGS{records_loop}} ) {</%perl>' .
        '<% $_->{ name } %>: <% $_->{ age } %>' .
        '<%perl>}</%perl>' . "\n",
    array_loop_template       =>
        '<%perl>foreach ( @{$ARGS{array_loop}} ) {</%perl>' .
        '<% $_ %>' .
        '<%perl>}</%perl>' . "\n",
    hash_loop_template        =>
        '<%perl>foreach ( sort( keys( %{$ARGS{hash_loop}} ) ) ) {</%perl>' .
        '<% $_ %>: <% $ARGS{hash_loop}->{$_} %>' .
        '<%perl>}</%perl>' . "\n",
    records_loop_template     =>
        '<%perl>foreach ( @{$ARGS{records_loop}} ) {</%perl>' .
        '<% $_->{ name } %>: <% $_->{ age } %>' .
        '<%perl>}</%perl>' . "\n",
    constant_if_literal       =>
        '<%perl>if( 1 ) {</%perl>true<%perl>}</%perl>' . "\n",
    variable_if_literal       =>
        '<%perl>if( $ARGS{variable_if} ) {</%perl>true<%perl>}</%perl>' . "\n",
    constant_if_else_literal  =>
        '<%perl>if( 1 ) {</%perl>true<%perl>} else {</%perl>' .
        'false<%perl>}</%perl>' . "\n",
    variable_if_else_literal  =>
        '<%perl>if( $ARGS{variable_if_else} ) {</%perl>true<%perl>} ' .
        'else {</%perl>false<%perl>}</%perl>' . "\n",
    constant_if_template      =>
        '<%perl>if( 1 ) {</%perl>' .
        '<% $ARGS{template_if_true} %><%perl>}</%perl>' . "\n",
    variable_if_template      =>
        '<%perl>if( $ARGS{variable_if} ) {</%perl>' .
        '<% $ARGS{template_if_true} %><%perl>}</%perl>' . "\n",
    constant_if_else_template =>
        '<%perl>if( 1 ) {</%perl>' .
        '<% $ARGS{template_if_true} %><%perl>} ' .
        'else {</%perl>' .
        '<% $ARGS{template_if_false} %><%perl>}</%perl>' . "\n",
    variable_if_else_template =>
        '<%perl>if( $ARGS{variable_if_else} ) {</%perl>' .
        '<% $ARGS{template_if_true} %><%perl>} ' .
        'else {</%perl>' .
        '<% $ARGS{template_if_false} %><%perl>}</%perl>' . "\n",
    constant_expression       =>
        '<% 10 + 12 %>',
    variable_expression       =>
        '<% $ARGS{variable_expression_a} * $ARGS{variable_expression_b} %>',
    complex_variable_expression =>
        '<% ( ( $ARGS{variable_expression_a} * $ARGS{variable_expression_b} ) + ' .
        '$ARGS{variable_expression_a} - $ARGS{variable_expression_b} ) / ' .
        '$ARGS{variable_expression_b} %>',
    constant_function         =>
        q[<% substr( 'this has a substring.', 11, 9 ) %>],
    variable_function         =>
        '<% substr( $ARGS{variable_function_arg}, 4, 2 ) %>',
    );

sub syntax_type { return( 'embedded-perl' ); }
sub pure_perl { return( 1 ); }

sub benchmark_descriptions
{
    return( {
        HM    =>
            "HTML::Mason ($HTML::Mason::VERSION)",
        } );
}

#  These flags lifted from HTML::Mason::Admin PERFORMANCE section.
#    code_cache_max_size => 0,  # turn off memory caching
#    use_object_files => 0,     # turn off disk caching
#    static_source => 1,        # turn off disk stat()s
#    enable_autoflush = 0,      # turn off dynamic autoflush checking

sub benchmark_functions_for_uncached_string
{
    my ( $self ) = @_;

    return( {
        HM =>
            sub
            {
                my $out = '';
                my $t = HTML::Mason::Interp->new(
                    code_cache_max_size => 0,
                    use_object_files    => 0,
                    static_source    => 1,
                    enable_autoflush => 0,
                    out_method       => \$out,
                    );

                my $c = $t->make_component(
                    comp_source => $_[ 0 ],
                    );

                $t->exec(
                    $c,
                    %{$_[ 1 ]}, %{$_[ 2 ]},
                    );
                \$out;
            },
        } );
}

sub benchmark_functions_for_uncached_disk
{
    my ( $self, $template_dir ) = @_;

    return( {
        HM =>
            sub
            {
                my $out = '';
                my $t = HTML::Mason::Interp->new(
                    comp_root        => $template_dir,
                    code_cache_max_size => 0,
                    use_object_files    => 0,
                    static_source    => 1,
                    enable_autoflush => 0,
                    out_method       => \$out,
                    );

                $t->exec(
                    #  Don't use File::Spec, Mason reads it like a URL path.
                    '/' . $_[ 0 ],
                    %{$_[ 1 ]}, %{$_[ 2 ]},
                    );
                \$out;
            },
        } );
}

sub benchmark_functions_for_disk_cache
{
    my ( $self, $template_dir, $cache_dir ) = @_;

    return( {
        HM =>
            sub
            {
                my $out = '';
                my $t = HTML::Mason::Interp->new(
                    comp_root        => $template_dir,
                    data_dir         => $cache_dir,
                    code_cache_max_size => 0,
                    static_source    => 1,
                    enable_autoflush => 0,
                    out_method       => \$out,
                    );

                $t->exec(
                    #  Don't use File::Spec, Mason reads it like a URL path.
                    '/' . $_[ 0 ],
                    %{$_[ 1 ]}, %{$_[ 2 ]},
                    );
                \$out;
            },
        } );
}

sub benchmark_functions_for_shared_memory_cache
{
    my ( $self, $template_dir, $cache_dir ) = @_;

    return( undef );
}

sub benchmark_functions_for_memory_cache
{
    my ( $self, $template_dir, $cache_dir ) = @_;

    return( {
        HM =>
            sub
            {
                my $out = '';
                my $t = HTML::Mason::Interp->new(
                    comp_root        => $template_dir,
                    data_dir         => $cache_dir,
                    static_source    => 1,
                    enable_autoflush => 0,
                    out_method       => \$out,
                    );

                $t->exec(
                    #  Don't use File::Spec, Mason reads it like a URL path.
                    '/' . $_[ 0 ],
                    %{$_[ 1 ]}, %{$_[ 2 ]},
                    );
                \$out;
            },
        } );
}

sub benchmark_functions_for_instance_reuse
{
    my ( $self, $template_dir, $cache_dir ) = @_;
    my ( $t, $out );

    $t = HTML::Mason::Interp->new(
        comp_root        => $template_dir,
        data_dir         => $cache_dir,
        static_source    => 1,
        enable_autoflush => 0,
        out_method       => \$out,
        );

    return( {
        HM =>
            sub
            {
                $out = '';
                $t->exec(
                    #  Don't use File::Spec, Mason reads it like a URL path.
                    '/' . $_[ 0 ],
                    %{$_[ 1 ]}, %{$_[ 2 ]},
                    );
                \$out;
            },
        } );
}

1;

__END__

=pod

=head1 NAME

Template::Benchmark::Engines::HTMLMason - Template::Benchmark plugin for HTML::Mason.

=head1 SYNOPSIS

Provides benchmark functions and template feature syntaxes to allow
L<Template::Benchmark> to benchmark the L<HTML::Mason> template
engine.

=head1 AUTHOR

Sam Graham, C<< <libtemplate-benchmark-perl at illusori.co.uk> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-template-benchmark at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Template-Benchmark>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Template::Benchmark::Engines::HTMLMason


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Template-Benchmark>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Template-Benchmark>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Template-Benchmark>

=item * Search CPAN

L<http://search.cpan.org/dist/Template-Benchmark/>

=back


=head1 ACKNOWLEDGEMENTS

Thanks to Paul Seamons for creating the the bench_various_templaters.pl
script distributed with L<Template::Alloy>, which was the ultimate
inspiration for this module.

=head1 COPYRIGHT & LICENSE

Copyright 2010 Sam Graham.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut