Dogcows Code - chaz/p5-CGI-Ex/blob - samples/devel/dprof_template.d

   1 # -*-perl-*-
   2 # run with perl -d:DProf $0 ; dprofpp
   3
   4 use strict;
   5 use POSIX qw(tmpnam);
   6 use File::Path qw(rmtree);
   7 use CGI::Ex::Template;
   8 #use CGI::Ex::Template_60;
   9
  10 my $tt_cache_dir = tmpnam;
  11 END { rmtree $tt_cache_dir };
  12 mkdir $tt_cache_dir, 0755;
  13
  14 my $cet = CGI::Ex::Template->new(ABSOLUTE => 1);
  15 #use Template;
  16 #my $cet = Template->new(ABSOLUTE => 1);
  17
  18 ###----------------------------------------------------------------###
  19
  20 my $swap = {
  21     one   => "ONE",
  22     two   => "TWO",
  23     three => "THREE",
  24     a_var => "a",
  25     hash  => {a => 1, b => 2, c => { d => ["hmm"] }},
  26     array => [qw(A B C D E a A)],
  27     code  => sub {"($_[0])"},
  28     cet   => $cet,
  29 };
  30
  31 my $txt = '';
  32 $txt .= "[% one %]\n";
  33 $txt .= ((" "x1000)."[% one %]\n")x100;
  34 $txt .= "[%f=10; WHILE (g=f) ; f = f - 1 ; f ; END %]";
  35 $txt .= ("[% \"".(" "x10)."\$one\" %]\n")x1000;
  36
  37 my $file = \$txt;
  38
  39 if (1) {
  40     $file = $tt_cache_dir .'/template.txt';
  41     open(my $fh, ">$file") || die "Couldn't open $file: $!";
  42     print $fh $txt;
  43     close $fh;
  44 }
  45
  46 ###----------------------------------------------------------------###
  47
  48 sub cet {
  49     my $out = '';
  50     $cet->process($file, $swap, \$out);
  51     return $out;
  52 }
  53
  54 cet() for 1 .. 500;