################################################################################### # # Embperl - Copyright (c) 1997-2004 Gerald Richter / ECOS # # 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: ASP.pm,v 1.3 2004/01/23 06:50:57 richter Exp $ # ################################################################################### package Embperl::Syntax::ASP ; use Embperl::Syntax qw{:types} ; use Embperl::Syntax::HTML ; use strict ; use vars qw{@ISA %Cmds %CmdsOutput %CmdsOutputLink} ; @ISA = qw(Embperl::Syntax::HTML) ; ################################################################################### # # Methods # ################################################################################### # --------------------------------------------------------------------------------- # # Create new Syntax Object # # --------------------------------------------------------------------------------- sub new { my $class = shift ; my $self = Embperl::Syntax::HTML::new ($class) ; if (!$self -> {-aspInit}) { $self -> {-aspInit} = 1 ; Init ($self) ; } return $self ; } ################################################################################### # # Definitions for ASP HTML tags # ################################################################################### sub Init { my ($self) = @_ ; $self -> {-aspCmds} = $self -> CloneHash ({ %Cmds, %CmdsOutput }) ; $self -> {-aspCmdsLink} = $self -> CloneHash ({ %Cmds, %CmdsOutputLink }, { 'unescape' => 2 }) ; $self -> AddToRoot ($self -> {-aspCmds}) ; $self -> AddToRoot ({ 'ASP Syntax' => { 'text' => '<%?syntax', 'end' => '?%>', 'procinfo' => { embperl => { compiletimeperlcode => '$_[0] -> Syntax (Embperl::Syntax::GetSyntax(%#\'0%, $_[0] -> SyntaxName));', parsetimeperlcode => '$_[0] -> Syntax (Embperl::Syntax::GetSyntax(\'%%\', $_[0] -> SyntaxName)) ;', removenode => 3, } } } }) ; } # --------------------------------------------------------------------------------- # # Add new simple html tag (override to add asp commands inside html tags) # # --------------------------------------------------------------------------------- sub AddTag { my $self = shift ; my $tag = $self -> Embperl::Syntax::HTML::AddTag (@_) ; #### add the ASP cmd inside the new HTML Tag #### $tag -> {inside} ||= {} ; my $inside = $tag -> {inside} ; while (my ($k, $v) = each (%{$self -> {-aspCmds}})) { $inside -> {$k} = $v ; } if (!$self -> {-aspHTMLInit}) { #### if not already done add the ASP cmds inside the HTML Attributes #### $self -> {-aspHTMLInit} = 1 ; my $unescape = 0 ; foreach ('', 'Link') { my $attr = $self -> {"-htmlAssignAttr$_"} ; my $blocks = $self -> {"-aspCmds$_"} ; while (my ($k1, $v1) = each %$attr) { if (!($k1 =~ /^-/) && ref ($v1) eq 'HASH') { my $follow = $v1 -> {follow} ; if (ref($follow) eq 'HASH') { while (my ($k2, $v2) = each %$follow) { if (ref($v2) eq 'HASH') { $v2 -> {inside} ||= {} ; my $inside = $v2 -> {inside} ; while (my ($k, $v) = each (%$blocks)) { $inside -> {$k} = $v ; } } } } } } } my $quotes = $self -> {"-htmlQuotes"} ; my $blocks = $self -> {"-aspCmds"} ; while (my ($k2, $v2) = each %$quotes) { if (ref($v2) eq 'HASH') { $v2 -> {inside} ||= {} ; my $inside = $v2 -> {inside} ; while (my ($k, $v) = each (%$blocks)) { $inside -> {$k} = $v ; } } } } return $tag ; } ################################################################################### # # ASP Implementation # ################################################################################### %Cmds = ( '-lsearch' => 1, 'ASP Code' => { 'text' => '<%', 'end' => '%>', 'procinfo' => { embperl => { perlcode => '%$c%%#0%', removenode => 3, mayjump => 1, compilechilds => 0, }, }, } ) ; %CmdsOutput = ( 'ASP Output' => { 'text' => '<%=', 'end' => '%>', 'procinfo' => { embperl => { perlcode => [ 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }}', 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }', 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$row%)))) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; }', '_ep_rp(%$x%,scalar(%#0%));', ], removenode => 4, mayjump => '%#~0:$col|$row|$cnt% %?*htmlrow% %?*htmltable%', compilechilds => 0, } } } ) ; %CmdsOutputLink = ( 'ASP Output Link' => { 'text' => '<%=', 'end' => '%>', 'nodename' => '<%=url', 'unescape' => 2, 'procinfo' => { embperl => { perlcode => [ 'if (!defined (_ep_rpurl(%$x%,scalar(%#~0:$col%)))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }}', 'if (!defined (_ep_rpurl(%$x%,scalar(%#~0:$col%)))) { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }', 'if (!defined (_ep_rpurl(%$x%,scalar(%#~0:$row%)))) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; }', '_ep_rpurl(%$x%,scalar(%#0%));', ], removenode => 4, mayjump => '%#~0:$col|$row|$cnt% %?*htmlrow% %?*htmltable%', compilechilds => 0, } } } ) ; 1; __END__ =pod =head1 NAME ASP syntax module for Embperl =head1 SYNOPSIS [$syntax ASP $] <% $a = 1 ; %>
| <%= $_ %> | <%= $a += 2 %> |