[Templates-cvs] cvs commit: TT3/lib/Template/TT3 Tag.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Fri, 19 Dec 2003 17:28:42 +0000
cvs 03/12/19 17:28:42
Modified: lib/Template/TT3 Tag.pm
Log:
* updated base class tag in minor reorganisation
Revision Changes Path
1.5 +67 -97 TT3/lib/Template/TT3/Tag.pm
Index: Tag.pm
===================================================================
RCS file: /template-toolkit/TT3/lib/Template/TT3/Tag.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Tag.pm 2003/12/16 12:41:14 1.4
+++ Tag.pm 2003/12/19 17:28:42 1.5
@@ -17,7 +17,7 @@
# modify it under the same terms as Perl itself.
#
# REVISION
-# $Id: Tag.pm,v 1.4 2003/12/16 12:41:14 abw Exp $
+# $Id: Tag.pm,v 1.5 2003/12/19 17:28:42 abw Exp $
#
#========================================================================
@@ -26,16 +26,15 @@
use strict;
use warnings;
use Template::TT3::Base;
-use vars qw( $VERSION $DEBUG $ERROR $WARNING $TAG );
+use vars qw( $VERSION $DEBUG $ERROR $WARNING $TAG @ISA );
use base qw( Template::TT3::Base );
-$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
$TAG = {
- start => '[%',
- end => '%]',
name => 'tag',
+ start => '$',
};
@@ -64,58 +63,67 @@
sub pkgtag {
my $self = shift;
my $class = ref $self || $self;
+ my @pending = ($class);
+ my ($pkg, $pkgtag, %seen);
+
no strict 'refs';
- return ${"$class\::TAG"} || $TAG;
+
+ while ($pkg = shift @pending) {
+ next if $seen{ $pkg }++;
+ last if ($pkgtag = ${"$pkg\::TAG"});
+ push(@pending, @{"$pkg\::ISA"});
+ }
+ return $pkgtag || $TAG;
}
+
#------------------------------------------------------------------------
-# scan($content, $document, $start, $end)
+# scan($textref, $handler, $lineref, $start)
+#
+# Default scan method for open tags. Defines a $self->{ match } record
+# and calls the parse() method for further processing. Keeps track of
+# lines consumed and updates $lineref accordingly.
#------------------------------------------------------------------------
sub scan {
- my ($self, $content, $document, $start, $end) = @_;
- @$self{ qw( start_token end_token ) } = ($start, $end);
- return $self->parse($content, $document);
+ my ($self, $textref, $handler, $lineref, $start) = @_;
+ my $start_pos = pos($$textref) || 0;
+
+ local $self->{ match } = {
+ start => $start,
+ line => $$lineref,
+ };
+
+ $handler = $self->parse($textref, $handler);
+
+ my $end_pos = pos $$textref || 0;
+ my $substr = substr($$textref, $start_pos, $end_pos - $start_pos);
+ $$lineref += ($substr =~ tr/\n//);
+
+ return $handler;
}
#------------------------------------------------------------------------
-# parse($content, $document)
+# parser($textref, $handler)
#
-# Method to parse the tag content, usually redefined by subclasses to do
-# something useful.
+# Stub method for redefinition by subclasses.
#------------------------------------------------------------------------
sub parse {
- my ($self, $content, $document) = @_;
- return $document;
+ my ($self, $textref, $handler) = @_;
+ return $handler;
}
#------------------------------------------------------------------------
-# start() / start($token)
-# end() / end($token)
-# name() / name($name)
+# name()
+# name($name)
#
-# Accessor methods to get/set the start tag, end tag and optional tag
-# name and action attributes.
+# Accessor method to get/set the start token.
#------------------------------------------------------------------------
-sub start {
- my $self = shift;
- return @_ ? ($self->{ start } = shift) : $self->{ start };
-}
-
-sub end {
- my $self = shift;
- if (@_) {
- $self->{ end } = shift;
- delete $self->{ end_regex };
- }
- return $self->{ end };
-}
-
sub name {
my $self = shift;
return @_ ? ($self->{ name } = shift) : $self->{ name };
@@ -123,44 +131,44 @@
#------------------------------------------------------------------------
-# start_token()
-# end_token()
-#
-# Accessor methods to return the actual tokens matched for the start and
-# end tags respectively, as set by the scan() method.
+# start()
+# start($token)
+#
+# Accessor method to get/set the start token.
#------------------------------------------------------------------------
-sub start_token {
- my $self = shift;
- return @_ ? ($self->{ start_token } = shift) : $self->{ start_token };
-}
-
-sub end_match {
+sub start {
my $self = shift;
- return @_ ? ($self->{ end_token } = shift) : $self->{ end_token };
+ return @_ ? ($self->{ start } = shift) : $self->{ start };
}
#------------------------------------------------------------------------
-# is_open()
-# is_closed()
+# match()
#
-# Methods which return boolean flags to indicate if the tag has an
-# end defined, in which case it is closed, or not, in which case it is
-# open.
+# Accessor method to get the current match.
#------------------------------------------------------------------------
-sub is_open {
+sub match {
my $self = shift;
- return defined($self->{ end }) && length($self->{ end }) ? 0 : 1;
+ return $self->{ match };
}
-sub is_closed {
- my $self = shift;
- return defined($self->{ end }) && length($self->{ end }) ? 1 : 0;
-}
+sub tag_error {
+ my $self = shift;
+ my $match = $self->{ match };
+ if ($match) {
+ return $self->error( @_,
+ " starting '$match->{ start }'",
+ " at line $match->{ line }" );
+ }
+ else {
+ return $self->error(@_);
+ }
+}
+
1;
__END__
@@ -171,45 +179,7 @@
=head1 SYNOPSIS
- package My::Custom::Tag;
- use base qw( Template::TT3::Tag );
- use vars qw( $DEBUG $TAG );
-
- $DEBUG = 0 unless defined $DEBUG;
- $TAG = {
- start => '[%',
- end => '%]',
- name => 'mytag',
- };
-
- sub parse {
- my ($self, $content, $document) = @_;
-
- # NOTE: the API for the document class isn't fixed yet
- # so this is all tentative
-
- if ($$content =~ /^INCLUDE (\w+)$/) {
- # simple directive
- return $document->add_item( include => $1 );
- }
- elsif ($$content =~ /^IF (.*)$/) {
- # start of block directive
- return $document->begin_item( if => $1 );
- }
- elsif ($$content eq 'END') {
- # end of block directive
- return $document->end_item();
- }
- .
- . # etc...
- .
- else {
- return $self->error( "invalid directive: ",
- $self->start_token(),
- $$content,
- $self->end_token() );
- }
- }
+# TODO - this is all out of date
=head1 DESCRIPTION
@@ -527,7 +497,7 @@
=head1 VERSION
-$Revision: 1.4 $
+$Revision: 1.5 $
=head1 COPYRIGHT