File Coverage

lib/Template/Plugin/XML/Style.pm

Criterion	Covered	Total	%
statement	40	41	97.5
branch	4	4	100.0
condition	19	23	82.6
subroutine	7	7	100.0
pod	0	4	0.0
total	70	79	88.6

#============================================================= -*-Perl-*-
#
# Template::Plugin::XML::Style
#
# DESCRIPTION
#   Template Toolkit plugin which performs some basic munging of XML
#   to perform simple stylesheet like transformations.
#
# AUTHOR
#   Andy Wardley
#
# COPYRIGHT
#   Copyright (C) 2001-2006 Andy Wardley.  All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
#============================================================================

package Template::Plugin::XML::Style;

use strict;
use warnings;
use base 'Template::Plugin::Filter';

our $VERSION = 2.36;
our $DYNAMIC = 1;
our $FILTER_NAME = 'xmlstyle';


#------------------------------------------------------------------------
# new($context, \%config)
#------------------------------------------------------------------------

sub init {
    my $self = shift;
    my $name = $self->{ _ARGS }->[0] || $FILTER_NAME;
    $self->install_filter($name);
    return $self;
}


sub filter {
    my ($self, $text, $args, $config) = @_;

    # munge start tags
    $text =~ s/ < ([\w\.\:]+) ( \s+ [^>]+ )? >
	      / $self->start_tag($1, $2, $config)
	      /gsex;

    # munge end tags
    $text =~ s/ < \/ ([\w\.\:]+) >
	      / $self->end_tag($1, $config)
	      /gsex;

    return $text;

}


sub start_tag {
    my ($self, $elem, $textattr, $config) = @_;
    $textattr ||= '';
    my ($pre, $post);

    # look for an element match in the stylesheet
    my $match = $config->{ $elem }
    	|| $self->{ _CONFIG }->{ $elem }
	    || return "<$elem$textattr>";

    # merge element attributes into copy of stylesheet attributes
    my $attr = { %{ $match->{ attributes } || { } } };
    while ($textattr =~ / \s* ([\w\.\:]+) = " ([^"]+) " /gsx ) {
        $attr->{ $1 } = $2;
    }
    $textattr = join(' ', map { "$_=\"$attr->{$_}\"" } keys %$attr);
    $textattr = " $textattr" if $textattr;

    $elem = $match->{ element    } || $elem;
    $pre  = $match->{ pre_start  } || '';
    $post = $match->{ post_start } || '';

    return "$pre<$elem$textattr>$post";
}


sub end_tag {
    my ($self, $elem, $config) = @_;
    my ($pre, $post);

    # look for an element match in the stylesheet
    my $match = $config->{ $elem }
    	|| $self->{ _CONFIG }->{ $elem }
        || return "";

    $elem = $match->{ element  } || $elem;
    $pre  = $match->{ pre_end  } || '';
    $post = $match->{ post_end } || '';

    return "$pre$post";
}


1;

__END__