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

[cvs@template-toolkit.org]

cvs         04/12/01 11:16:32

  Modified:    lib/Template/Generator Perl.pm
  Log:
  * first attempt at code for generating MY variables
  
  Revision  Changes    Path
  1.7       +50 -3     TT3/lib/Template/Generator/Perl.pm
  
  Index: Perl.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/Generator/Perl.pm,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- Perl.pm	2004/11/29 11:38:19	1.6
  +++ Perl.pm	2004/12/01 11:16:32	1.7
  @@ -18,7 +18,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Perl.pm,v 1.6 2004/11/29 11:38:19 abw Exp $
  +#   $Id: Perl.pm,v 1.7 2004/12/01 11:16:32 abw Exp $
   #
   #========================================================================
   
  @@ -30,7 +30,7 @@
   use Template::Generator;
   use base qw( Template::Generator );
   
  -our $VERSION  = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
  +our $VERSION  = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
   our $DEBUG    = 0 unless defined $DEBUG;
   our $ERROR    = '';
   #our $DEFAULT  = '_default';
  @@ -406,6 +406,21 @@
   
   sub generate_variable {
       my ($self, $nodes) = @_;
  +
  +    if (@$nodes == 1) {
  +        my $node = $nodes->[0];
  +        my ($name, $args) = @$node;
  +        if ($name->[0] eq 'ident') {
  +            $name = $name->[1];
  +            if (my $code = $self->{ variables }->{ $name }) {
  +                $self->debug("got code for $name: $code\n");
  +                return $code;
  +            }
  +        }
  +        else {
  +            $self->debug("not an ident; $name->[0]\n");
  +        }
  +    }
       return '$stash->get(' . $self->variable_nodes($nodes) . ')';
   }
   
  @@ -499,6 +514,38 @@
   
   
   #------------------------------------------------------------------------
  +# generate_my(@list) 
  +#------------------------------------------------------------------------
  +
  +sub generate_my {
  +    my ($self, @list) = @_;
  +    my @items;
  +
  +    foreach my $assign (@list) {
  +        my ($type, $var, $value) = @$assign;
  +        return $self->error("non-assign node in MY: $assign->[0]")
  +            unless $type eq 'assign';
  +        ($type, $var) = @$var;
  +        return $self->error("cannot create non-variable MY variable")
  +            unless $type eq 'variable';
  +        return $self->error("cannot create complex MY variable")
  +            if @$var > 1;
  +        $var = $var->[0];
  +        my ($name, $args) = @$var;
  +        return $self->error("cannot create MY variable with arguments: $args")
  +            if $args && @$args;
  +        return $self->error("cannot create non-identifier MY variable: $var->[0]->[0]")
  +            unless $name->[0] eq 'ident';
  +        $name = $name->[1];
  +        $value = $self->generate($value);
  +        push(@items, "my \$var_$name = $value");
  +        $self->{ variables }->{ $name } = "\$var_$name";
  +    }
  +    return join('; ', @items) . ';';
  +}
  +
  +
  +#------------------------------------------------------------------------
   # generate_default($setlist)
   #------------------------------------------------------------------------
   
  @@ -1484,7 +1531,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.6 $
  +$Revision: 1.7 $
   
   =head1 COPYRIGHT