#!/usr/bin/perl
# $Id: bench_mem.pl 1086 2009-07-03 16:45:27Z tinita $
use strict;
use warnings;
use lib "blib/lib";
$|=1;
use File::Copy;
use FindBin qw/ $RealBin /;
chdir "$RealBin/..";
# call perl examples/bench_mem.pl htc 1000
my ($mod, $count) = @ARGV;
usage() unless $mod;
mkdir "examples/mem";
mkdir "examples/memcache";
mkdir "examples/memcache/htc";
mkdir "examples/memcache/jit";
my %modules = (
tt => 'Template',
ht => 'HTML::Template',
htc => 'HTML::Template::Compiled',
htj => 'HTML::Template::JIT',
);
$count ||= 5;
eval "require $modules{$mod}";
#print HTML::Template::Compiled->VERSION,$/;
my %files = (
ht => 'test.htc',
htc => 'test.htc',
htj => 'test.htc',
tt => 'test.tt',
);
my @unique = keys %{ {reverse %files} };
sub new_htc {
my $t = HTML::Template::Compiled->new(
path => 'examples/mem',
loop_context_vars => 1,
filename => $_[0],
cache_dir => "examples/memcache/htc",
#cache => 0,
);
return $t;
}
sub new_ht {
my $t = HTML::Template->new(
path => 'examples/mem',
loop_context_vars => 1,
filename => $_[0],
cache => 1,
);
return $t;
}
sub new_htj {
my $t = HTML::Template::JIT->new(
path => ['examples/mem'],
loop_context_vars => 1,
filename => $_[0],
cache => 1,
jit_path => 'examples/memcache/jit',
);
return $t;
}
my $tt;
if ($mod eq 'tt') {
$tt = Template->new(
COMPILE_EXT => '.ttc',
COMPILE_DIR => 'examples/memcache/tt',
INCLUDE_PATH => 'examples/mem',
);
}
sub new_tt { return $tt }
my %params = (
name => '',
loopa => [{a=>3},{a=>4},{a=>5}],
#a => [qw(b c d)],
loopb => [{ inner => 23 }],
c => [
{
d=>[({F=>11},{F=>22}, {F=>33})]
},
{
d=>[({F=>44}, {F=>55}, {F=>66})]
}
],
if2 => 1,
if3 => 0,
blubber => "html <test>",
);
open OUT, ">>/dev/null";
#open OUT, ">&STDOUT";
my $cparam = $count;
my $ht_out = sub {
my $t = shift;
return unless defined $t;
$params{name} = (ref $t).' '.$cparam++;
$t->param(%params);
my $out = $t->output;
$t->param({});
print OUT $out;
};
my $outputs = {
ht => $ht_out,
htc => $ht_out,
htj => $ht_out,
tt => sub {
my ($t,$f) = @_;
return unless defined $t;
#print OUT "TT $f\n";
$t->process($f, \%params, \*OUT);
},
};
my $news = {
tt => \&new_tt,
ht => \&new_ht,
htc => \&new_htc,
htj => \&new_htj,
};
{
my $file = $files{$mod};
print "File $file\n";
-f "examples/mem/included.tt" or
copy "examples/included.tt", "examples/mem/included.tt" or die $!;
-f "examples/mem/included.htc" or
copy "examples/included.htc", "examples/mem/included.htc" or die $!;
# preprocess half of the templates
my $t = process($count/2, $mod, $file);
print_top("root");
for my $i (1..2) {
if (my $pid = fork) {
}
else {
print "Starting loop $i\n";
my $t = process($count, $mod, $file);
print_top($i);
print "End loop $i\n";
exit;
}
}
print "Waiting for child processes to finish\n";
wait;
print "Still waiting for child processes to finish\n";
wait;
print "Finished child processes\n";
print_top("root");
#<STDIN>;
}
sub print_top {
my $top = qx{top -b -n 1 |grep $$};
#my $top = qx{top -b -n 1 |grep perl};
chomp $top;
print "\ntop($_[0]) PID $$:\n$top\n";
}
sub process {
my ($count, $mod, $file) = @_;
for my $i ( 1 .. $count ) {
my $dup = sprintf "%s.%02d", $file, $i;
-f "examples/mem/$dup"
or copy "examples/$file", "examples/mem/$dup"
or die $!;
my $t;
if ($mod eq 'tt') {
$t = $tt;
}
else {
$t = $news->{$mod}->("$dup") or die $!;
}
#print STDERR "$mod '$t' loop '$i'\r";
$outputs->{$mod}->( $t, $dup ) or die $t->error;
#select undef, undef, undef, 1/($count/5);
}
}
sub usage {
print <<"EOM";
Usage: $0 (tt|ht|htc) num
Example: 100 iterations for TT:
$0 tt 100
EOM
exit;
}
__END__
-- with caching the template objects extra
:!perl examples/bench_mem.pl htj 500
File test.htc
htj 'tmpl_3588d6c4e3fc6254d1133a51e4c439b0' loop '500'
top: 744 tina 25 0 18980 16m 10m S 0.0 3.3 0:07.74 perl
:!perl examples/bench_mem.pl ht 500
File test.htc
ht 'HTML::Template=HASH(0x89ae50c)' loop '500'
top: 754 tina 25 0 11928 10m 2648 S 0.0 2.0 0:02.61 perl
:!perl examples/bench_mem.pl tt 500
File test.tt
tt 'Template=HASH(0xa184104)' loop '500'
top: 759 tina 24 0 36556 34m 2668 S 0.0 6.7 0:03.15 perl
:!perl examples/bench_mem.pl htc 500
File test.htc
htc 'HTML::Template::Compiled=ARRAY(0x94a0f44)' loop '500'
top: 764 tina 25 0 23272 21m 2732 S 0.0 4.2 0:01.54 perl
-- without caching the template objects extra
:!perl examples/bench_mem.pl htj 500
File test.htc
htj 'tmpl_3588d6c4e3fc6254d1133a51e4c439b0' loop '500'
top: 784 tina 25 0 18964 16m 10m S 0.0 3.3 0:07.76 perl
:!perl examples/bench_mem.pl ht 500
File test.htc
ht 'HTML::Template=HASH(0x88b62dc)' loop '500'
top: 792 tina 25 0 10900 9312 2648 S 0.0 1.8 0:02.66 perl
:!perl examples/bench_mem.pl tt 500
File test.tt
tt 'Template=HASH(0x8366640)' loop '500'
top: 797 tina 25 0 5744 4084 2668 S 0.0 0.8 0:03.62 perl
:!perl examples/bench_mem.pl htc 500
File test.htc
htc 'HTML::Template::Compiled=ARRAY(0x9498650)' loop '500'
top: 788 tina 25 0 23256 21m 2732 S 0.0 4.2 0:01.55 perl