view release on metacpan or  search on metacpan

Embperl/Syntax/HTML.pm  view on Meta::CPAN

#
#   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 ({

Embperl/Syntax/HTML.pm  view on Meta::CPAN

# ---------------------------------------------------------------------------------
#
#   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__

=pod

=head1 NAME

Embperl::Syntax::HTML - define the syntax for HTML

=head1 SYNOPSIS


=head1 DESCRIPTION

Class derived from Embperl::Syntax to define the syntax for HTML.
This class does not add functionalty of it own, it just provides
methods add definitions for derived classes to implement their own
tags.

=head1 Methods

I<Embperl::Syntax::HTML> defines the following methods:

=head2 Embperl::Syntax::HTML -> new  /  $self -> new

Create a new syntax class. This method should only be called inside a constructor
of a derived class.

=head2 AddTag ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo, $taginfo, $addsess)

Add a new HTML tag. 

=over 4

=item $tagname

Name of the HTML tag

=item $attrs

List of attributes that should be parsed out.

=item $attrsurl

List of attributes that should be parsed out. Any output inside the attribute value
is url escaped.

=item $attrsnoval

List of attributes that should be parsed out and doesn't contain a value.

=item $procinfo

Processor info. See I<Embperl::Syntax> for a definition of procinfo.