File Coverage

blib/lib/Embperl/Syntax/HTML.pm

Criterion	Covered	Total	%
statement	57	94	60.6
branch	22	42	52.3
condition	4	6	66.6
subroutine	8	11	72.7
pod	6	8	75.0
total	97	161	60.2

###################################################################################
#
#   Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh  www.ecos.de
#   Embperl - Copyright (c) 2008-2014 Gerald Richter
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#   $Id: HTML.pm 1578075 2014-03-16 14:01:14Z richter $
#
###################################################################################



package Embperl::Syntax::HTML ;

use Embperl::Syntax (':types') ;

use strict ;
use vars qw{@ISA %Attr %AssignAttr %AssignAttrLink %Quotes} ;


@ISA = qw(Embperl::Syntax) ;


###################################################################################
#
#   Methods
#
###################################################################################

# ---------------------------------------------------------------------------------
#
#   Create new Syntax Object
#
# ---------------------------------------------------------------------------------

sub new

    {
    my $self = shift ;

    $self = Embperl::Syntax::new ($self) ;

    if (!$self -> {-htmlAssignAttr})
        {
        $self -> {-htmlAssignAttr}     = $self -> CloneHash (\%AssignAttr) ;
        $self -> {-htmlAssignAttrLink} = $self -> CloneHash (\%AssignAttr) ;
        $self -> {-htmlQuotes}         = $self -> CloneHash (\%Quotes) ;
        }

    return $self ;
    }


# ---------------------------------------------------------------------------------
#
#   Add new element
#
# ---------------------------------------------------------------------------------


sub AddElement

    {
    my ($self, $tagtype, $tagname, $attrs, $attrsurl, $attrsnoval, $procinfo, $taginfo, $addsess) = @_ ;


    my $ttref ;
    die "'$tagtype' unknown" if (!($ttref = $self -> {-root}{$tagtype})) ;
    my $ttfollow = ($ttref -> {'follow'} ||= {}) ;

    $ttref -> {'follow'}{-contains} = 'abcdefghijklmnopqrstuvwxyz0123456789_' ;

    my $tag = $ttfollow -> {$tagname} = {
                                'text'      => $tagname,
                                'unescape'  => 1,
                                (ref($taginfo) eq 'HASH'?%$taginfo:()),
                              } ;
    $tag -> {'procinfo'} = { $self -> {-procinfotype} => $procinfo, (ref($taginfo) eq 'HASH'?%{$taginfo->{procinfo}}:()) } if ($procinfo) ;

    my %inside = (%{$self -> {-htmlQuotes}},
                   'removeslash' =>
        {
        'text' => "/",
        'nodetype' => 0,
        'cdatatype' => 0,
        'removespaces' => 0,
        'nodename' => '',
        },

                 ) ;
    my $addinside = 0 ;
    if ($attrs)
        {
        my $assignattr = $self -> {-htmlAssignAttr} ;
        foreach (@$attrs)
            {
            $inside {$_} = { 'text' => $_,  'nodename' => $_,  'follow' => $assignattr },
            $addinside++ ;
            }
        }
    if ($attrsurl)
        {
        my $assignattr = $self -> {-htmlAssignAttrLink} ;
        foreach (@$attrsurl)
            {
            $inside {$_} = { 'text' => $_,  'nodename' => $_,  'follow' => $assignattr },
            $addinside++ ;
            }
        $tag -> {'procinfo'}{$self->{-procinfotype}}{perlcode} .=
            q[Embperl::Cmd::AddSessionIdToLink (%$n%, ] . $addsess . q[,'] . join ("','", @$attrsurl) . "') ;"
                if ($addsess) ;
        }
    if ($attrsnoval)
        {
        foreach (@$attrsnoval)
            {
            $inside {$_} = { 'text' => $_,  , 'nodetype'   => ntypAttr, },
            $addinside++ ;
            }
        }
    $tag -> {'inside'} = \%inside if ($addinside) ;

    if (exists ($tag -> {'inside'}))
        {
        $self -> {-htmlTagInside} ||= [] ;
        push @{$self -> {-htmlTagInside}}, $tag -> {'inside'} ;
        }

    return $tag ;
    }

# ---------------------------------------------------------------------------------
#
#   Add new simple html tag
#
# ---------------------------------------------------------------------------------


sub AddTag

    {
    my $self = shift ;


    $self -> AddToRoot ({
                        'A HTML Tag' => {
                            'text' => '<',
                            'end'  => '>',
                            }
                        }) if (!exists $self -> {-root}{'A HTML Tag'}) ;


    $self -> AddElement ('A HTML Tag', @_) ;
    }



# ---------------------------------------------------------------------------------
#
#   Add new simple html tag which is also available inside of other tags
#
# ---------------------------------------------------------------------------------


sub AddTagInside

    {
    my $self = shift ;

    my $tag = $self -> AddTag (@_) ;


    foreach my $inside (@{$self -> {-htmlTagInside}})
        {
        if (!exists ($inside -> {'HTML Tag'}))
            {
            $inside -> {'HTML Tag'} =
                           {
                            'text' => '<',
                            'end'  => '>',
                            'follow' => {},
                            } ;
            }
        $inside -> {'HTML Tag'}{follow}{$_[0]} = $tag ;
        }

    my $quotes = $self -> {"-htmlQuotes"} ;
    while (my ($k2, $v2) = each %$quotes)
        {
        if (ref($v2) eq 'HASH')
	    {
            my $inside = $v2 -> {inside} ;
            if (!exists ($inside -> {'HTML Tag'}))
                {
                $inside -> {'HTML Tag'} =
                               {
                                'text' => '<',
                                'end'  => '>',
                                'follow' => {},
                                } ;
                }
            $inside -> {'HTML Tag'}{follow}{$_[0]} = $tag ;

	    }
        }

    $quotes = $self -> {"-htmlAssignAttr"}{'Assign'}{follow} ;
    while (my ($k2, $v2) = each %$quotes)
        {
        if (ref($v2) eq 'HASH')
	    {
            my $inside = $v2 -> {inside} ;
            if (!exists ($inside -> {'HTML Tag'}))
                {
                $inside -> {'HTML Tag'} =
                               {
                                'text' => '<',
                                'end'  => '>',
                                'follow' => {},
                                } ;
                }
            $inside -> {'HTML Tag'}{follow}{$_[0]} = $tag ;

	    }
        }
    $quotes = $self -> {"-htmlAssignAttrLink"}{'Assign'}{follow} ;
    while (my ($k2, $v2) = each %$quotes)
        {
        if (ref($v2) eq 'HASH')
	    {
            my $inside = $v2 -> {inside} ;
            if (!exists ($inside -> {'HTML Tag'}))
                {
                $inside -> {'HTML Tag'} =
                               {
                                'text' => '<',
                                'end'  => '>',
                                'follow' => {},
                                } ;
                }
            $inside -> {'HTML Tag'}{follow}{$_[0]} = $tag ;

	    }
        }
    }


# ---------------------------------------------------------------------------------
#
#   Add new html comment tag
#
# ---------------------------------------------------------------------------------


sub AddComment

    {
    my $self = shift ;


    $self -> AddToRoot (
                    {
                    'HTML Comment' => {
                        'text' => '',
                            }
                        }) if (!exists $self -> {-root}{'HTML Comment'}) ;

    $self -> AddElement ('HTML Comment', @_) ;
    }

# ---------------------------------------------------------------------------------
#
#   Add new block html tag
#
# ---------------------------------------------------------------------------------


sub AddTagBlock

    {
    my ($self, $tagname, $attrs, $attrsurl, $attrsnoval, $procinfo, $taginfo) = @_ ;


    my $tag = $self -> AddTag ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo, $taginfo) ;

    $tag -> {'nodetype'} = &ntypStartTag ;

    $tag = $self -> AddTag ("/$tagname") ;

    $tag -> {'nodetype'} = &ntypEndTag ;
    $tag -> {'starttag'} = $tagname ;
    }


