view release on metacpan or  search on metacpan

examples/bench.pl  view on Meta::CPAN

use strict;
use warnings;
use Getopt::Long;
use Benchmark qw/ timethese cmpthese /;
use FindBin qw/ $RealBin /;
chdir "$RealBin/..";
#use Devel::Size qw(size total_size);
my $count = 0;
mkdir "cache";
mkdir "cache/htc";
mkdir "cache/htcc";
mkdir "cache/hte";
mkdir "cache/htpl";
mkdir "cache/jit";
my %use = (
	'HTML::Template'           => 0,
    'HTML::Template::Pro'      => 0,
	'HTML::Template::Compiled' => 0,
	'HTML::Template::Pluggable' => 0,
	'HTML::Template::Expr' => 0,
	'HTML::Template::Compiled::Classic' => 0,
#	'HTML::Template::JIT'      => 0,
	'Template'                 => 0,
    'Template::Alloy'                 => 0,
    'Template::HTML'           => 0,
    'Template::AutoFilter'     => 0,
    'Template::Like'           => 0,
	'CGI::Ex::Template'        => 0,
	# not yet
	'Text::ScriptTemplate'     => 0,
    'Text::Xslate'             => 0,
);
for my $key (sort keys %use) {
	eval "require $key";
	$use{$key} = 1 unless $@;
	my $version = $use{$key} ? $key->VERSION : "-";
    printf "using %35s %s\n", $key, $version;
}
HTML::Template::Compiled->clear_filecache("cache/htc");
HTML::Template::Compiled->clear_filecache("cache/htcc");
my $debug = 0;
$ENV{'HTML_TEMPLATE_ROOT'} = "examples";
my $FILE_CACHE     = 0;
my $MEM_CACHE      = 1;
my $LOOP_CONTEXT   = 1;
my $GLOBAL_VARS    = 0;
my $CASE_SENSITIVE = 1;
my $default_escape = 0;
my $template_size  = 1;
my $bench          = 'timethese';
GetOptions(
    "file-cache=i" => \$FILE_CACHE,
    "mem-cache=i" => \$MEM_CACHE,
    "loop-context=i" => \$LOOP_CONTEXT,
    "global-vars=i" => \$GLOBAL_VARS,
    "case-sensitive=i" => \$CASE_SENSITIVE,
    "default-escape=i" => \$default_escape,
    "template-size=i" => \$template_size,
    "bench=s" => \$bench,
);
my $iterations = shift;
my $ht_file = 'test.htc';
my $htcc_file = $ht_file . 'c';
my $tt_file = "test.tt";
my $tst_file = "test.tst";
my $xslfile = "test.xslate";
$template_size =~ tr/0-9//cd;
if ($template_size > 1) {
    for my $file ($ht_file, $htcc_file, $tt_file, $tst_file, $xslfile) {
        open my $fh, "<", "examples/$file" or die "examples/$file: $!";
        my $data = do { local $/; <$fh> };
        my $new_file = "$file.n$template_size";
        open my $out, ">", "examples/$new_file" or die $!;
        print $out $data x $template_size;
        $file = $new_file;
    }
}

print "running with:
--file-cache $FILE_CACHE --mem-cache $MEM_CACHE --loop-context $LOOP_CONTEXT "
. "--global-vars $GLOBAL_VARS --case-sensitive $CASE_SENSITIVE "
. "--default-escape $default_escape --template-size=$template_size
";

my $STDOUT = 0;
sub new_htc {
	my $t1 = HTML::Template::Compiled->new_file( $ht_file,
		#path => 'examples',
		case_sensitive => $CASE_SENSITIVE, # slow down
		loop_context_vars => $LOOP_CONTEXT,
        $default_escape ? (default_escape => 'HTML') : (),
		debug => $debug,
		# note that you have to create the cachedir
		# first, otherwise it will run without cache
#        cache_dir => ($FILE_CACHE ? "cache/htc" : undef),
        file_cache_dir => ($FILE_CACHE ? "cache/htc" : undef),
        file_cache => ($FILE_CACHE ? 1 : undef),

        cache => $MEM_CACHE,
		out_fh => $STDOUT ? 1 : 0,
        global_vars => $GLOBAL_VARS,
        tagstyle => [qw(-asp -comment)],
		expire_time => 1000,
	);
	return $t1;
}

sub new_htcc {
	my $t1 = HTML::Template::Compiled::Classic->new_file( $htcc_file,
		#path => 'examples',
		case_sensitive => $CASE_SENSITIVE, # slow down
		loop_context_vars => $LOOP_CONTEXT,
        $default_escape ? (default_escape => 'HTML') : (),
		debug => $debug,
		# note that you have to create the cachedir
		# first, otherwise it will run without cache
        cache_dir => ($FILE_CACHE ? "cache/htcc" : undef),
        cache => $MEM_CACHE,
		out_fh => $STDOUT ? 1 : 0,
        global_vars => $GLOBAL_VARS,
        debug => 0,

examples/bench.pl  view on Meta::CPAN

            $MEM_CACHE
                ? ()
                : (all_tt_new_object => sub {my $t = new_tt();output_tt($t)}),
        ): (),
        $use{'Template::Alloy'} ? (
            #new_tt => sub {my $t = new_tt();},
            #output_tt => sub {output_tt($global_tt)},
            process_ta => sub {output_tt($global_ta)},
            $MEM_CACHE
                ? ()
                : (all_ta_new_object => sub {my $t = new_ta();output_tt($t)}),
        ): (),
        $use{'Template::AutoFilter'} ? (
            #new_ttaf => sub {my $t = new_ttaf();},
            #output_ttaf => sub {output_ttaf($global_ttaf)},
            process_ttaf => sub {output_ttaf($global_ttaf)},
            $MEM_CACHE
                ? ()
                : (all_ttaf_new_object => sub {my $t = new_ttaf();output_ttaf($t)}),
        ): (),
        $use{'Template::HTML'} ? (
            #new_tt => sub {my $t = new_tt();},
            #output_tt => sub {output_tt($global_tt)},
            process_tth => sub {output_tt($global_tth)},
            $MEM_CACHE
                ? ()
                : (all_tth_new_object => sub {my $t = new_tth();output_tt($t)}),
        ): (),
        $use{'Text::Xslate'} ? (
            #new_tt => sub {my $t = new_tt();},
            #output_tt => sub {output_tt($global_tt)},
            process_xslate => sub {output_xslate($global_xslate)},
            $MEM_CACHE
                ? ()
                : (all_xslate_new_object => sub {my $t = new_xslate();output_xslate($t)}),
        ): (),
        $use{'Template::Like'} ? (
            process_tl => sub {output_tl($global_tl)},
        ): (),
        $use{'CGI::Ex::Template'} ? (
            #new_tt => sub {my $t = new_tt();},
            #output_tt => sub {output_tt($global_tt)},
            process_cet => sub {output_tt($global_cet)},
            $MEM_CACHE
                ? ()
                : (all_cet_new_object => sub {my $t = new_cet();output_tt($t)}),
        ): (),
        $use{'Text::ScriptTemplate'} ? (
					#new_tst => sub {my $t = new_tst();},
                    #output_tst => sub {output_tst($global_tst)},
						all_tst => sub {my $t = new_tst();output_tst($t)},
        ): (),
);
# try to align table correctly also for longer strings
my %args_new;
for my $key (keys %args) {
    my $new_key = sprintf "%21s", $key;
    $args_new{ $new_key } = $args{ $key };
}
if ($bench eq 'timethese') {
    timethese ($iterations||-1, {
        %args_new
 	});
}
elsif ($bench eq 'cmpthese') {
    cmpthese ($iterations||-1, {
        %args_new
 	});
}
}
__END__