[Templates-cvs] cvs commit: TT3/benchmark/lib/Scanner/TT2 Handler.pm Interp.pm List.pm Null.pm TT2.pm iNull.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Fri, 19 Dec 2003 12:08:26 +0000
cvs 03/12/19 12:08:24
Added: benchmark/lib/Scanner/TT2 Handler.pm Interp.pm List.pm
Null.pm TT2.pm iNull.pm
Log:
added benchmark files
Revision Changes Path
1.1 TT3/benchmark/lib/Scanner/TT2/Handler.pm
Index: Handler.pm
===================================================================
# scanner which uses the code from TT2 split_text() but calls the
# handler methods rather than pushing items onto a list
package Scanner::TT2::Handler;
use Template::TT3::Constants qw( :chomp );
use Template::TT3::Scanner;
use base qw( Template::TT3::Scanner );
use vars qw( $DEBUG );
use strict;
use warnings;
sub init {
my ($self, $config) = @_;
$self->SUPER::init($config) || return;
$self->{ style } = {
START_TAG => '\[%',
END_TAG => '%\]',
ANYCASE => 0,
INTERPOLATE => 0,
PRE_CHOMP => 0,
POST_CHOMP => 0,
V1DOLLAR => 0,
EVAL_PERL => 0,
};
return $self;
};
sub scan {
my ($self, $textref, $handler) = @_;
my $text = ref $textref ? $$textref : $textref;
my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags);
my $style = $self->{ style };
my ($start, $end, $prechomp, $postchomp, $interp ) =
@$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) };
my @tokens = ();
my $line = 1;
return \@tokens ## RETURN ##
unless defined $text && length $text;
# extract all directives from the text
while ($text =~ s/
^(.*?) # $1 - start of line up to directive
(?:
$start # start of tag
(.*?) # $2 - tag contents
$end # end of tag
)
//sx) {
($pre, $dir) = ($1, $2);
$pre = '' unless defined $pre;
$dir = '' unless defined $dir;
$postlines = 0; # denotes lines chomped
$prelines = ($pre =~ tr/\n//); # NULL - count only
$dirlines = ($dir =~ tr/\n//); # ditto
# the directive CHOMP options may modify the preceding text
for ($dir) {
# remove leading whitespace and check for a '-' chomp flag
s/^([-+\#])?\s*//s;
if ($1 && $1 eq '#') {
# comment out entire directive except for any chomp flag
$dir = ($dir =~ /([-+])$/) ? $1 : '';
}
else {
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $prechomp);
my $space = $prechomp == CHOMP_COLLAPSE
? ' ' : '';
# chomp off whitespace and newline preceding directive
$chomp and $pre =~ s/(\n|^)([ \t]*)\Z/($1||$2) ? $space : ''/me
and $1 eq "\n"
and $prelines++;
}
# remove trailing whitespace and check for a '-' chomp flag
s/\s*([-+])?\s*$//s;
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $postchomp);
my $space = $postchomp == CHOMP_COLLAPSE
? ' ' : '';
$postlines++
if $chomp and $text =~ s/
^
([ \t]*)\n # whitespace to newline
(?:(.|\n)|$) # any char (not EOF)
/
(($1||$2) ? $space : '') . (defined $2 ? $2 : '')
/ex;
}
# any text preceding the directive can now be added
if (length $pre) {
$handler = $handler->text(\$pre, $line, $prelines)
|| return $self->error($handler->error());
# push(@tokens, $interp
# ? [ $pre, $line, 'ITEXT' ]
# : ('TEXT', $pre) );
$line += $prelines;
}
# and now the directive, along with line number information
if (length $dir) {
# the TAGS directive is a compile-time switch
if ($dir =~ /^TAGS\s+(.*)/i) {
my @tags = split(/\s+/, $1);
if (scalar @tags > 1) {
($start, $end) = map { quotemeta($_) } @tags;
}
# elsif ($tags = $TAG_STYLE->{ $tags[0] }) {
# ($start, $end) = @$tags;
# }
else {
warn "invalid TAGS style: $tags[0]\n";
}
}
else {
$handler = $handler->tag( directive => \$dir, $line, $dirlines );
# DIRECTIVE is pushed as:
# [ $dirtext, $line_no(s), \@tokens ]
# push(@tokens,
# [ $dir,
# ($dirlines
# ? sprintf("%d-%d", $line, $line + $dirlines)
# : $line), $dir ]);
# ### $self->tokenise_directive($dir) ]);
}
}
# update line counter to include directive lines and any extra
# newline chomped off the start of the following text
$line += $dirlines + $postlines;
}
# anything remaining in the string is plain text
$handler = $handler->text(\$text, $line, 0)
|| return $self->error($handler->error())
if length $text;
# push(@tokens, $interp
# ? [ $text, $line, 'ITEXT' ]
# : ( 'TEXT', $text) )
# if length $text;
return \@tokens; ## RETURN ##
return 1;
}
1;
1.1 TT3/benchmark/lib/Scanner/TT2/Interp.pm
Index: Interp.pm
===================================================================
# scanner which uses the code from TT2 split_text() but calls the
# handler methods rather than pushing items onto a list. It also
# runs text through the interpolate_text() method to scan for
# embedded variables
package Scanner::TT2::Interp;
use Template::TT3::Constants qw( :chomp );
use Template::TT3::Scanner;
use base qw( Template::TT3::Scanner );
use vars qw( $DEBUG );
use strict;
use warnings;
sub init {
my ($self, $config) = @_;
$self->SUPER::init($config) || return;
$self->{ style } = {
START_TAG => '\[%',
END_TAG => '%\]',
ANYCASE => 0,
INTERPOLATE => 0,
PRE_CHOMP => 0,
POST_CHOMP => 0,
V1DOLLAR => 0,
EVAL_PERL => 0,
};
return $self;
};
sub scan {
my ($self, $textref, $handler) = @_;
my $text = ref $textref ? $$textref : $textref;
my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags);
my $style = $self->{ style };
my ($start, $end, $prechomp, $postchomp, $interp ) =
@$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) };
my @tokens = ();
my $line = 1;
return \@tokens ## RETURN ##
unless defined $text && length $text;
# extract all directives from the text
while ($text =~ s/
^(.*?) # $1 - start of line up to directive
(?:
$start # start of tag
(.*?) # $2 - tag contents
$end # end of tag
)
//sx) {
($pre, $dir) = ($1, $2);
$pre = '' unless defined $pre;
$dir = '' unless defined $dir;
$postlines = 0; # denotes lines chomped
$prelines = ($pre =~ tr/\n//); # NULL - count only
$dirlines = ($dir =~ tr/\n//); # ditto
# the directive CHOMP options may modify the preceding text
for ($dir) {
# remove leading whitespace and check for a '-' chomp flag
s/^([-+\#])?\s*//s;
if ($1 && $1 eq '#') {
# comment out entire directive except for any chomp flag
$dir = ($dir =~ /([-+])$/) ? $1 : '';
}
else {
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $prechomp);
my $space = $prechomp == CHOMP_COLLAPSE
? ' ' : '';
# chomp off whitespace and newline preceding directive
$chomp and $pre =~ s/(\n|^)([ \t]*)\Z/($1||$2) ? $space : ''/me
and $1 eq "\n"
and $prelines++;
}
# remove trailing whitespace and check for a '-' chomp flag
s/\s*([-+])?\s*$//s;
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $postchomp);
my $space = $postchomp == CHOMP_COLLAPSE
? ' ' : '';
$postlines++
if $chomp and $text =~ s/
^
([ \t]*)\n # whitespace to newline
(?:(.|\n)|$) # any char (not EOF)
/
(($1||$2) ? $space : '') . (defined $2 ? $2 : '')
/ex;
}
# any text preceding the directive can now be added
if (length $pre) {
$handler = $handler->text(\$pre, $line, $prelines)
|| return $self->error($handler->error());
}
# and now the directive, along with line number information
if (length $dir) {
# the TAGS directive is a compile-time switch
if ($dir =~ /^TAGS\s+(.*)/i) {
my @tags = split(/\s+/, $1);
if (scalar @tags > 1) {
($start, $end) = map { quotemeta($_) } @tags;
}
# elsif ($tags = $TAG_STYLE->{ $tags[0] }) {
# ($start, $end) = @$tags;
# }
else {
warn "invalid TAGS style: $tags[0]\n";
}
}
else {
$handler = $handler->tag( directive => \$dir, $line, $dirlines );
}
}
# update line counter to include directive lines and any extra
# newline chomped off the start of the following text
$line += $dirlines + $postlines;
}
# anything remaining in the string is plain text
$handler = $handler->text(\$text, $line, 0)
|| return $self->error($handler->error())
if length $text;
return \@tokens; ## RETURN ##
return 1;
}
sub interpolate_text {
my ($self, $text, $handler, $line) = @_;
my @tokens = ();
my ($pre, $var, $dir);
while ($text =~
/
( (?: \\. | [^\$] ){1,3000} ) # escaped or non-'$' character [$1]
|
( \$ (?: # embedded variable [$2]
(?: \{ ([^\}]*) \} ) # ${ ... } [$3]
|
([\w\.]+) # $word [$4]
)
)
/gx) {
($pre, $var, $dir) = ($1, $3 || $4, $2);
# preceding text
if (defined($pre) && length($pre)) {
$line += $pre =~ tr/\n//;
$pre =~ s/\\\$/\$/g;
$handler->text(\$pre, $line);
}
# $variable reference
if ($var) {
$line += $dir =~ tr/\n/ /;
$handler->tag( directive => \$dir, $line );
}
# other '$' reference - treated as text
elsif ($dir) {
$line += $dir =~ tr/\n//;
$handler->text(\$pre, $line);
}
}
return \@tokens;
}
1;
1.1 TT3/benchmark/lib/Scanner/TT2/List.pm
Index: List.pm
===================================================================
# scanner which uses the code from TT2 split_text() (or close enough),
# pushing items onto a list rather than calling handler methods.
package Scanner::TT2::List;
use Template::TT3::Constants qw( :chomp );
use Template::TT3::Scanner;
use base qw( Template::TT3::Scanner );
use vars qw( $DEBUG );
use strict;
use warnings;
sub init {
my ($self, $config) = @_;
$self->SUPER::init($config) || return;
$self->{ style } = {
START_TAG => '\[%',
END_TAG => '%\]',
ANYCASE => 0,
INTERPOLATE => 0,
PRE_CHOMP => 0,
POST_CHOMP => 0,
V1DOLLAR => 0,
EVAL_PERL => 0,
};
return $self;
};
sub scan {
my ($self, $textref, $handler) = @_;
my $text = ref $textref ? $$textref : $textref;
my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags);
my $style = $self->{ style };
my ($start, $end, $prechomp, $postchomp, $interp ) =
@$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) };
my @tokens = ();
my $line = 1;
return \@tokens ## RETURN ##
unless defined $text && length $text;
# extract all directives from the text
while ($text =~ s/
^(.*?) # $1 - start of line up to directive
(?:
$start # start of tag
(.*?) # $2 - tag contents
$end # end of tag
)
//sx) {
($pre, $dir) = ($1, $2);
$pre = '' unless defined $pre;
$dir = '' unless defined $dir;
$postlines = 0; # denotes lines chomped
$prelines = ($pre =~ tr/\n//); # NULL - count only
$dirlines = ($dir =~ tr/\n//); # ditto
# the directive CHOMP options may modify the preceding text
for ($dir) {
# remove leading whitespace and check for a '-' chomp flag
s/^([-+\#])?\s*//s;
if ($1 && $1 eq '#') {
# comment out entire directive except for any chomp flag
$dir = ($dir =~ /([-+])$/) ? $1 : '';
}
else {
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $prechomp);
my $space = $prechomp == CHOMP_COLLAPSE
? ' ' : '';
# chomp off whitespace and newline preceding directive
$chomp and $pre =~ s/(\n|^)([ \t]*)\Z/($1||$2) ? $space : ''/me
and $1 eq "\n"
and $prelines++;
}
# remove trailing whitespace and check for a '-' chomp flag
s/\s*([-+])?\s*$//s;
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $postchomp);
my $space = $postchomp == CHOMP_COLLAPSE
? ' ' : '';
$postlines++
if $chomp and $text =~ s/
^
([ \t]*)\n # whitespace to newline
(?:(.|\n)|$) # any char (not EOF)
/
(($1||$2) ? $space : '') . (defined $2 ? $2 : '')
/ex;
}
# any text preceding the directive can now be added
if (length $pre) {
push(@tokens, $interp
? [ $pre, $line, 'ITEXT' ]
: ('TEXT', $pre) );
$line += $prelines;
}
# and now the directive, along with line number information
if (length $dir) {
# the TAGS directive is a compile-time switch
if ($dir =~ /^TAGS\s+(.*)/i) {
my @tags = split(/\s+/, $1);
if (scalar @tags > 1) {
($start, $end) = map { quotemeta($_) } @tags;
}
# elsif ($tags = $TAG_STYLE->{ $tags[0] }) {
# ($start, $end) = @$tags;
# }
else {
warn "invalid TAGS style: $tags[0]\n";
}
}
else {
# DIRECTIVE is pushed as:
# [ $dirtext, $line_no(s), \@tokens ]
push(@tokens,
[ $dir,
($dirlines
? sprintf("%d-%d", $line, $line + $dirlines)
: $line), $dir ]);
### $self->tokenise_directive($dir) ]);
}
}
# update line counter to include directive lines and any extra
# newline chomped off the start of the following text
$line += $dirlines + $postlines;
}
# anything remaining in the string is plain text
push(@tokens, $interp
? [ $text, $line, 'ITEXT' ]
: ( 'TEXT', $text) )
if length $text;
return \@tokens; ## RETURN ##
return 1;
}
1;
1.1 TT3/benchmark/lib/Scanner/TT2/Null.pm
Index: Null.pm
===================================================================
# scanner which does nothing more than run the regular expression from
# the TT2 split_text() method.
package Scanner::TT2::Null;
use Template::TT3::Constants qw( :chomp );
use Template::TT3::Scanner;
use base qw( Template::TT3::Scanner );
use vars qw( $DEBUG );
use strict;
use warnings;
sub init {
my ($self, $config) = @_;
$self->SUPER::init($config) || return;
$self->{ style } = {
START_TAG => '\[%',
END_TAG => '%\]',
ANYCASE => 0,
INTERPOLATE => 0,
PRE_CHOMP => 0,
POST_CHOMP => 0,
V1DOLLAR => 0,
EVAL_PERL => 0,
};
return $self;
};
sub scan {
my ($self, $textref, $handler) = @_;
my $text = ref $textref ? $$textref : $textref;
my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags);
my $style = $self->{ style };
my ($start, $end, $prechomp, $postchomp, $interp ) =
@$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) };
my @tokens = ();
my $line = 1;
return \@tokens ## RETURN ##
unless defined $text && length $text;
# extract all directives from the text
while ($text =~ s/
^(.*?) # $1 - start of line up to directive
(?:
$start # start of tag
(.*?) # $2 - tag contents
$end # end of tag
)
//sx) {
}
return 1;
}
1;
1.1 TT3/benchmark/lib/Scanner/TT2/TT2.pm
Index: TT2.pm
===================================================================
package Scanner::TT2;
use Template::TT3::Constants qw( :chomp );
use Template::TT3::Scanner;
use base qw( Template::TT3::Scanner );
use vars qw( $DEBUG );
use strict;
use warnings;
sub init {
my ($self, $config) = @_;
$self->SUPER::init($config) || return;
$self->{ style } = {
START_TAG => '\[%',
END_TAG => '%\]',
ANYCASE => 0,
INTERPOLATE => 0,
PRE_CHOMP => 0,
POST_CHOMP => 0,
V1DOLLAR => 0,
EVAL_PERL => 0,
};
return $self;
};
sub scan {
my ($self, $textref, $handler) = @_;
my $text = ref $textref ? $$textref : $textref;
my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags);
my $style = $self->{ style };
my ($start, $end, $prechomp, $postchomp, $interp ) =
@$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) };
my @tokens = ();
my $line = 1;
return \@tokens ## RETURN ##
unless defined $text && length $text;
# extract all directives from the text
while ($text =~ s/
^(.*?) # $1 - start of line up to directive
(?:
$start # start of tag
(.*?) # $2 - tag contents
$end # end of tag
)
//sx) {
($pre, $dir) = ($1, $2);
$pre = '' unless defined $pre;
$dir = '' unless defined $dir;
$postlines = 0; # denotes lines chomped
$prelines = ($pre =~ tr/\n//); # NULL - count only
$dirlines = ($dir =~ tr/\n//); # ditto
# the directive CHOMP options may modify the preceding text
for ($dir) {
# remove leading whitespace and check for a '-' chomp flag
s/^([-+\#])?\s*//s;
if ($1 && $1 eq '#') {
# comment out entire directive except for any chomp flag
$dir = ($dir =~ /([-+])$/) ? $1 : '';
}
else {
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $prechomp);
my $space = $prechomp == CHOMP_COLLAPSE
? ' ' : '';
# chomp off whitespace and newline preceding directive
$chomp and $pre =~ s/(\n|^)([ \t]*)\Z/($1||$2) ? $space : ''/me
and $1 eq "\n"
and $prelines++;
}
# remove trailing whitespace and check for a '-' chomp flag
s/\s*([-+])?\s*$//s;
$chomp = ($1 && $1 eq '+') ? 0 : ($1 || $postchomp);
my $space = $postchomp == CHOMP_COLLAPSE
? ' ' : '';
$postlines++
if $chomp and $text =~ s/
^
([ \t]*)\n # whitespace to newline
(?:(.|\n)|$) # any char (not EOF)
/
(($1||$2) ? $space : '') . (defined $2 ? $2 : '')
/ex;
}
# any text preceding the directive can now be added
if (length $pre) {
push(@tokens, $interp
? [ $pre, $line, 'ITEXT' ]
: ('TEXT', $pre) );
$line += $prelines;
}
# and now the directive, along with line number information
if (length $dir) {
# the TAGS directive is a compile-time switch
if ($dir =~ /^TAGS\s+(.*)/i) {
my @tags = split(/\s+/, $1);
if (scalar @tags > 1) {
($start, $end) = map { quotemeta($_) } @tags;
}
# elsif ($tags = $TAG_STYLE->{ $tags[0] }) {
# ($start, $end) = @$tags;
# }
else {
warn "invalid TAGS style: $tags[0]\n";
}
}
else {
# DIRECTIVE is pushed as:
# [ $dirtext, $line_no(s), \@tokens ]
push(@tokens,
[ $dir,
($dirlines
? sprintf("%d-%d", $line, $line + $dirlines)
: $line), $dir ]);
### $self->tokenise_directive($dir) ]);
}
}
# update line counter to include directive lines and any extra
# newline chomped off the start of the following text
$line += $dirlines + $postlines;
}
# anything remaining in the string is plain text
push(@tokens, $interp
? [ $text, $line, 'ITEXT' ]
: ( 'TEXT', $text) )
if length $text;
return \@tokens; ## RETURN ##
return 1;
}
1;
1.1 TT3/benchmark/lib/Scanner/TT2/iNull.pm
Index: iNull.pm
===================================================================
# scanner which does runs the basic regular expression from
# the TT2 split_text() method and also a second regular expression
# to handle interpolated variables.
package Scanner::TT2::iNull;
use Template::TT3::Constants qw( :chomp );
use Template::TT3::Scanner;
use base qw( Template::TT3::Scanner );
use vars qw( $DEBUG );
use strict;
use warnings;
sub init {
my ($self, $config) = @_;
$self->SUPER::init($config) || return;
$self->{ style } = {
START_TAG => '\[%',
END_TAG => '%\]',
ANYCASE => 0,
INTERPOLATE => 0,
PRE_CHOMP => 0,
POST_CHOMP => 0,
V1DOLLAR => 0,
EVAL_PERL => 0,
};
return $self;
};
sub scan {
my ($self, $textref, $handler) = @_;
my $text = ref $textref ? $$textref : $textref;
my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags);
my $style = $self->{ style };
my ($start, $end, $prechomp, $postchomp, $interp ) =
@$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) };
my @tokens = ();
my $line = 1;
return \@tokens ## RETURN ##
unless defined $text && length $text;
# extract all directives from the text
while ($text =~ s/
^(.*?) # $1 - start of line up to directive
(?:
$start # start of tag
(.*?) # $2 - tag contents
$end # end of tag
)
//sx) {
if ($pre = $1) {
$self->interpolate_text($pre);
}
}
return 1;
}
sub interpolate_text {
my ($self, $text, $line) = @_;
my @tokens = ();
my ($pre, $var, $dir);
while ($text =~
/
( (?: \\. | [^\$] ){1,3000} ) # escaped or non-'$' character [$1]
|
( \$ (?: # embedded variable [$2]
(?: \{ ([^\}]*) \} ) # ${ ... } [$3]
|
([\w\.]+) # $word [$4]
)
)
/gx) {
}
}
1;