# ---------------------------------------------------------------------------------
#
#   Add new html tag which is an optional end tag
#
# ---------------------------------------------------------------------------------


sub AddTagWithStart

    {
    my ($self, $tagname, $starttag, $attrs, $attrsurl, $attrsnoval, $procinfo, $taginfo) = @_ ;


    my $tag = $self -> AddTag ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo, $taginfo) ;

    $tag -> {'starttag'} = $starttag ;
    }




# ---------------------------------------------------------------------------------
#
#
#
# ---------------------------------------------------------------------------------



sub AddInside

    {
    my ($self, $tagtype, $inside) = @_ ;

    my $ttref ;
    die "'$tagtype' unknown" if (!($ttref = $self -> {-tagtype}{$tagtype})) ;
    my $ttinside = ($ttref -> {'inside'} ||= {}) ;

    while (my ($k, $v) = each (%$inside))
        {
        $ttinside -> {$k} = $v ;
        }

    }


###################################################################################
#
#   Definitions for HTML attributs
#
###################################################################################


%Attr = (
    '-lsearch' => 1,
    'Attribut ""' =>
        {
        'text'   => '"',
        'end'    => '"',
        'nodetype'   => ntypAttr,
        'cdatatype'  => ntypAttrValue,
        },
    'Attribut \'\'' =>
        {
        'text'   => '\'',
        'end'    => '\'',
        'nodetype'   => ntypAttr,
        'cdatatype'  => ntypAttrValue,
        'addflags' => aflgSingleQuote,
        },
    'Attribut alphanum' =>
        {
        'contains'   => 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789',
        'nodetype'   => ntypAttr,
        'cdatatype'  => ntypAttrValue,
        }
    ) ;


%AssignAttr = (
    'Assign' =>
        {
        'text' => '=',
        'follow' => \%Attr,
        }
    ) ;

%Quotes = (
    'Quote ""' =>
        {
        'text'   => '"',
        'end'    => '"',
        'nodetype'   => ntypCDATA,
        'cdatatype'  => ntypAttrValue,
        },
    'Quote \'\'' =>
        {
        'text'   => '\'',
        'end'    => '\'',
        'nodetype'   => ntypCDATA,
        'cdatatype'  => ntypAttrValue,
        },
    ) ;


1;


__END__