[Templates-cvs] cvs commit: TT3/lib/Template/TT3 Document.pm Tag.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Wed, 10 Dec 2003 14:15:25 +0000
cvs 03/12/10 14:15:24
Added: lib/Template/TT3 Document.pm Tag.pm
Log:
* added Document and Tag modules
Revision Changes Path
1.1 TT3/lib/Template/TT3/Document.pm
Index: Document.pm
===================================================================
#========================================================================
#
# Template::TT3::Document
#
# DESCRIPTION
# This module defines an object class which is used to represent an
# instance of a template document during the scanning, parsing and
# compilation phase.
#
# 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: Document.pm,v 1.1 2003/12/10 14:15:24 abw Exp $
#
#========================================================================
package Template::TT3::Document;
use strict;
use warnings;
use Template::TT3::Base;
use vars qw( $VERSION $DEBUG $ERROR $WARNING $TAGS );
use base qw( Template::TT3::Base );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
#------------------------------------------------------------------------
# init(\%config)
#
# Initialisation method called by base class new().
#------------------------------------------------------------------------
sub init {
my ($self, $config) = @_;
my $text = $config->{ text };
$text = '' unless defined $text;
my $name = $config->{ name };
$name = '' unless defined $name;
$self->{ name } = $name;
$self->{ text } = ref $text ? $text : \$text;
$self->{ line } = 1;
$self->{ size } = 0;
$self->{ body } = [ ];
return $self;
}
#------------------------------------------------------------------------
# scan($scanner)
#
# Scan the template source using the scanner object provided as an
# argument.
#------------------------------------------------------------------------
sub scan {
my ($self, $scanner) = @_;
$scanner->scan($self->{ text }, $self)
|| return $self->error($scanner->error());
}
#------------------------------------------------------------------------
# text($text)
#
# Add a chunk of text to the current block on the stack. Newlines are
# counted in the text and the internal 'line' and 'position' members
# updated accordingly.
#------------------------------------------------------------------------
sub text {
my ($self, $text) = @_;
my $textref = ref $text ? $text : \$text;
$self->debug("text at line $self->{ line } [$$textref]\n") if $DEBUG;
$self->{ line } += ($$textref =~ tr/\n//);
$self->{ size } = 0;
my $textdir = [ text => $textref ];
push(@{ $self->{ body } }, $textdir);
# TODO ???
$self->{ pending } = 0;
return $textdir;
}
#------------------------------------------------------------------------
# body()
# body($item)
#
# Returns body list when called without arguments. Adds item to body
# when called with an argument.
#------------------------------------------------------------------------
sub body {
my $self = shift;
return $self->{ body } unless @_;
my $item = shift;
$self->debug("body item at line $self->{ line }\n") if $DEBUG;
push(@{ $self->{ body } }, $item);
# TODO ???
$self->{ pending } = 0;
return $item;
}
sub name {
my $self = shift;
return @_ ? ($self->{ name } = shift) : $self->{ name };
}
sub byte {
my $self = shift;
return pos(${ $self->{ text } });
}
sub line {
my $self = shift;
return @_ ? ($self->{ line } = shift) : $self->{ line };
}
sub size {
my $self = shift;
return @_ ? ($self->{ size } = shift) : $self->{ size };
}
sub move {
my $self = shift;
if (@_) {
$self->{ line } += shift;
}
elsif ($self->{ size }) {
$self->{ line } += $self->{ size };
}
$self->{ size } = 0;
return $self->{ line };
}
sub position {
my $self = shift;
if (@_) {
$self->{ line } += shift;
$self->{ size } = @_ ? shift : 0;
}
if ($self->{ size }) {
my $end = $self->{ line } + $self->{ size };
return "$self->{ line }-$end";
}
else {
return $self->{ line };
}
}
sub location {
my $self = shift;
my $posn = $self->position();
return "$self->{ name } line $posn";
}
sub parse_error {
my $self = shift;
$self->error('parse error at ', $self->location(), ': ', @_);
}
sub next_text {
my ($self, $textref) = @_;
$textref ||= $self->{ text };
return '' unless length $$textref;
my $pos = pos $$textref;
my $match = $$textref =~ / \G (.*) /gcsx;
pos $$textref = $pos;
return $match ? $1 : '';
}
sub next_token {
my ($self, $textref) = @_;
$textref ||= $self->{ text };
return '' unless length $$textref;
my $pos = pos $$textref;
my $match = $$textref =~ / \G \s* (\w+|.) /gcsx;
pos $$textref = $pos;
return $match ? $1 : '';
}
1;
__END__
=head1 NAME
Template::TT3::Document - template document being compiled
=head1 SYNOPSIS
package Template::TT3::Document;
=head1 DESCRIPTION
# TODO
=head1 METHODS
=head2 new()
# TODO
=head2 name()
Accessor method to get or set the name of the document.
=head2 text($text)
Add the text passed as an argument (as either a scalar string or a
reference to one) to the body of the template document. The text is
scanned for newlines and the current internal line number is updated.
=head2 body($item)
Add the item passed as an argument to the body of the template document.
No further processing is done.
=head2 line()
The method can be called with an argument to set the current line number.
$document->line(42);
The current line number is returned when called without any arguments.
print $document->line(); # 42
=head2 size()
This method is used to notify the document about the size (in lines)
of a forthcoming block of content. When a size is defined the position()
method returns a range of lines (e.g. 7-12) rather than a single line.
=head2 move()
This method can be called with a single argument to move the line counter
forward by a number of lines. The method returns the new line number.
print $document->line(); # 42
print $document->move(2); # 44
If a block size has been set by a call to the size() method then the move()
method can be called without any arguments. The line number will be moved
forward by the number of lines indicated by size. The size value is then
cleared.
print $document->line(); # 44
print $document->size(2); # 2
print $document->move(); # 46
=head2 position()
This method returns the current line number or range of line numbers if
a block size has been set via a call to size().
print $document->position(); # 42
$document->size(3);
print $document->position(); # 42-45
The position() method can also be called with one or two arguments to
update the current line number and block size. The first argument
provides a number to be I<added> to the current line number. The
second optional argument indicates a size.
$document->position(); # 42
$document->position(10); # 52
$document->position(0, 3); # 52-55
$document->position(3, 4); # 55-59
=head2 location()
Returns a message indicating the document name and current position.
print $document->location() # testdoc line 55-59
=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/Tag.pm
Index: Tag.pm
===================================================================
#========================================================================
#
# Template::TT3::Tag
#
# DESCRIPTION
# Module implementing a base class tag object which is used to scan
# embedded tags within a template.
#
# 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: Tag.pm,v 1.1 2003/12/10 14:15:24 abw Exp $
#
#========================================================================
package Template::TT3::Tag;
use strict;
use warnings;
use Template::TT3::Base;
use vars qw( $VERSION $DEBUG $ERROR $WARNING $TAG );
use base qw( Template::TT3::Base );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
$TAG = {
start => '[%',
end => '%]',
name => 'tt3tag',
};
#------------------------------------------------------------------------
# init(\%config)
#
# Initialiser method called by base class new() method.
#------------------------------------------------------------------------
sub init {
my ($self, $config) = @_;
my $pkgtag = $self->pkgtag();
my $tagdef = { %$pkgtag, %$config };
@$self{ keys %$tagdef } = values %$tagdef;
return $self;
}
#------------------------------------------------------------------------
# pkgtag()
#
# Return the $TAG hash reference in the subclass package if defined, or
# in the base class package if not.
#------------------------------------------------------------------------
sub pkgtag {
my $self = shift;
my $class = ref $self || $self;
no strict 'refs';
return ${"$class\::TAG"} || $TAG;
}
#------------------------------------------------------------------------
# name()
# name($name)
#
# Accessor method to get/set the optional tag name.
#------------------------------------------------------------------------
sub name {
my $self = shift;
return @_ ? ($self->{ name } = shift) : $self->{ name };
}
#------------------------------------------------------------------------
# start()
# start($token)
#
# Accessor method to get/set the start token.
#------------------------------------------------------------------------
sub start {
my $self = shift;
return @_ ? ($self->{ start } = shift) : $self->{ start };
}
#------------------------------------------------------------------------
# end()
# end($token)
#
# Accessor method to get/set the end token.
#------------------------------------------------------------------------
sub end {
my $self = shift;
if (@_) {
$self->{ end } = shift;
delete $self->{ end_regex };
}
return $self->{ end };
}
#------------------------------------------------------------------------
# scan($start_tag, $textref, $document)
#
# Called when a start tag is matched, this method scans up to any defined
# end tag and then calls the parse() method to handle the content.
#------------------------------------------------------------------------
sub scan {
my ($self, $start, $textref, $document) = @_;
my ($end, $regex, $content);
$self->{ start_match } = $start;
$self->debug("Tag<$self->{ name }> scan()\n") if $DEBUG;
if (defined ($end = $self->{ end })) {
$regex = $self->{ end_regex } ||= do {
$end = ref $end eq 'Regexp' ? $end : quotemeta($end);
qr/ \G (.*?) ($end) /sx;
};
$self->debug("scanning for end with $end\n") if $DEBUG;
if ($$textref =~ /$regex/gc) {
my $content = $1;
$self->{ end_match } = $2;
$self->debug( 'matched content: "',
$self->_inspect_text($content),
"\"\n") if $DEBUG;
return $self->parse(\$content, $document);
}
else {
return $self->error("missing end tag: $self->{ end }");
}
}
else {
return $self->parse($textref, $document);
}
die 'not reached';
}
#------------------------------------------------------------------------
# parse($textref, $document)
#
# Method to parse the tag content, usually redefined by subclasses to do
# something useful. Otherwise, the action() method is called to activate
# any other handler for the tag.
#------------------------------------------------------------------------
sub parse {
my ($self, $textref, $document) = @_;
my $action = $self->{ action };
return $self->error('no action') unless defined $action;
my $result;
$self->debug("parse('$$textref', '$document->{ name }')\n") if $DEBUG;
if (ref $action eq 'CODE') {
# subroutine reference
eval {
$result = &$action($textref, $document);
};
$result = $self->error($@) if $@;
}
elsif ($action eq '1' || $action eq '0') {
# simple return code
$result = $action;
}
elsif (! ref $action) {
# method name to call against document
$result = $document->$action($textref)
|| $self->error($document->error());
}
else {
$result = $self->error('unknown action type: ', ref $action);
}
return $result;
}
#------------------------------------------------------------------------
# action()
# action($action)
#
# Accessor method to get/set the tag action handler.
#------------------------------------------------------------------------
sub action {
my $self = shift;
return @_ ? ($self->{ action } = shift) : $self->{ action };
}
sub parse_error {
my $self = shift;
my $document = shift;
$document->parse_error(@_);
return $self->error($document->error());
}
1;
__END__
=head1 NAME
Template::TT3::Tag - base class scanner for embedded tags
=head1 SYNOPSIS
package Template::TT3::Tag;
# TODO
=head1 DESCRIPTION
# TODO
=head1 METHODS
=head2 new()
# 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: