[Templates-cvs] cvs commit: TT3/lib/Template/TT3 Document.pm

cvs@template-toolkit.org cvs@template-toolkit.org
Thu, 11 Dec 2003 17:29:45 +0000


cvs         03/12/11 17:29:44

  Modified:    lib/Template/TT3 Document.pm
  Log:
  added some hacks for testing
  
  Revision  Changes    Path
  1.3       +73 -19    TT3/lib/Template/TT3/Document.pm
  
  Index: Document.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/TT3/Document.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- Document.pm	2003/12/11 15:09:39	1.2
  +++ Document.pm	2003/12/11 17:29:44	1.3
  @@ -18,7 +18,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Document.pm,v 1.2 2003/12/11 15:09:39 abw Exp $
  +#   $Id: Document.pm,v 1.3 2003/12/11 17:29:44 abw Exp $
   #
   #========================================================================
   
  @@ -31,11 +31,12 @@
   use vars qw( $VERSION $DEBUG $ERROR $WARNING $TAGS );
   use base qw( Template::TT3::Base );
   
  -$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
  +$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
   $DEBUG   = 0 unless defined $DEBUG;
   $ERROR   = '';
   
   use constant TEXT => 'text';
  +use constant TAG  => 'tag';
   
   
   #------------------------------------------------------------------------
  @@ -80,6 +81,23 @@
   
   
   #------------------------------------------------------------------------
  +# tag($text)
  +#
  +# Add a tag to the body.  This is a temporary hack.
  +#------------------------------------------------------------------------
  +
  +sub tag {
  +    my ($self, $text) = @_;
  +    my $textref = ref $text ? $text : \$text;
  +    $self->debug("tag at line $self->{ line } [$$textref]\n") if $DEBUG;
  +
  +    my $tagdir = [ TAG, $textref, $self->position() ];
  +    push(@{ $self->{ body } }, $tagdir);
  +
  +    return $tagdir;
  +}
  +
  +#------------------------------------------------------------------------
   # text($text)
   #
   # Add a chunk of text to the current block on the stack.  Newlines are
  @@ -91,25 +109,34 @@
       my ($self, $text) = @_;
       my $textref = ref $text ? $text : \$text;
       $self->debug("text at line $self->{ line } [$$textref]\n") if $DEBUG;
  +
  +    # for debugging
  +    my $posn = $self->position();
  +
       $self->{ line } += ($$textref =~ tr/\n//);
       $self->{ size }  = 0;
  -    my $flag;
  +
  +    # can't have a pending side-effect directive run across text
  +    delete $self->{ pending };
   
       # remove leading whitespace if post_chomp flag set
  -    if ($flag = delete $self->{ post_chomp }) {
  +    if (my $flag = delete $self->{ post_chomp }) {
           $flag ||= CHOMP_ALL;
           $flag = ($flag == CHOMP_COLLAPSE ? ' ' : '');
  -        $self->debug("post-chomping text\n") if $DEBUG;
  +        $self->debug("post-chomping text [$$textref]\n") if $DEBUG;
           $$textref =~ s/^\s+/$flag/;
  +        $self->debug("post-chomped text [$$textref]\n") if $DEBUG;
       }
  -
  -    my $textdir = [ TEXT, $textref ];
  -    push(@{ $self->{ body } }, $textdir);
   
  -    # TODO ???
  -    $self->{ pending } = 0;
  -
  -    return $textdir;
  +    if (length $$textref) {
  +        my $textdir = [ TEXT, $textref, $posn ];
  +        push(@{ $self->{ body } }, $textdir);
  +        return $textdir;
  +    }
  +    else {
  +        # don't both adding empty strings
  +        return 1;
  +    }
   }
   
   
  @@ -120,11 +147,13 @@
   
       my $last = $self->{ body }->[-1] || return 1;
       return 1 unless $last->[0] eq TEXT;
  -    my $textref = $last->[-1];
  +    my $textref = $last->[1];
   
       $self->debug("pre-chomping text [$$textref]\n") if $DEBUG;
       $$textref =~ s/\s+$/$flag/;
       $self->debug("pre-chomped text [$$textref]\n") if $DEBUG;
  +    pop(@$last) unless length $$textref;
  +
       return 1;
   }
   
  @@ -139,9 +168,9 @@
   
   #------------------------------------------------------------------------
   # body()
  -# body($item)
  +# body($item, $item, ...)
   #
  -# Returns body list when called without arguments.  Adds item to body 
  +# Returns body list when called without arguments.  Adds item(s) to body 
   # when called with an argument.
   #------------------------------------------------------------------------
   
  @@ -149,10 +178,10 @@
       my $self = shift;
       return $self->{ body } unless @_;
   
  -    my $item = shift;
  -    $self->debug("body item at line $self->{ line }\n") if $DEBUG;
  +    my ($item, %options) = @_;
  +    $self->debug("body item(s) at line $self->{ line }\n") if $DEBUG;
   
  -    push(@{ $self->{ body } }, $item);
  +    push(@{ $self->{ body } }, @_);
   
       # TODO ???
       $self->{ pending    } = 0;
  @@ -163,6 +192,31 @@
   
   
   
  +#------------------------------------------------------------------------
  +# directive($directive, %options)
  +#
  +# Add a directive to the current block on the stack as it is.  As for the 
  +# variable() method, the 'line' and 'position' members are not updated.
  +# The 'commit' flag can be passed as an argument to ensure that this
  +# directive is commited to the document and not marked as "pending" for 
  +# a following side-effect block directive to adopt.
  +#------------------------------------------------------------------------
  +
  +sub directive {
  +    my ($self, $directive, %options) = @_;
  +    my $commit = $options{ commit };
  +    $self->{ pending } = $commit ? 0 : 1;
  +
  +    $self->debug("directive (", $commit ? 'commit' : 'pending', 
  +                 ") at line $self->{ position }: [@$directive]\n") 
  +        if $DEBUG;
  +
  +    push(@{ $self->{ stack }->[-1]->[-1] }, $directive);
  +
  +    return $directive;
  +}
  +
  +
   sub name {
       my $self = shift;
       return @_ ? ($self->{ name } = shift) : $self->{ name };
  @@ -349,7 +403,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.2 $
  +$Revision: 1.3 $
   
   =head1 COPYRIGHT