[Templates-cvs] cvs commit: TT3/lib/Template Parser.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Wed, 01 Dec 2004 17:59:36 +0000
cvs 04/12/01 17:59:36
Modified: lib/Template Parser.pm
Log:
* reorganised and refactors various methods for parsing tuples
Revision Changes Path
1.13 +219 -228 TT3/lib/Template/Parser.pm
Index: Parser.pm
===================================================================
RCS file: /template-toolkit/TT3/lib/Template/Parser.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- Parser.pm 2004/11/26 12:45:59 1.12
+++ Parser.pm 2004/12/01 17:59:36 1.13
@@ -18,7 +18,7 @@
# modify it under the same terms as Perl itself.
#
# REVISION
-# $Id: Parser.pm,v 1.12 2004/11/26 12:45:59 abw Exp $
+# $Id: Parser.pm,v 1.13 2004/12/01 17:59:36 abw Exp $
#
#========================================================================
@@ -29,7 +29,7 @@
use Template::Base;
use base qw( Template::Base );
-our $VERSION = sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = sprintf("%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/);
our $DEBUG = 0 unless defined $DEBUG;
our $ERROR = '';
our $THROW = 'parser';
@@ -402,6 +402,36 @@
#------------------------------------------------------------------------
+# parse_ident($text)
+#
+# Parser a simple identifier (e.g. variable name), checking to make sure
+# it's not a reserved directive keyword.
+#------------------------------------------------------------------------
+
+sub parse_ident {
+ my ($self, $textref) = @_;
+
+ $self->debug("parse_ident(", $self->next_chunk($textref), ")\n")
+ if $DEBUG;
+
+ # save current text position in case we scan an ident but then
+ # find out that it's a directive keyword and need to backtrack
+ my $pos = pos $$textref;
+
+ if ($$textref =~ /$IDENT/cog) {
+ if ($self->{ directives }->{ $1 }) {
+ pos $$textref = $pos;
+ return $self->decline("not an identifier (got keyword: $1)");
+ }
+ return $1;
+ }
+ else {
+ return $self->decline('not an identifier');
+ }
+}
+
+
+#------------------------------------------------------------------------
# parse_number($textref)
#
# Number has an optional sign and can be hex or decimal, either integer,
@@ -683,52 +713,205 @@
}
+#------------------------------------------------------------------------
+# 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) = @_;
+
+ $self->debug("parse_qwlist(", $self->next_chunk($textref), ")\n")
+ if $DEBUG;
+
+ # look up regex to match corresponding right bracket
+ my $regex = $RBRACKET->{ $left }
+ || return $self->error("no right bracket defined to match $1\n");
+
+ my $right = $BRACKETS->{ $left };
+
+ # match text up to right bracket
+ return $self->error("missing $right after 'qw$left'")
+ unless $$textref =~ /$regex/gc;
+
+ return [ qwlist => $left, $1, $right ];
+}
+
#------------------------------------------------------------------------
-# parse_hash_key($textref)
+# parse_list($textref)
#
+# Parses the contents of an anonymous list definition.
+#------------------------------------------------------------------------
+
+sub parse_list {
+ my ($self, $textref) = @_;
+ my ($item, $range, $end, @items);
+
+ $self->debug("parse_list(", $self->next_chunk($textref), ")") if $DEBUG;
+
+ # skip any leading whitespace, comments, etc.
+ $$textref =~ /$self->{ wspace }/cg;
+
+ while ($item = $self->parse_expression($textref)) {
+ if ($$textref =~ /$self->{ range }/cg) {
+ # '..' indicates a range, e.g. foo..bar
+ $range = $1;
+
+ if ($end = $self->parse_expression($textref)) {
+ $self->debug("list got range: $item $range $end\n") if $DEBUG;
+ push(@items, [ range => $item, $end ]);
+ }
+ else {
+ return $self->unexpected( $textref,
+ "after '$range' where expression expected" );
+ }
+ }
+ else {
+ # otherwise it's a single item
+ push(@items, $item);
+ }
+
+ # skip over any whitespace and optional comma
+ $$textref =~ /$self->{ comma }/cg;
+ }
+
+ return [ list => \@items ];
+}
+
+
+#------------------------------------------------------------------------
+# parse_hash($textref)
+#
+# Parses the contents of an anonymous hash definition. Skips leading
+# and trailing whitespace, comments, etc., and any commas and other
+# whitespace, comments, etc., in between items.
+#------------------------------------------------------------------------
+
+sub parse_hash {
+ my ($self, $textref) = @_;
+ my ($key, $value, @hash);
+
+ $self->debug("parse_hash(", $self->next_chunk($textref), ")") if $DEBUG;
+
+ # skip any leading whitespace, comments, etc.
+ $$textref =~ /$self->{ wspace }/cg;
+
+ while ($key = $self->parse_key($textref)) {
+ $value = $self->parse_assign_expr($textref)
+ || return $self->missing( $textref,
+ "assignment after hash key $self->{ key }" );
+ push(@hash, [ $key, $value ]);
+
+ # skip comma and/or whitespace
+ $$textref =~ /$self->{ comma }/cg;
+ }
+
+ # remove any trailing whitespace (TODO: is this required?)
+ $$textref =~ /$self->{ wspace }/cg;
+
+ return [ hash => \@hash ];
+}
+
+
+#------------------------------------------------------------------------
+# parse_key($textref)
+#
# Parse anything that can be used as the key for a hash, parameter name,
# etc: unquoted identifier word, single or double quoted string.
#------------------------------------------------------------------------
-sub parse_hash_key {
+sub parse_key {
my ($self, $textref) = @_;
+ $self->debug("parse_key(", $self->next_chunk($textref), ")\n")
+ if $DEBUG;
+
# save current string position
my $pos = pos $$textref;
# look for something that can be the LHS of an assignment
if ($$textref =~ /$IDENT/cog) {
- $self->{ hash_key } = "'$1'";
+ $self->{ key } = "'$1'";
+ if ($self->{ directives }->{ $1 }) {
+ pos $$textref = $pos;
+ return $self->decline("found directive keyword: $1");
+ }
return [ ident => $1 ];
}
elsif ($$textref =~ /$SQUOTE/cog) {
- $self->{ hash_key } = "'$1'";
+ $self->{ key } = "'$1'";
return [ squote => $1 ];
}
elsif ($$textref =~ /$DQUOTE/cog) {
- $self->{ hash_key } = "\"$1\"";
+ $self->{ key } = "\"$1\"";
my $text = $1;
my $string = $self->parse_string(\$text) || return;
return [ dquote => $string ];
}
+
+ pos $$textref = $pos;
+ return $self->decline("not a key");
+}
+
+
+#------------------------------------------------------------------------
+# parse_assign_expr($textref)
+#
+# Parses an assignment to an expression, e.g. "= 10", "=> x", " => y || z".
+#------------------------------------------------------------------------
+
+sub parse_assign_expr {
+ my ($self, $textref) = @_;
+ my ($op, $expr);
+
+ $self->debug("parse_assign_expr(",
+ $self->next_chunk($textref), ")") if $DEBUG;
+
+ # skip any leading whitespace, comments, etc.
+ $$textref =~ /$self->{ wspace }/cg;
+
+ if ($$textref =~ /$self->{ assign }/cg) {
+ $op = $1;
+ return $self->parse_expression($textref)
+ || $self->missing( $textref,
+ "expression after '$op'" );
+ }
else {
- pos $$textref = $pos;
- return $self->decline("not a hash key");
+ return $self->decline('not an assignment');
}
}
#------------------------------------------------------------------------
-# parse_args($textref)
+# parse_ident_assign_expr($textref)
#
-# args: args, arg # foo, bar=baz
-# | args arg # foo bar=baz
-# | arg # foo
-# | <empty args> #
+# Parses an assignment of a simple identifier to an expression, e.g.
+# "x = 10", "y => x", "z = x || y".
+#------------------------------------------------------------------------
+
+sub parse_ident_assign_expr {
+ my ($self, $textref) = @_;
+ my ($ident, $expr);
+
+ $self->debug("parse_ident_assign_expr(",
+ $self->next_chunk($textref), ")") if $DEBUG;
+
+ $$textref =~ /$self->{ wspace }/cgx;
+
+ $ident = $self->parse_ident($textref) || return;
+ $expr = $self->parse_assign_expr($textref)
+ || return $self->missing( $textref,
+ "assignment after identifier '$ident'" );
+ return [ $ident, $expr ];
+}
+
+
+#------------------------------------------------------------------------
+# parse_args($textref)
#
-# arg: hashitem
-# | expression
+# Parse the contents of a parenthesised argument list.
#------------------------------------------------------------------------
sub parse_args {
@@ -745,17 +928,12 @@
# save current string position
$pos = pos $$textref;
- if ($key = $self->parse_hash_key($textref)) {
- $self->debug("got hash key: ", join(' => ', @$key), "\n") if $DEBUG;
-
- if ($$textref =~ /$self->{ assign }/cg) {
+ if ($key = $self->parse_key($textref)) {
+ $self->debug("got key: ", join(' => ', @$key), "\n") if $DEBUG;
+ if ($value = $self->parse_assign_expr($textref)) {
# named parameter
- $op = $1;
- ($value = $self->parse_expression($textref))
- || return $self->missing( $textref,
- "missing expression after '$op'");
push(@$args, [ tuple => $key, $value ]);
- next; ## NAMED PARAM ##
+ next; ## NAMED PARAM ##
}
else {
# positional argument - reset and drop through
@@ -764,7 +942,7 @@
}
if ($value = $self->parse_expression($textref)) {
- push(@$args, $value); ## POSITONAL ARG ##
+ push(@$args, $value); ## POSITONAL ARG ##
}
elsif ($self->{ DECLINED }) {
# parser declined so we're all done
@@ -789,11 +967,14 @@
#------------------------------------------------------------------------
# parse_params($textref)
+#
+# Parse an open list of parameters, such as those following the template
+# name in an INCLUDE directive.
#------------------------------------------------------------------------
sub parse_params {
my ($self, $textref) = @_;
- my ($pos, $op, $key, $value);
+ my ($pos, $key, $value);
my $params = [ ];
$self->debug("parse_params(", $self->next_token($textref), ")\n")
@@ -801,46 +982,12 @@
# skip any leading whitespace, comments, etc.
$$textref =~ /$self->{ wspace }/cg;
-
- while (1) {
- # save current string position
- $pos = pos $$textref;
- if ($$textref =~ /$IDENT/cog) {
- $key = $1;
- if ($self->{ directives }->{ $key }) {
- $self->debug("found keyword '$key' in args, ending\n") if $DEBUG;
- pos $$textref = $pos;
- return $params;
- }
- }
- elsif ($$textref =~ /$SQUOTE/cog) {
- $key = [ squote => $1 ];
- }
- elsif ($$textref =~ /$DQUOTE/cog) {
- my $text = $1;
- $key = [ dquote => $self->parse_string(\$text) ];
- }
- else {
- last;
- }
-
- $self->debug("possible parameter name: $key\n") if $DEBUG;
-
- if ($$textref =~ /$self->{ assign }/cg) {
- # named parameter
- $op = $1;
- ($value = $self->parse_expression($textref))
- || return $self->missing( $textref,
- "missing expression after '$op'");
- push(@$params, [ tuple => $key, $value ]);
- }
- else {
- # doesn't look like an assignment, so reset and return
- $self->debug("not a parameter, rewinding\n") if $DEBUG;
- pos $$textref = $pos;
- return $params;
- }
+ while ($key = $self->parse_key($textref)) {
+ $value = $self->parse_assign_expr($textref)
+ || return $self->missing( $textref,
+ "assignment after parameter $self->{ key }" );
+ push(@$params, [ tuple => $key, $value ]);
# skip comma and/or whitespace
$$textref =~ /$self->{ comma }/cg;
@@ -853,138 +1000,6 @@
}
-#------------------------------------------------------------------------
-# 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) = @_;
-
- $self->debug("parse_qwlist(", $self->next_chunk($textref), ")\n")
- if $DEBUG;
-
- # look up regex to match corresponding right bracket
- my $regex = $RBRACKET->{ $left }
- || return $self->error("no right bracket defined to match $1\n");
-
- my $right = $BRACKETS->{ $left };
-
- # match text up to right bracket
- return $self->error("missing $right after 'qw$left'")
- unless $$textref =~ /$regex/gc;
-
- return [ qwlist => $left, $1, $right ];
-}
-
-
-#------------------------------------------------------------------------
-# parse_list($textref)
-#
-# 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, $end, @items);
-
- $self->debug("parse_list(", $self->next_chunk($textref), ")") if $DEBUG;
-
- # skip any leading whitespace, comments, etc.
- $$textref =~ /$self->{ wspace }/cg;
-
- # parse each expression in the list
- while ($item = $self->parse_expression($textref)) {
-
- if ($$textref =~ /$self->{ range }/cg) {
- $range = $1;
-
- # '..' indicates a range, e.g. foo..bar
- if ($end = $self->parse_expression($textref)) {
- $self->debug("list got range: $item $range $end\n") if $DEBUG;
- push(@items, [ range => $item, $end ]);
- }
- else {
- return $self->unexpected( $textref,
- "after '$range' where expression expected" );
- }
- }
- else {
- # otherwise it's a single item
- push(@items, $item);
- }
-
- # skip over any whitespace and optional comma
- $$textref =~ /$self->{ comma }/cg;
- }
-
- return [ list => \@items ];
-}
-
-
-#------------------------------------------------------------------------
-# parse_hash($textref)
-#
-# 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);
-
- $self->debug("parse_hash(", $self->next_chunk($textref), ")") if $DEBUG;
-
- # skip any leading whitespace, comments, etc.
- $$textref =~ /$self->{ wspace }/cg;
-
- while ($key = $self->parse_hash_key($textref)) {
- # look for = or => following
- if ($$textref =~ /$self->{ assign }/cg) {
- $op = $1;
-
- # parse expression on rhs of assignment
- if ($value = $self->parse_expression($textref)) {
- push(@hash, [ tuple => $key, $value ]);
- }
- else {
- return $self->unexpected( $textref,
- "after '$op' where expression expected" );
- }
-
- # skip comma and/or whitespace
- $$textref =~ /$self->{ comma }/cg;
- }
- else {
- # remove any leading whitespace that would be ignored
- $$textref =~ /$self->{ wspace }/cg;
- return $self->unexpected( $textref,
- "after hash key ", $self->{ hash_key },
- " where '=' expected" );
- }
- }
-
- return [ hash => \@hash ];
-}
-
#------------------------------------------------------------------------
@@ -1050,32 +1065,10 @@
}
-#------------------------------------------------------------------------
-# parse_identifier($text)
-#
-# Parser a simple identifier (e.g. variable name).
-# TODO: should we check it's not a keyword?
-#------------------------------------------------------------------------
-
-sub parse_identifier {
- my ($self, $textref) = @_;
- my ($term, $terms, $args);
-
- $self->debug("parse_identifier(", $self->next_chunk($textref), ")\n")
- if $DEBUG;
-
- # first argument must be a plain ident
- if ($$textref =~ /$IDENT/cog) {
- return $1;
- }
- else {
- return $self->decline('not an identifier');
- }
-}
#------------------------------------------------------------------------
-# parse_identifier_args($text)
+# parse_ident_args($text)
#
# Parser a simple identifier (e.g. variable name) optionally followed by
# a parenthesised list of further identifiers. This is used by the MACRO
@@ -1083,10 +1076,10 @@
# TODO: should we check it's not a keyword?
#------------------------------------------------------------------------
-sub parse_identifier_args {
+sub parse_ident_args {
my ($self, $textref) = @_;
- $self->debug("parse_identifier_args(", $self->next_chunk($textref), ")\n")
+ $self->debug("parse_ident_args(", $self->next_chunk($textref), ")\n")
if $DEBUG;
my $pos = pos $$textref;
@@ -1340,11 +1333,9 @@
sub missing {
my ($self, $textref, @error) = @_;
-
my $next = $self->next_token($textref);
- $next = defined $next && length $next
- ? " (got '$next')" : '';
- return $self->error(@error, $next);
+ $next = defined $next && length $next ? " (got '$next')" : '';
+ return $self->error('missing ', @error, $next);
}
@@ -1501,7 +1492,7 @@
=head1 VERSION
-$Revision: 1.12 $
+$Revision: 1.13 $
=head1 COPYRIGHT