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

[cvs@template-toolkit.org]

cvs         04/11/10 17:56:13

  Modified:    lib/Template/Tag Directive.pm
  Log:
  * added custom init() method to handle various configuration parameters
    (tag_style, tag_styles, tag_start and tag_end)
  
  * added tag style management
  
  Revision  Changes    Path
  1.3       +101 -7    TT3/lib/Template/Tag/Directive.pm
  
  Index: Directive.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/Tag/Directive.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- Directive.pm	2004/11/09 13:30:03	1.2
  +++ Directive.pm	2004/11/10 17:56:13	1.3
  @@ -16,7 +16,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Directive.pm,v 1.2 2004/11/09 13:30:03 abw Exp $
  +#   $Id: Directive.pm,v 1.3 2004/11/10 17:56:13 abw Exp $
   #
   #========================================================================
   
  @@ -29,7 +29,7 @@
   use Template::Tag;
   use base qw( Template::Tag );
   
  -our $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
  +our $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
   our $DEBUG   = 0 unless defined $DEBUG;
   our $ERROR   = '';
   our $PARSER  = 'Template::Parser';
  @@ -40,10 +40,41 @@
   our $DELIMITER = qr/ (?: $WHITESPACE ; $WHITESPACE )+ /ox 
       unless defined $DELIMITER;
   
  -# default tag configuration
  +our $TAG_STYLES = {
  +    # special controls
  +    off       => { enabled => 0 },
  +    on        => { enabled => 1 },
  +
  +    # standard TT tags styles
  +    square    => [ '[%', '%]' ],            # [% ... %]
  +    angle     => [ '<%', '%>' ],            # <% ... %>
  +    round     => [ '(%', '%)' ],            # (% ... %)
  +    star      => [ '[*', '*]' ],            # [* ... *]
  +    html      => [ '<!--', '-->' ],         # <!-- ... -->
  +    xml       => [ '<', '/>' ],             # < ... />
  +    ttxml     => [ qr| < (?i:tt) : |x,      # <tt: ... />
  +                   qr| /? > |x 
  +                 ],
  +    
  +    # compatability styles
  +    metatext  => [ '%%', '%%' ],
  +    mason     => [ '<%', '>'  ],
  +    asp       => [ '<%', '%>' ],
  +    php       => [ '<?', '?>' ],
  +    template1 => [ qr/[\[%]%/, qr/%[\]%]/ ],    
  +} unless defined $TAG_STYLES;
  +
  +$TAG_STYLES->{ default  } = 
  +$TAG_STYLES->{ template } = 
  +$TAG_STYLES->{ tt3      } = 
  +$TAG_STYLES->{ tt2      } = 
  +$TAG_STYLES->{ square   };
  +
   our $TAG = {
  -    start       => '[%',
  -    end         => '%]',
  +    style       => 'default',
  +    styles      => $TAG_STYLES,
  +    start       => $TAG_STYLES->{ default }->[0],
  +    end         => $TAG_STYLES->{ default }->[1],
       pre_chomp   => 0,
       post_chomp  => 0,
       side_effect => 1,
  @@ -51,8 +82,52 @@
       comment     => 1,
       ignore      => $WHITESPACE,
       delimiter   => $DELIMITER,
  -};
  +} unless defined $TAG;
  +
  +
  +# TODO: should upgrade ignore (or rename as whitespace?) and delimiter
  +# to regexen if not already so?
  +
  +sub init {
  +    my ($self, $config) = @_;
  +
  +    # we allow the start, end, style and styles config items to be preceeded
  +    # with a 'tag_' prefix.  If the unadorned item (e.g. start) isn't defined
  +    # in the config then we look for it with the prefix (e.g. tag_start) and
  +    # rename it if found.
  +
  +    foreach my $item (qw( start end style styles )) {
  +        next if defined $config->{ $item };
  +        $config->{ $item } = delete $config->{"tag_$item"}
  +            if defined $config->{"tag_$item"};
  +    }
  +
  +    # fetch the default $TAG in this package or a subclass
  +    my $default = $self->pkgvar( TAG => $TAG );
  +        
  +    # styles can be specified in the config, in the default $TAG or in $TAG_STYLES 
  +    my $styles = $config->{ styles } ||= $default->{ styles }
  +        || $self->pkgvar( TAG_STYLES => $TAG_STYLES );
  +
  +    # determine tag_style from config or $default $TAG
  +    my $style = $config->{ style } || $default->{ style };
  +    my $sdata = $styles->{ $style } 
  +        || return $self->error("invalid tag style: $style");
  +
  +    # if stype data ($sdata) is a list of [ start, end ] then convert to a hash
  +    $sdata = { start => $sdata->[0], end => $sdata->[1] }
  +        if UNIVERSAL::isa($sdata, 'ARRAY');
  +
  +    # copy any items from style into config that haven't been explicitly 
  +    # set in the config
  +    while (my ($key, $value) = each %$sdata) {
  +        $config->{ $key } = $value
  +            unless defined $config->{ $key };
  +    }    
   
  +    return $self->SUPER::init($config);
  +}
  +
   
   sub scan {
       my ($self, $textref, $handler, $match) = @_;
  @@ -277,6 +352,25 @@
   }
   
   
  +sub style {
  +    my ($self, $name) = @_;
  +
  +    return $self->{ style } unless defined $name;
  +
  +    my $style = $self->{ styles }->{ $name }
  +        || return $self->error("invalid tag style: $name");
  +
  +    # convert list into hash
  +    $style = { start => $style->[0], end => $style->[1] }
  +        if UNIVERSAL::isa($style, 'ARRAY');
  +
  +    # copy items in $style into $self
  +    @$self{ keys %$style } = values %$style;
  +    
  +    return $name;
  +}
  +
  +
   1;
   __END__
   
  @@ -306,7 +400,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.2 $
  +$Revision: 1.3 $
   
   =head1 COPYRIGHT