view release on metacpan or  search on metacpan

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

@ISA = qw(Embperl::Syntax) ;


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

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

sub new

    {
    my $self        = shift ;
    my $exchange    = shift ;

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

    if (!$self -> {-epbBlocks})
        {
        $self -> {-epbBlocks}     = $self -> CloneHash ({ %Blocks, %BlocksOutput }, ref $exchange?$exchange:undef) ;
        $self -> {-epbBlocksLink} = $self -> CloneHash ({ %Blocks, %BlocksOutputLink }, { 'unescape' => 2 }) ;

        $self -> AddToRoot ($self -> {-epbBlocks}) ;

        Init ($self, ref $exchange?$exchange:undef) ;

        $self -> AddInitCode ('use Data::Dumper;') ;
        }

    return $self ;
    }

# ---------------------------------------------------------------------------------
#
#   Add new meta command
#
# ---------------------------------------------------------------------------------


sub AddMetaCmd

    {
    my ($self, $cmdname, $procinfo, $taginfo) = @_ ;

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

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

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

    my $tag2 = $ttfollow -> {$cmdname} = { 
                                'text'      => $cmdname,
                                'nodetype'  => ntypTag,
                                'cdatatype' => ntypAttrValue,
                                'forcetype' => 1,
                                'unescape'  => 2,
                                (ref($taginfo) eq 'HASH'?%$taginfo:()),
                              } ;
    $tag2 -> {'procinfo'} = { $self -> {-procinfotype} => $procinfo } if ($procinfo) ;

    return $tag ;
    }


# ---------------------------------------------------------------------------------
#
#   Add new meta command that has an corresponding end meta command
#
# ---------------------------------------------------------------------------------


sub AddMetaCmdWithEnd

    {
    my ($self, $cmdname, $endname, $procinfo) = @_ ;

    my $tag = $self -> AddMetaCmd ($cmdname, $procinfo, {'endtag' => $endname} ) ;

    return $tag ;
    }

# ---------------------------------------------------------------------------------
#
#   Add new meta command with start and end
#
# ---------------------------------------------------------------------------------


sub AddMetaCmdBlock

    {
    my ($self, $cmdname, $endname, $procinfostart, $procinfoend) = @_ ;

    my $tag ;
    my $pinfo = { %$procinfostart, 'stackname' => 'metacmd', 'push' => $cmdname };
    $tag = $self -> AddMetaCmd ($cmdname, $pinfo, {'endtag' => $endname} ) ;

    $pinfo = { %$procinfoend, 'stackname' => 'metacmd', 'stackmatch' => $cmdname };
    $tag = $self -> AddMetaCmd ($endname, $pinfo) ;

    return $tag ;
    }

# ---------------------------------------------------------------------------------
#
#   Add new block 
#
# ---------------------------------------------------------------------------------


sub AddMetaStartEnd 

    {
    my ($self, $cmdname, $endname, $procinfostart, $taginfostart) = @_ ;

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

        },
     'Embperl code' => {
        'text' => '[-',
        'end'  => '-]',
        'unescape' => 1,
        'procinfo' => {
            embperl => { 
                        perlcode    => [
                                '%$c%if (!defined (scalar(do{' . "\n" . '%#~0:$col%' . "\n" . '}))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%^*htmlrow%) ; last l%^*htmlrow% ; }}',
                                '%$c%if (!defined (scalar(do{' . "\n" . '%#~0:$col%' . "\n" . '}))) { _ep_dcp (%^*htmlrow%) ; last l%^*htmlrow% ; }',
                                '%$c%if (!defined (scalar(do{' . "\n" . '%#~0:$row%' . "\n" . '}))) { _ep_dcp (%^*htmltable%) ; last l%^*htmltable% ; }',
                                '%$c%{' . "\n" . '%#0%' . "\n" . ';}',
                                ],
                        removenode  => 3,
                        mayjump     => 1,
                        compilechilds => 0,
                        },
            },
        },
     'Embperl global code' => {
        'text' => '[*',
        'end'  => '*]',
        'unescape' => 1,
        'procinfo' => {
            embperl => { 
                        perlcode    => '%$c%' . "\n" . '%#0%',
                        removenode  => 3,
                        mayjump     => 1,
                        compilechilds => 0,
                        },
            },
        },
     'Embperl startup code' => {
        'text' => '[!',
        'end'  => '!]',
        'unescape' => 1,
        'procinfo' => {
            embperl =>  { 
                        compiletimeperlcode => '%#0%;',
                        removenode  => 3,
                        compilechilds => 0,
                        }
            },
        },
     'Embperl comment' => {
        'text' => '[#',
        'end'  => '#]',
#        'inside' => \%MetaComment,
        'procinfo' => {
            embperl => { 
                compilechilds => 0,
                removenode  => 3, 
                },
            },
        },
     'Embperl output msg id' => {
        'text' => '[=',
        'end'  => '=]',
        'unescape' => 1,
         removespaces  => 72,
        'cdatatype' => ntypAttrValue,
        'procinfo' => {
            embperl => { 
                    perlcode => 
                        [
                        '_ep_rpid(%$x%,scalar(%&\'<noname>%));', 
			],
                    removenode  => 4,
                    compilechilds => 0,
                    }
            },
        },
      ) ;  
   
#%MetaComment = (
#    '-lsearch' => 1,
#     'Embperl comment' => {
#        'text' => '[#',
#        'end'  => '#]',
#        'inside' => \%MetaComment
#        },
#) ;


%BlocksOutput =
    (
     'Embperl output code' => {
        'text' => '[+',
        'end'  => '+]',
        'unescape' => 1,
        'procinfo' => {
            embperl => { 
                    perlcode => 
                        [
                        'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%^*htmlrow%) ; last l%^*htmlrow% ; }}',
                        'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) { _ep_dcp (%^*htmlrow%) ; last l%^*htmlrow% ; }',
                        'if (!defined (_ep_rp(%$x%,scalar(%#~0:$row%)))) { _ep_dcp (%^*htmltable%) ; last l%^*htmltable% ; }',
                        '_ep_rp(%$x%,scalar(%#0%));', 
			],
                    removenode  => 4,
                    mayjump => '%#~0:$col|$row|$cnt% %?*htmlrow% %?*htmltable%',
                    compilechilds => 0,
                    }
            },
        },
    ) ;

%BlocksOutputLink =
    (
     'Embperl output code URL' => {
        'text' => '[+',       
        'nodename' => '[+url',
        'end'  => '+]',
        'unescape' => 2,
        'procinfo' => {
            embperl => { 
                    perlcode => 
                        [
                        'if (!defined (_ep_rpurl(%$x%,scalar(%#~0:$col%)))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%^*htmlrow%) ; last l%^*htmlrow% ; }}',
                        'if (!defined (_ep_rpurl(%$x%,scalar(%#~0:$col%)))) { _ep_dcp (%^*htmlrow%) ; last l%^*htmlrow% ; }',
                        'if (!defined (_ep_rpurl(%$x%,scalar(%#~0:$row%)))) {  _ep_dcp (%^*htmltable%) ; last l%^*htmltable% ; }',