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

cvs@template-toolkit.org cvs@template-toolkit.org
Fri, 12 Nov 2004 18:33:29 +0000


cvs         04/11/12 18:33:29

  Modified:    lib/Template Handler.pm
  Log:
  * added element(), start_element() and end_element() methods
  * everything here still in flux
  
  Revision  Changes    Path
  1.2       +73 -190   TT3/lib/Template/Handler.pm
  
  Index: Handler.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/Handler.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- Handler.pm	2004/11/10 18:21:41	1.1
  +++ Handler.pm	2004/11/12 18:33:29	1.2
  @@ -17,7 +17,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Handler.pm,v 1.1 2004/11/10 18:21:41 abw Exp $
  +#   $Id: Handler.pm,v 1.2 2004/11/12 18:33:29 abw Exp $
   #
   #========================================================================
   
  @@ -29,15 +29,13 @@
   use Template::Base;
   use base qw( Template::Base );
   
  -our $VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
  +our $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
   our $DEBUG   = 0 unless defined $DEBUG;
   our $ERROR   = '';
   our $THROW   = 'handler';
   our $TYPE    = 'block';
   
   
  -
  -
   #------------------------------------------------------------------------
   # init(\%config)
   # 
  @@ -67,101 +65,80 @@
   }
   
   
  -#------------------------------------------------------------------------
  -# start_block( $type => @args )
  -# start_block(\@expr, %opts)
  -# start_block(\@expr, \%opts)
  -#
  -# Begins a new block directive which defines a nested block of template
  -# content.  The arguments passed are added to the enclosing block content
  -# as the stub of a new directive.  Then a new content block is created
  -# and added to the stack.
  -#------------------------------------------------------------------------
  -
  -sub start_block {
  +sub element {
       my $self = shift;
  -    my $expr = @_ && UNIVERSAL::isa($_[0], 'ARRAY') ? shift : [ splice(@_) ];
  -    my $opts = @_ && UNIVERSAL::isa($_[0], 'HASH')  ? shift : { @_ };
  -    my $type = $expr->[0];
  -
  -    $self->debug("start_block(", join(', ', @$expr), ")\n") if $DEBUG;
   
  -    # options can indicate class for new handler, otherwise create
  -    # a handler of the same class as $self, by calling new() as 
  -    # an object method against $self
  -    my $class = $opts->{ class } || ref $self;
  +    # first argument can be an element object or a reference to a list of 
  +    # [ type => @args ], followed by a list or reference to a hash of named
  +    # options.  If the first argument isn't a ref then we gobble up the entire
  +    # args list
   
  -    return $class->new({
  -        %$opts,
  -        parent => $self,
  -        type   => $type,
  -        expr   => $expr,
  -    }) || $self->error( "failed to create child handler: ", 
  -                        $class->error() );
  -}
  -
  -
  -#------------------------------------------------------------------------
  -# next_block()
  -#
  -# Ends the current block directive previously started by calling 
  -# start_block() and then starts a new block, chained onto the 
  -# same parent expresssion.  This is used to implement multi-block 
  -# directives structured like IF...ELSIF...ELSE...END.
  -#------------------------------------------------------------------------
  -
  -sub next_block {
  -    my ($self, $type, @args) = @_;
  -
  -    $self->debug("next_block(", $type || '', ")\n") if $DEBUG;
  +    my $args = @_ && ref $_[0] ? shift : [ splice(@_) ];
  +    my $opts = @_ && UNIVERSAL::isa($_[0], 'HASH')  ? shift : { @_ };
  +    my $element;
   
  -    # if a $type argument is provided then ensure it matches 
  -    # the value defined in $self->{ type }
  -    if (defined $type) {
  -        return $self->error("unexpected $type in $self->{ type } block")
  -            unless $type eq $self->{ type };
  +    # if $args is an array of [ type => @args ] then we lookup the 
  +    # element type and instantiate an object via the new() constructor 
  +    # method, passing @args as arguments
  +
  +    if (UNIVERSAL::isa($args, 'ARRAY')) {
  +        # first item in element list is its type, rest are constructor args
  +        my $name  = shift @$element || return $self->error('no element type');
  +        my $type = $self->{ elements }->{ $name }
  +            || return $self->error("invalid element: $name");
  +
  +        $self->debug("element( $name => ", join(', ', @$args), " )\n") if $DEBUG;
  +
  +        $element = $type->new(@$args)
  +            || return $self->error( "failed to create $name element: ", 
  +                                    $type->error() );
       }
  +    else {
  +        $element = $args;
  +        $self->debug("element( $element )\n") if $DEBUG;
  +    }
   
  -    # add content block to end of expression 
  -    my $expr = $self->{ expr };
  -    push(@$expr, $self->{ content });
  +    push(@{ $self->{ content } }, $element);
   
  -    $self->{ content } = [ ];
  +    # set pending flag unless commit option passed
  +    $self->{ pending } = $opts->{ commit } ? 0 : 1;
   
  -    return $self;
  +    return $element;
   }
   
   
  -#------------------------------------------------------------------------
  -# end_block()
  -# end_block($type)
  -#
  -# Ends a block directive previously started by calling start_block().
  -# The content block is removed from the stack and added to the directive
  -# stub at the end of the enclosing block.
  -#------------------------------------------------------------------------
  -
  -sub end_block {
  -    my ($self, $type, @args) = @_;
  +sub start_element {
  +    my $self = shift;
  +    my $args = @_ && UNIVERSAL::isa($_[0], 'HASH') ? shift : [ splice(@_) ];
  +    my $opts = @_ && UNIVERSAL::isa($_[0], 'HASH') ? shift : { @_ };
  +    my $name = shift @$args 
  +        || return $self->error('no element type');
  +    my $type = $self->{ elements }->{ $name }
  +        || return $self->error("invalid element: $name");
   
  -    $self->debug("end_block(", join(', ', @_), ")\n") if $DEBUG;
  +    $self->debug("start_element( $name => ", join(', ', @$args), " )\n") 
  +        if $DEBUG;
   
  -    # call end() to return block as a structured expression
  -    my $expr = $self->end($type);
  +    # set parent link back to self
  +    $opts->{ parent } = $self;
   
  -    # look for a parent to report to, otherwise return expression
  -    my $parent = delete $self->{ parent }
  -        || return $expr;
  +    # call element start() method
  +    return $type->start($args, $opts)
  +        || $self->error( "failed to start $name element: ", 
  +                         $type->error() );
  +}
   
  -    my $result = $parent->expr($expr, @args)
  -        || return $self->error($parent->error());
  +sub end_element {
  +    my ($self, $element) = @_;
   
  -    return $self->{ dangling }
  -         ? $result->end_block()
  -         : $result;
  +    $self->debug("end_element( $element )\n") if $DEBUG;
   
  +    push(@{ $self->{ content } }, $element);
  +    return $self;
   }
   
  +
  +
   sub end {
       my ($self, $type) = @_;
   
  @@ -173,14 +150,24 @@
           return $self->error("unexpected end ($type) in $self->{ type } block")
               unless $type eq $self->{ type };
       }
  +
  +    my $element = $self->{ element };
   
  -    # add content block to end of expression 
  -    my $expr = $self->{ expr };
  -    push(@$expr, $self->{ content });
  +    if ($element) {
  +        my $result = $element->end($self->{ args }, $self->{ content })
  +            || return $self->error($element->error());
   
  -    return $expr;
  +        return $self->end_element($result);
  +    }
  +    else {
  +        # add content block to end of expression 
  +        my $expr = $self->{ expr };
  +        push(@$expr, $self->{ content });
  +        return $expr;
  +    }
   }
   
  +
   #------------------------------------------------------------------------
   # expr( $type => @args )
   # expr([$type => @args], @options)
  @@ -202,7 +189,6 @@
       my $self = shift;
       my $expr = @_ && UNIVERSAL::isa($_[0], 'ARRAY') ? shift : [ splice(@_) ];
       my $opts = @_ && UNIVERSAL::isa($_[0], 'HASH')  ? shift : { @_ };
  -    my ($type, $hook, $action, $node);
   
       $self->debug("expr(", join(', ', @$expr), ")\n") if $DEBUG;
   
  @@ -376,115 +362,12 @@
   
   
   
  -#------------------------------------------------------------------------
  -# event( $type => $arg1, $arg2, $arg3, ...)
  -# event([$type => $arg1, $arg2, $arg3, ...], commit => 1)
  -# event([$type => $arg1, $arg2, $arg3, ...], { commit => 1 })
  -#------------------------------------------------------------------------
  -
  -sub old_event {
  -    my $self = shift;
  -
  -    # fold args into list ref and examine first item for event type
  -    my $item = @_ && UNIVERSAL::isa($_[0], 'ARRAY') ? shift : [ @_ ];
  -    my $opts = @_ && UNIVERSAL::isa($_[0], 'HASH')  ? shift : { @_ };
  -    my ($type, $hook, $action, $node);
  -
  -    ITEM: {
  -      # we need to be able to repeat this section because a hook set via 
  -      # hook_next() could change the $item to a different type.  It could also
  -      # conceivably set a hook for the type of the new item (although I can't 
  -      # think why...) so we check it all through again (via a redo) after the
  -      # hook callback is called.
  -
  -      $type = @$item ? $item->[0] : return $self->error('no event type specified');
  -      $hook = delete $self->{ hook_next };
  -
  -      # call any event hook set by hook_next()
  -      if ($hook) {
  -          my ($htype, $hcode, @hargs) = @$hook;
  -          if ($htype eq $type) {
  -              $self->debug("event($type) hooked\n") if $DEBUG;
  -              unshift(@hargs, $item);
  -              &$hcode($self, @hargs) || return;
  -              redo ITEM;
  -          }
  -          else {
  -              $self->debug("event($type) not hooked ($htype wanted)\n") if $DEBUG;
  -          }
  -      }
  -    }
  -
  -    # look for an action associated with this event type, walking up
  -    # the parent chain until the action is found or we run out of parents
  -
  -    $node = $self;
  -    while ($node) {
  -        last if ($action = $node->{ events }->{ $type });
  -        $node = $node->{ parent };
  -    }
  -
  -    return $self->error("invalid $type event")
  -        unless defined $action;
   
  -    $self->debug("event($type) action: $action\n") if $DEBUG;
   
  -    # false value for $action indicates silent decline
  -    return $self unless $action;
  -
  -    # first look for a code reference (which is called) or hash reference
  -    # (which is unpacked to reveal an action)
  -
  -    if (UNIVERSAL::isa($action, 'CODE')) {
  -        return eval {
  -            &$action($self, $item, $opts);
  -        };
  -        return $self->error($@) if $@;
  -        return $self->error("most strange - eval didn't return or die");
  -    }
  -    elsif (UNIVERSAL::isa($action, 'HASH')) {
  -        # unpack $action HASH, looking for 'action' item, 
  -        # defaulting it to EXPAND if undefined
  -        $opts = $action;
  -        $action = $opts->{ action } || EXPAND;
  -    }
  -
  -    # now see if $action matches one of the numerical constants or string
  -    # values that indicates a known action, or see if it is a method that 
  -    # the $handler->can() call;
  -
  -    if (+$action == ACCEPT || $action eq 'accept') {
  -        $self->debug("event($type) action: ACCEPT\n") if $DEBUG;
  -        return $self->accept($item, $opts);
  -    }
  -    elsif (+$action == EXPAND || $action eq 'expand') {
  -        $self->debug("event($type) action: EXPAND (hash)\n") if $DEBUG;
  -        return $self->expand($item, $opts);
  -    }
  -    elsif (+$action == EXTEND || $action eq 'extend') {
  -        $self->debug("event($type) action: EXTEND (hash)\n") if $DEBUG;
  -        return $self->extend($item, $opts);
  -    }
  -    elsif (+$action == REDUCE || $action eq 'reduce') {
  -        $self->debug("event($type) action: REDUCE\n") if $DEBUG;
  -        return $self->reduce($item, $opts);
  -    }
  -    elsif ($self->can($action)) {
  -        return $self->$action($item, $opts);
  -    }
  -    else {
  -        return $self->error("invalid event action: $action");
  -    }
  -    
  -    die('not reached');
  -}
  -
  -
  -
  -
   1;
   
   __END__
  +
   =head1 NAME
   
   Template::Handler - handler for parse events
  @@ -515,7 +398,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.1 $
  +$Revision: 1.2 $
   
   =head1 COPYRIGHT