[Templates-cvs] cvs commit: TT3/lib/Template/TT3 Generator.pm Parser.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Tue, 16 Dec 2003 14:36:27 +0000
cvs 03/12/16 14:36:27
Added: lib/Template/TT3 Generator.pm Parser.pm
Log:
* added Template::TT3::Parser, Template::TT3::Generator and
Template::TT3::Generator.
Revision Changes Path
1.1 TT3/lib/Template/TT3/Generator.pm
Index: Generator.pm
===================================================================
#========================================================================
#
# Template::TT3::Generator
#
# DESCRIPTION
# Base class generator for compiling parsed template nodes into some
# other form, typically Perl code.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# REVISION
# $Id: Generator.pm,v 1.1 2003/12/16 14:36:27 abw Exp $
#
#========================================================================
package Template::TT3::Generator;
use strict;
use warnings;
use Template::TT3::Base;
use vars qw( $VERSION $DEBUG $ERROR $WARNING );
use base qw( Template::TT3::Base );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
sub generate {
my ($self, $node) = @_;
return $node unless ref $node;
my ($name, @args) = @$node;
return $self->error("unknown generator node type: $name")
unless $self->can($name);
return $self->$name(@args);
}
1;
__END__
=head1 NAME
Template::TT3::Generator - compiled template generator
=head1 SYNOPSIS
Template::TT3::Generator;
# TODO
=head1 DESCRIPTION
# TODO
=head1 METHODS
=head2 new()
# TODO
=head2 generate($item)
TODO
=head1 AUTHOR
Andy Wardley E<lt>abw@wardley.orgE<gt>
=head1 VERSION
$Revision: 1.1 $
=head1 COPYRIGHT
Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved.
Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4:
1.1 TT3/lib/Template/TT3/Parser.pm
Index: Parser.pm
===================================================================
#========================================================================
#
# Template::TT3::Parser
#
# DESCRIPTION
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# REVISION
# $Id: Parser.pm,v 1.1 2003/12/16 14:36:27 abw Exp $
#
#========================================================================
package Template::TT3::Parser;
use strict;
use warnings;
use Template::TT3::Base;
use vars qw( $VERSION $DEBUG $ERROR $WARNING );
use base qw( Template::TT3::Base );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
#------------------------------------------------------------------------
# regexen used by the parser
#------------------------------------------------------------------------
use vars qw( $BRACKETS $LBRACKET $RBRACKET
$WSPACE $GWSPACE $COMMA $ASSIGN $QUESTION $COLON $RANGE
$HEXNUM $SIGN $FLOAT $EXPONENT $NUMBER $INTEGER
$SQUOTE $DQUOTE $EMBED $INTERP
$IDENT $KEYWORD $FILENAME $RESOURCE $HASHKEY
$DOTOP $UNARYOP $MATHOP $COMPARE $LOGICAL $BINARYOP
$QWLIST $LIST $HASH $PAREN $ENDLIST $ENDHASH $ENDPAREN
);
$BRACKETS = { qw/ ( ) [ ] { } < > / };
$LBRACKET = join('', map { quotemeta } keys %$BRACKETS);
$LBRACKET = qr/ [$LBRACKET] /ox;
$RBRACKET = {
map {
my $end = quotemeta($BRACKETS->{ $_ });
$end = qr/ \G ([^$end]*) $end /x;
($_, $end);
} keys %$BRACKETS,
};
$WSPACE = qr/ \s* (?:\#[^\n]*\n\s*)* /x;
$GWSPACE = qr/ \G $WSPACE /ox;
$COMMA = qr/ \G (?:$WSPACE,)? $WSPACE /ox;
$ASSIGN = qr/ \G $WSPACE (=>?) $WSPACE /ox;
$QUESTION = qr/ \G $WSPACE \? $WSPACE /ox;
$COLON = qr/ \G $WSPACE : $WSPACE /ox;
$RANGE = qr/ \G $WSPACE \.\. $WSPACE /ox;
$HEXNUM = qr/ 0[xX][\dA-Fa-f]+ /x;
$SIGN = qr/ [+-]? /x;
$FLOAT = qr/ (?: \.\d+ )? /x;
$EXPONENT = qr/ (?: [eE][+-]?\d+ )? /x;
$NUMBER = qr/ \G ( $SIGN (?: $HEXNUM | \d+ $FLOAT $EXPONENT ) ) /ox;
$INTEGER = qr/ \G ( $SIGN (?: $HEXNUM | \d+ ) ) /ox;
$SQUOTE = qr/ \G ' ( (?:\\'|[^'])* ) ' /x;
$DQUOTE = qr/ \G " ( (\\\\|\\"|.|\n)*? ) " /x;
$EMBED = qr/ \G \${ $WSPACE ( [^}]+? ) $WSPACE } /ox;
$INTERP = qr/ \G \$ (?= \w+ ) /x;
$IDENT = qr/ \G ( \w+ ) /x;
$KEYWORD = qr/ \G ( \w+ )\b /x;
$FILENAME = qr/ \G ( [\w\.\/:]+ ) /x;
$RESOURCE = qr/ \G ( \w+ ) : ( [\w\.\/:]+ ) /x;
$HASHKEY = qr/ \G $IDENT | $SQUOTE /ox;
$DOTOP = qr/ \G \.(?!\.) /x;
$UNARYOP = qr/ \G $WSPACE ( [-+!] ) /ox;
$MATHOP = qr/ [-+*\/%] /x;
$COMPARE = qr/ [=!<>]= | [<>] /x; # | eq | ne | [lg][et]
$LOGICAL = qr/ &&? | \|\| | or | and /x;
$BINARYOP = qr/ \G $WSPACE ( $MATHOP | $COMPARE | $LOGICAL ) $WSPACE /ox;
$QWLIST = qr/ \G qw ($LBRACKET) /ox;
$LIST = qr/ \G \[ $WSPACE /ox;
$HASH = qr/ \G \{ $WSPACE /ox;
$PAREN = qr/ \G \( $WSPACE /ox;
$ENDLIST = qr/ \G $WSPACE \] /ox;
$ENDHASH = qr/ \G $WSPACE \} /ox;
$ENDPAREN = qr/ \G $WSPACE \) /ox;
#------------------------------------------------------------------------
# init(\%config)
#
# Initialiser method called by base class new() method.
#------------------------------------------------------------------------
sub init {
my ($self, $config) = @_;
$self->{ grammar } = $config->{ grammar };
return $self;
}
#------------------------------------------------------------------------
# grammar() # return current grammar
# grammar($grammar) # install new grammar
#
# Accessor method to get/set reference to grammar.
#------------------------------------------------------------------------
sub grammar {
my $self = shift;
return @_ ? ($self->{ grammar } = shift) : $self->{ grammar };
}
#------------------------------------------------------------------------
# parse_expression($text, \%options)
#
# Implements a left-recursive parse of an expression.
#
# foo && bar && baz && qux
# foo && ( bar && ( baz && qux ) ) # old (incorrect) way
# ( ( foo && bar ) && baz ) && qux # new (correct) way
#
# expression: UNARYOP expression
# | term BINOP expression
# | expression ? expression : expression
#------------------------------------------------------------------------
sub parse_expression {
my ($self, $textref, $options) = @_;
my ($expr, $term, $error, $unop, $binop);
my @tokens = ();
$self->debug("parse_expression()\n") if $DEBUG;
CHUNK: {
# skip any leading whitespace
$$textref =~ /$GWSPACE/cog;
if ($$textref =~ /$UNARYOP/cog ) {
$unop = $1;
if ($term = $self->parse_expression($textref, { first_term => 1 })) {
$term = [ unaryop => $unop, $term ];
}
elsif (defined $term) {
return $self->unexpected( $textref,
"after '$unop' where expression expected" );
}
else {
return undef;
}
}
elsif ($term = $self->parse_term($textref)) {
$self->debug("expr term: @$term\n") if $DEBUG;
}
elsif (defined $term) {
# $term = 0, indicating parse_term() declined
if (@tokens) {
return $self->unexpected($textref,
"after '$binop' where expression expected");
}
else {
$self->debug("no term\n") if $DEBUG;
last CHUNK;
}
}
else {
return;
}
# return the first token if relevant option is set
return $term if $options->{ first_term };
# we got a term, munch munch
push(@tokens, $term);
# is there a binary operator indicating more to come?
if ($$textref =~ /$BINARYOP/cog) {
$binop = $1;
$self->debug("expr binop: $binop\n") if $DEBUG;
push(@tokens, $binop);
redo CHUNK;
}
}
if (@tokens > 1) {
$expr = [ binops => \@tokens ];
}
elsif (@tokens) {
$expr = shift @tokens;
}
else {
return 0; #$self->decline('not an expression');
}
if ($$textref =~ /$QUESTION/cog) {
my ($true, $false);
unless ($true = $self->parse_expression($textref)) {
return defined $true
? $self->unexpected($textref, "after '?' where expression expected")
: undef;
}
$self->debug("expr test [$expr]\n") if $DEBUG;
return $self->error("missing ':' after expression following '?'")
unless $$textref =~ /$COLON/cog;
$self->debug("expr true [$true]\n") if $DEBUG;
unless ($false = $self->parse_expression($textref)) {
return defined $true
? $self->unexpected($textref, "after ':' where expression expected")
: undef;
}
$self->debug("expr false [$false]\n") if $DEBUG;
$expr = [ condition => $expr, $true, $false ];
}
return $expr;
}
#------------------------------------------------------------------------
# parse_term($textref)
#
# term: number # 3.14159
# | squote # 'blah blah'
# | dquote # "blah $var blah"
# | qwlist # qw[ foo bar ]
# | list # [ 1, two, 'three' ]
# | hash # { one => 'foo', two => 'bar' ]
# | parens # ( a ? b : c )
# | variable # foo.bar(3, 5).baz(7, 11)
#------------------------------------------------------------------------
sub parse_term {
my ($self, $textref) = @_;
my ($term);
$self->debug("parse_term(", $self->next_text($textref), ")\n")
if $DEBUG;
# skip any leading whitespace
$$textref =~ /$GWSPACE/cog;
# match one of the term types
if ($$textref =~ /$NUMBER/cog) {
$term = [ number => $1 ];
}
elsif ($$textref =~ /$SQUOTE/cog) {
$term = [ squote => $1 ];
}
elsif ($$textref =~ /$DQUOTE/cog) {
my $text = $1;
$term = $self->parse_dquote(\$text) || return;
}
elsif ($$textref =~ /$QWLIST/cog) {
$term = $self->parse_qwlist($textref, $1) || return;
}
elsif ($$textref =~ /$LIST/cog) {
$term = $self->parse_list($textref) || return;
}
elsif ($$textref =~ /$HASH/cog) {
$term = $self->parse_hash($textref) || return;
}
elsif ($$textref =~ /$PAREN/cog) {
$term = $self->parse_parens($textref) || return;
}
elsif ($term = $self->parse_variable($textref)) {
# parse_variable() will gobble up all dotops, so we
# can return right away to bypass the dotop code below
return $term;
}
else {
# no term, so decline
return 0;
}
# dotop may follow literal term, e.g. "string".length, [a, b, c].join
if ( $$textref =~ /$DOTOP/cog ) {
$term = $self->parse_varnodes($textref, [ [ data => $term ] ])
|| return;
$term = [ variable => $term ];
}
return $term;
}
#------------------------------------------------------------------------
# parse_dquote($text)
#
# Parses the contents (i.e. not the enclosing '"' characters) of a double
# quoted string which may contain embedded variables.
#------------------------------------------------------------------------
sub parse_dquote {
my ($self, $textref) = @_;
my (@tokens, $token);
while ( $$textref =~ /
( (?: \\. | [^\$] )+ ) # $1 : escaped or non-'$' character
| \${ \s* ([^}]*?) \s* } # $2 : ${ }
| \$ ([\w\.]+) # $3 : $term
/gx ) {
if (defined $1) {
# preceding text
push(@tokens, $1);
}
elsif (defined $2) {
# embedded ${ variable }
my $text = $2;
$token = $self->parse_variable(\$text)
|| return $self->missing( $textref, $token,
"missing variable in '\${ }'" );
push(@tokens, $token);
}
elsif (defined $3) {
# $variable reference
my $text = $3;
$token = $self->parse_variable(\$text)
|| return $self->missing( $textref, $token,
'missing variable after \$' );
push(@tokens, $token);
}
else {
return $self->error("no match in parse_dquote()");
}
}
return [ dquote => \@tokens ];
}
#------------------------------------------------------------------------
# parse_qwlist($textref, $left)
#
# Parses a quoted word list, e.g. qw[ ] qw( foo bar baz ) qw< x y z >.
#------------------------------------------------------------------------
sub parse_qwlist {
my ($self, $textref, $left) = @_;
# look up regex to match corresponding right bracket
my $right = $RBRACKET->{ $left }
|| return $self->error("no right bracket defined to match $1\n");
# match text up to right bracket
return $self->error("missing $BRACKETS->{ $left } after 'qw$left'")
unless $$textref =~ /$right/gc;
return [ qwlist => $1 ];
}
#------------------------------------------------------------------------
# parse_list($text)
#
# Parses an anonymous list definition.
#
# list: list, listitem # foo, bar, baz
# | list listitem # foo bar baz
# | listitem # foo
# | <empty list> #
#
# listitem: expression # foo
# | expression .. expression # foo..bar
#
#------------------------------------------------------------------------
sub parse_list {
my ($self, $textref) = @_;
my ($item, $range, @items);
# skip any leading whitespace
$$textref =~ /$GWSPACE/cog;
# parse each expression in the list
while ($item = $self->parse_expression($textref)) {
if ($$textref =~ /$RANGE/cog) {
# '..' indicates a range, e.g. foo..bar
if ($range = $self->parse_expression($textref)) {
$self->debug("list got range: $item .. $range\n") if $DEBUG;
push(@items, [ range => $item, $range ]);
}
else {
return defined $range
? $self->unexpected( $textref,
"after '..' where expression expected" )
: undef;
}
}
else {
# otherwise it's a single item
push(@items, $item);
}
# skip over any whitespace and optional comma
$$textref =~ /$COMMA/cog;
}
# undefined value indicates error
return unless defined $item;
# check for closing ']'
return $self->unexpected($textref, 'in list definition')
unless $$textref =~ /$ENDLIST/cog;
return [ list => \@items ];
}
#------------------------------------------------------------------------
# parse_hash($text)
#
# Parses an anonymous hash definition.
#
# hash: hash, hashitem # pi => 3.14, e => 2.718
# | hash hashitem # pi => 3.14 e => 2.718
# | hashitem # pi => 3.14
# | <empty hash> #
#
# hashitem: IDENT =>? expression
# | LITERAL =>? expression
#
#------------------------------------------------------------------------
sub parse_hash {
my ($self, $textref) = @_;
my ($key, $value, $op, @hash);
while ($$textref =~ /$HASHKEY/cog) {
# $HASHKEY is /$IDENT|$SQUOTE/ so need to look for $1 or $2
$key = $1 || $2;
# look for = or => following
if ($$textref =~ /$ASSIGN/cog) {
$op = $1;
# parse expression on rhs of assignment
if ($value = $self->parse_expression($textref)) {
push(@hash, $key, $value);
}
else {
return defined $value
? $self->unexpected( $textref,
"after '$op' where expression expected" )
: undef;
}
# skip comma and/or whitespace
$$textref =~ /$COMMA/cog;
}
else {
return $self->unexpected( $textref,
"after hash key '$key' where '=' expected" );
}
}
return $self->unexpected($textref, 'in hash definition')
unless $$textref =~ /$ENDHASH/cog;
return [ hash => \@hash ];
}
#------------------------------------------------------------------------
# parse_parens($textref)
#
# Parse parenthesised assignment or other expression:
# ( foo + bar ) ( foo + a or b )
# ( a or b ) ( foo ? bar : baz + 10 )
#------------------------------------------------------------------------
sub parse_parens {
my ($self, $textref) = @_;
my $term;
# look first for an assignment
if ($term = $self->parse_assign($textref)) {
return $$textref =~ /$ENDPAREN/cog
? [ parens => $term ]
: $self->unexpected( $textref,
"where ')' expected after assignment" );
}
# undefined value indicates error
return unless defined $term;
if ($term = $self->parse_expression($textref)) {
return $$textref =~ /$ENDPAREN/cog
? [ parens => $term ]
: $self->unexpected( $textref,
"where ')' expected after expression" );
}
return unless defined $term;
# maybe it's empty parens?
return ($$textref =~ /$ENDPAREN/cog)
? [ parens => ['nullop'] ]
: $self->unexpected( $textref,
"where ')' expected" );
}
#------------------------------------------------------------------------
# parse_assign($text)
#
# Parses an assignement statement of the form: variable =>? expression
#------------------------------------------------------------------------
sub parse_assign {
my ($self, $textref) = @_;
my ($var, $op, $value, $assign);
$self->debug("parse_assign()\n") if $DEBUG;
# skip any leading whitespace
$$textref =~ /$GWSPACE/cog;
# save string position in case we need to backtrack
my $pos = pos $$textref;
# look for a variable
$var = $self->parse_variable($textref);
return unless defined $var;
if ($$textref =~ /$ASSIGN/cog) {
$op = $1;
$self->debug(" - assign ($op)\n") if $DEBUG;
if ($value = $self->parse_expression($textref)) {
return [ assign => $var, $value ];
}
else {
return defined $value
? $self->unexpected($textref, "after '$op' where expression expected")
: undef;
}
}
# rewind string position to start of variable
$self->debug("- not assign, backtracking\n") if $DEBUG;
pos $$textref = $pos;
return 0; # $self->decline('not an assignment');
}
#------------------------------------------------------------------------
# parse_variable($textref)
#
# Parse a variable starting with an ident followed by zero to many
# varnodes separated by dotops.
#------------------------------------------------------------------------
sub parse_variable {
my ($self, $textref) = @_;
my ($term, $terms, $args);
$self->debug("parse_variable(", $self->next_text($textref), ")\n")
if $DEBUG;
# skip any leading whitespace
$$textref =~ /$GWSPACE/cog;
my $pos = pos $$textref;
# first argument must be a plain ident
if ($$textref =~ /$IDENT/cog) {
my $ident = $1;
my $grammar = $self->{ grammar };
# TODO: check for keywords
# if ($grammar && $grammar->directive($ident)) {
# $self->debug("found KEYWORD at variable position, declining\n")
# if $DEBUG;
# pos $$textref = $pos;
# return $self->decline("found keyword: $ident");
# }
$term = [ ident => $ident ];
# args may follow
if ($$textref && $$textref =~ /$PAREN/cog) {
$args = $self->parse_args($textref) || return;
push(@$term, $args);
}
}
else {
return 0;
}
$terms = [ $term ];
# may be other dotops following...
if ( $$textref =~ /$DOTOP/cog ) {
($term = $self->parse_varnodes($textref, $terms))
|| return $self->missing( $textref, $term,
"missing item after '.'" );
}
return [ variable => $terms ];
}
#------------------------------------------------------------------------
# parse_varnodes($textref, $nodes)
#
# Parse a sequence of dotop separated variable nodes.
#------------------------------------------------------------------------
sub parse_varnodes {
my ($self, $textref, $nodes) = @_;
$nodes ||= [ ];
my $node;
$self->debug("parse_varnodes(", $self->next_text($textref), ")\n")
if $DEBUG;
do {
($node = $self->parse_varnode($textref))
|| return @$nodes
? $self->missing( $textref, $node,
"missing item after '.'" )
: $node;
push(@$nodes, $node);
}
while ($$textref =~ /$DOTOP/cog);
return $nodes;
}
#------------------------------------------------------------------------
# parse_varnode($textref)
#
# Parse a variable node and an optional argument list.
#
# varnode: integer # 3
# | qwlist # qw[ foo bar ]
# | ident # foo
# | squote # 'blah blah'
# | dquote # "blah $var blah"
# | list # [ 1, two, 'three' ]
# | hash # { one => 'foo', two => 'bar' ]
# | interp # $foo
# | embed # ${foo.bar}
#------------------------------------------------------------------------
sub parse_varnode {
my ($self, $textref) = @_;
my ($term, $args);
$self->debug("parse_varnode(", $self->next_text($textref), ")\n")
if $DEBUG;
if ($$textref =~ /$INTEGER/cog) {
$term = [ integer => $1 ];
}
elsif ($$textref =~ /$QWLIST/cog) {
$term = $self->parse_qwlist($textref, $1) || return;
}
elsif ($$textref =~ /$IDENT/cog) {
$term = [ ident => $1 ];
}
elsif ($$textref =~ /$SQUOTE/cog) {
$term = [ squote => $1 ];
}
elsif ($$textref =~ /$DQUOTE/cog) {
my $text = $1;
$term = $self->parse_dquote(\$text) || return;
}
elsif ($$textref =~ /$LIST/cog) {
$term = $self->parse_list($textref) || return;
}
elsif ($$textref =~ /$HASH/cog) {
$term = $self->parse_hash($textref) || return;
}
elsif ($$textref =~ /$EMBED/cog) {
my $text = $1;
($term = $self->parse_variable(\$text))
|| return $self->missing( $textref, $term,
"missing variable in '\${ }'" );
}
elsif ($$textref =~ /$INTERP/cog) {
($term = $self->parse_variable($textref))
|| return $self->missing( $textref, $term,
"missing variable after '\$'");
}
else {
return 0;
}
if ($$textref && $$textref =~ /$PAREN/cog) {
$args = $self->parse_args($textref) || return;
push(@$term, $args);
}
return $term;
}
#------------------------------------------------------------------------
# parse_args($text)
#
# args: args, arg # foo, bar=baz
# | args arg # foo bar=baz
# | arg # foo
# | <empty args> #
#
# arg: hashitem
# | expression
#------------------------------------------------------------------------
sub parse_args {
my ($self, $textref) = @_;
my ($pos, $op, $key, $value);
my $args = [ ];
$self->debug("parse_args(", $self->next_text($textref), ")\n")
if $DEBUG;
# skip any leading whitespace
$$textref =~ / \G $WSPACE /gcx;
while (1) {
# save current string position
$pos = pos $$textref;
# look for something that can be the LHS of an assignment
if ( ($$textref =~ /$IDENT/cog) || ($$textref =~ /$SQUOTE/cog) ) {
$key = $1;
$self->debug("got ident or literal: $key\n") if $DEBUG;
if ($$textref =~ /$ASSIGN/cog) {
# named parameter
$op = $1;
($value = $self->parse_expression($textref))
|| return $self->missing( $textref, $value,
"missing expression after '$op'");
push(@$args, [ named => $key, $value ]);
next; ## NAMED PARAM ##
}
else {
# positional argument - reset and drop through
pos $$textref = $pos;
}
}
if ($value = $self->parse_expression($textref)) {
push(@$args, [ value => $value ]); ## POSITONAL ARG ##
}
else {
last; ## ALL DONE ##
}
}
continue {
# skip comma and/or whitespace
$$textref =~ /$COMMA/cog;
}
# trailing comma/whitespace
$$textref =~ /$COMMA/cog;
return $self->missing( $textref, 0,
"missing ')' at end of argument list" )
unless ($$textref =~ /$ENDPAREN/cog);
return $args;
}
#------------------------------------------------------------------------
# parse_filename($textref)
#
# filename: FILENAME
# | QUOTED
# | LITERAL
# | $variable
#------------------------------------------------------------------------
sub parse_filename {
my ($self, $textref) = @_;
my $term;
# skip any leading whitespace
$$textref =~ / \G $WSPACE /gcx;
if ($$textref =~ /$FILENAME/cog) {
$term = [ filename => $1 ];
}
elsif ($$textref =~ /$SQUOTE/cog) {
$term = [ squote => $1 ];
}
elsif ($$textref =~ /$DQUOTE/cog) {
my $text = $1;
$term = $self->parse_dquote(\$text);
}
elsif ($$textref =~ /$INTERP/cog) {
$self->debug("parsing filename variable\n") if $DEBUG;
$term = $self->parse_variable($textref)
|| return $self->missing( $textref, $term,
"missing variable after '\$'");
}
else {
return 0; #$self->decline('not a filename');
}
return $term;
}
#------------------------------------------------------------------------
# missing(\$text, $value, $message)
#
# Error checking and reporting method. If $value is defined (but
# usually false) then it indicates that the parser has declined to parse
# a token which was expected. In which case, an error message is
# generated. If $value is undefined then we assume that a parser error
# has already been generated and we simply return undef.
#------------------------------------------------------------------------
sub missing {
my ($self, $textref, $value, @error) = @_;
return defined $value
? $self->error( @error, " (got '",
$self->next_token($textref), "')" )
: undef;
}
#------------------------------------------------------------------------
# unexpected(\$text, $message)
#
# Error reporting method.
#------------------------------------------------------------------------
sub unexpected {
my ($self, $textref, @message) = @_;
my $next = $self->next_token($textref);
$next = length $next ? "'$next'" : 'end of statement';
return $self->error("unexpected $next ", @message);
}
#------------------------------------------------------------------------
# next_char(\$text)
#
# Utility method to extract the next character following the current
# regex match position.
#------------------------------------------------------------------------
sub next_char {
my ($self, $textref) = @_;
return '' unless length $$textref;
my $pos = pos $$textref;
my $got = ($$textref =~ / \G (.) /gcsx);
pos $$textref = $pos;
return $got ? $1 : '';
}
#------------------------------------------------------------------------
# next_token(\$text)
#
# Utility method to extract the next whitespace delimited token following
# the current regex match position.
#------------------------------------------------------------------------
sub next_token {
my ($self, $textref) = @_;
return '' unless length $$textref;
my $pos = pos $$textref;
my $got = ($$textref =~ / \G \s* (\w+|.) /gcsx);
pos $$textref = $pos;
return $got ? $1 : '';
}
#------------------------------------------------------------------------
# next_text(\$text)
#
# Utility method to extract the part of the text following the current
# regex match position.
#------------------------------------------------------------------------
sub next_text {
my ($self, $textref) = @_;
return '' unless length $$textref;
my $pos = pos $$textref;
my $got = ($$textref =~ / \G \s* (.*) /gcsx);
pos $$textref = $pos;
return $got ? $1 : '';
}
1;
__END__
=head1 NAME
Template::TT3::Parser - parser basic language elements
=head1 SYNOPSIS
use Template::TT3::Parser;
# TODO
=head1 DESCRIPTION
# TODO
=head1 METHODS
=head2 new()
# TODO
=head2 missing(\$text, $value, $message)
Error checking and reporting method which raises an error based on the
value of the second argument, $value. It is called by various parsing
method as shown in the following example:
if ($$textref =~ / \G \$ /cg) {
$self->debug("parsing variable\n") if $DEBUG;
$value = $self->parse_variable($textref)
|| return $self->missing( $textref, $value,
"missing variable after '\$'");
}
If C<$value> is undefined then it indicates that a fatal error
occurred in the parse_variable() method, and one which has already
been reported via a previous call to $self->error(). In this case,
the missing() method does nothing and simply returns undef.
If $value is 0 then it indicates that the parse_variable() method
declined to parse a variable (i.e. there wasn't one in the input
stream). For example, if <$$textref> contains C<$@> then the error
reported would be:
missing variable after '$' (got '@')
=head2 unexpected(\$text, $message)
Error reporting method which generates a formatted error string and
calls the error() method to report it. It is called by various
parsing method as shown in the following example:
$$textref =~ / \G foo /gcx
|| return $self->unexpected( $textref,
" where 'foo' should be" );
If C<$$textref> contains C<bar> instead of C<foo> then the match will
fail and the method will return undef having set the internal error string
to:
unexpected 'bar' where 'foo' should be
If C<$$textref> doesn't contain any further text after the current
regex position then it will set the error to:
unexpected end of statement where 'foo' should be
=head2 next_char(\$text)
Utility method which returns the character following the current
regular expression position in the text string passed by reference
as an argument.
=head2 next_token(\$text)
Utility method which returns the next whitespace delimited token
following the current regular expression position in the text string
passed by reference as an argument.
=head2 next_text(\$text)
Utility method which returns all of the text following the current
regular expression position in the text string passed by reference as
an argument.
=head1 AUTHOR
Andy Wardley E<lt>abw@wardley.orgE<gt>
=head1 VERSION
$Revision: 1.1 $
=head1 COPYRIGHT
Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved.
Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: