[interchange-cvs] interchange - heins modified 10 files
interchange-core@interchange.redhat.com
interchange-core@interchange.redhat.com
Sun Feb 17 20:01:01 2002
User: heins
Date: 2002-02-18 01:00:21 GMT
Modified: code/SystemTag area.coretag attr_list.coretag
Modified: checked.coretag process.coretag selected.coretag
Modified: dist/test/products tests.asc
Modified: lib/Vend Config.pm Interpolate.pm Parse.pm Parser.pm
Log:
As this will be a 5.0 release, we are no longer supporting deprecated
MV3 features. Here is the first removal:
* Remove HTML-embedded syntax, which has been deprecated
since late MV3.
* This reduces documentation and code complexity, and should
provide at least a small speedup in parsing.
* Added "noRearrange" parameter to avoid $Tag->attr_list and
$Tag->uneval rearranging params when a hash is encountered as
the first argument.
Revision Changes Path
1.2 +0 -2 interchange/code/SystemTag/area.coretag
rev 1.2, prev_rev 1.1
Index: area.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/SystemTag/area.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- area.coretag 29 Jan 2002 05:52:38 -0000 1.1
+++ area.coretag 18 Feb 2002 01:00:21 -0000 1.2
@@ -2,6 +2,4 @@
UserTag area addAttr
UserTag area Implicit secure secure
UserTag area PosNumber 2
-UserTag area replaceAttr form action
-UserTag area replaceAttr a href
UserTag area MapRoutine Vend::Interpolate::tag_area
1.3 +3 -2 interchange/code/SystemTag/attr_list.coretag
rev 1.3, prev_rev 1.2
Index: attr_list.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/SystemTag/attr_list.coretag,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- attr_list.coretag 16 Feb 2002 09:39:08 -0000 1.2
+++ attr_list.coretag 18 Feb 2002 01:00:21 -0000 1.3
@@ -1,6 +1,7 @@
-UserTag attr-list Order hash
+UserTag attr-list addAttr
UserTag attr-list hasEndTag
-UserTag attr-list PosNumber 1
+UserTag attr-list PosNumber 0
+UserTag attr-list noRearrange
UserTag attr-list Routine <<EOR
sub {
my ($opt, $body) = @_;
1.2 +0 -1 interchange/code/SystemTag/checked.coretag
rev 1.2, prev_rev 1.1
Index: checked.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/SystemTag/checked.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- checked.coretag 29 Jan 2002 05:52:38 -0000 1.1
+++ checked.coretag 18 Feb 2002 01:00:21 -0000 1.2
@@ -4,7 +4,6 @@
UserTag checked Implicit default default
UserTag checked InvalidateCache
UserTag checked PosNumber 2
-UserTag checked replaceAttr input checked
UserTag checked Routine <<EOR
sub {
my ($field,$value,$opt) = @_;
1.2 +0 -1 interchange/code/SystemTag/process.coretag
rev 1.2, prev_rev 1.1
Index: process.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/SystemTag/process.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- process.coretag 29 Jan 2002 05:52:38 -0000 1.1
+++ process.coretag 18 Feb 2002 01:00:21 -0000 1.2
@@ -1,6 +1,5 @@
UserTag process Order target secure
UserTag process addAttr
-UserTag process replaceAttr form action
UserTag process Routine <<EOR
# Returns the href to process the completed order form or do the search.
sub {
1.2 +0 -1 interchange/code/SystemTag/selected.coretag
rev 1.2, prev_rev 1.1
Index: selected.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/SystemTag/selected.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- selected.coretag 29 Jan 2002 05:52:38 -0000 1.1
+++ selected.coretag 18 Feb 2002 01:00:21 -0000 1.2
@@ -2,7 +2,6 @@
UserTag selected addAttr
UserTag selected InvalidateCache
UserTag selected PosNumber 2
-UserTag selected replaceAttr option selected
UserTag selected Routine <<EOR
# Returns 'SELECTED' when a value is present on the form
# Must match exactly, but NOT case-sensitive
2.3 +102 -137 interchange/dist/test/products/tests.asc
rev 2.3, prev_rev 2.2
Index: tests.asc
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/test/products/tests.asc,v
retrieving revision 2.2
retrieving revision 2.3
diff -u -r2.2 -r2.3
--- tests.asc 1 Feb 2002 04:21:46 -0000 2.2
+++ tests.asc 18 Feb 2002 01:00:21 -0000 2.3
@@ -119,108 +119,111 @@
%%%
000009
%%
-<A MV=page MV.SEND=1 MV.HREF="test" HREF="not_here_I_hope.html">Try new tag style</A><BR>
+[try]
+ [calc] 2 / 0 [/calc]
+[/try]
+[catch] There was an error -- $@ [else] No error[/else][/catch]
%%
-test(\.html)?[?"]
+There was an error
%%
-
+No error
%%
%%
-HTML-style tag
+Try/catch on error
%%%
000010
%%
-<A MV=area MV.HREF="test" TARGET=top HREF="not_here_I_hope.html">Try new tag style, insert</A><BR>
+[try]
+ [calc] 1/1; [/calc]
+[/try]
+[catch] There was an error -- $@ [else] No error[/else][/catch]
%%
-test(\.html)?[?"]
+No error
%%
-
+There was an error
%%
%%
-
+Try/catch no error
%%%
000011
%%
-<A MV=area MV.SEND=1 MV.HREF="test" MV.NOREPLACE=1 TARGET=top HREF="HERE_I_HOPE.html">Try new tag style, no replace, should show up as 404/undercon if traveled </A><BR>
+[filter lc]UPPERCASE[/filter]
%%
-HERE_I_HOPE
+^[a-z\s]+$
%%
-
+[A-Z]
%%
%%
-
+Lowercase filter
%%%
000012
%%
-<A MV=area MV.HREF="test" MV.NOINSERT=1 TARGET=top HREF="HERE_I_HOPE.html"> <<-- Should be no tag, just URL
+[filter uc]lowercase[/filter]
%%
-test[^"]*$
+^[A-Z\s]+$
%%
-
+[a-z]
%%
%%
-
+Uppercase filter
%%%
000013
%%
-<A MV=URLD href="[value%20name=testpage%20set=test]">Should be a another link to this page</A><BR>
+[filter digits_dot]Abc 9.8[/filter]
%%
-test[^\]"]*">
+^[\d.]+$
%%
-
+[^\d.]
%%
%%
-
+Digits/dot filter
%%%
000014
%%
-<A MV="value testpage" MV.SEND=1 MV.APPEND=1 MV.URLD=1 MV.INTERPOLATE=1 href="[value name=testpage set=test]"> <== Should be "test" in a link</A><BR>
+[filter entities]<A HREF=this.html>[itl tag][/filter]
%%
->\s*test\s*<
+<.*>.*[
%%
-
+[<>\[]
%%
%%
-
+Entities filter
%%%
000015
%%
-Should be test ==> <A MV="value testpage" MV.PREPEND=1 MV.INTERPOLATE=1 href="[value name=testpage set=test]"> and a link </A>
+[calc]$CGI->{something} = '[' . "the value]"; return; [/calc][cgi something]
%%
-test.*<.*>.*<
+[the value]
%%
-
+\[
%%
%%
-
+CGI blocking left square bracket
%%%
000016
%%
-<FORM MV=process ACTION="test.action">
+[calc]$Values->{something} = '[' . "the value]"; return; [/calc][value something]
%%
-ACTION="[^"]*process[?"]
+[the value]
%%
-
+\[
%%
%%
-HTML-style process
+Value blocking left square bracket
%%%
000017
%%
-<SELECT MV="loop" MV.ARG="1 2 3">
-
-<OPTION> [loop-code]
-</SELECT>
+[area form=auto abc=def ghi=jkl]
%%
-<OPTION>\s*1\s*<OPTION>\s*2
+abc=def&ghi=jkl|ghi=jkl&abc=def
%%
%%
@@ -230,146 +233,108 @@
%%%
000018
%%
-<TABLE BORDER=1>
-<TR MV=loop MV.ARG="1 2 3">
-<TD>[loop-code]</TD>
-<TD>[loop-code]</TD>
-</TR>
-</table>
+[set foo]bar[/set][scratchd foo][scratch foo]
%%
-<TD>1<.TD>\s*<TD>1<.TD>\s*<.[tT][rR]>\s*<TR>\s*<TD>2
+bar
%%
-
+barbar
%%
%%
-
+Scratchd tag
%%%
000019
%%
-
-<U>Loop with rowfix</U><BR>
-<TABLE BORDER=1>
-<TR>
-<TD MV=loop MV.ARG="1 2 3" MV.ROWFIX=1>[loop-code]</TD>
-<TD>[loop-code]</TD>
-</TR>
-</table>
+[fly-list 00-0011][item-description][/fly-list]
%%
-(?i:<TD>1<.TD>\s*<TD>1<.TD>\s*<.[tT][rR]>\s*<TR>\s*<TD>2)
+MONA LISA
%%
%%
%%
-
+Fly-list tag
%%%
000020
%%
-<U>Tag each</U><BR>
-<TABLE BORDER=1>
-<TR MV="tag each products" MV.SEND=1>
-<TD>[loop-code]</TD>
-<TD>[loop-field title]</TD>
-</TR>
-</table>
+[sql query="select artist from products where category like 'Americana'"][sql-param artist] [/sql]
%%
-<TD>00-0011</TD>
+Grant Wood The Art Store Jean Langan
%%
%%
%%
-
+[sql] and [sql-param]
%%%
000021
%%
-
-<P>
-<U>Tag each with URLDECODE</U><BR>
-<TABLE BORDER=1>
-<TR MV="tag each products">
-<TD>[loop-code]</TD>
-<TD>[loop-field%20title]</TD>
-<TD><IMG HEIGHT=20 WIDTH=20 SRC="[loop-field%20image]" MV.URL=1></TD>
-</TR>
-</table>
+[sql query="select * from products where category like 'Americana'"][sql-field artist] [/sql]
%%
-Mona Lisa
+Grant Wood The Art Store Jean Langan
%%
%%
%%
-
+[sql] and [sql-field]
%%%
000022
%%
-<U>If table</U><BR>
-<TABLE BORDER=1>
-<TR MV="if value nevairbe">
-<TD>ERROR</TD>
-<TD>row</TD>
-</TR>
-<TR MV="[elsif !value nevairbe]">
-<TD>elsif</TD>
-<TD>should be only row</TD>
-</TR>
-<TR MV="else">
-<TD>ERROR</TD>
-<TD>row</TD>
-</TR>
-</table>
-%%
-only
+[calc] $Carts->{main} = [{
+ code => 'onfly', mv_price => 5,
+ description => 'Zum description',
+ quantity => 1,
+ }]; return;[/calc]
+[item-list][item-description][/item-list]
%%
-ERROR
+Zum descrip
%%
%%
+%%
+On-the-fly part description
%%%
000023
%%
-<U>If table, no lookahead</U><BR>
-<TABLE BORDER=1>
-<TR MV="if value nevairbe" mv.nolook=1>
-<TD>ERROR</TD>
-<TD>row</TD>
-</TR>
-<TR MV="[elsif value nevairbe2]">
-<TD>elsif</TD>
-<TD>This should be row one</TD>
-</TR>
-<TR MV="else">
-<TD>else</TD>
-<TD>This should be row two and final</TD>
-</TR>
-</table>
-%%
-row.one[\S\s]*two and final
+[calc] $Carts->{main} = [{
+ code => 'onfly',
+ mv_price => 5,
+ description => 'Zum description',
+ quantity => 1,
+ foo => 'bar',
+ }]; return;[/calc]
+[item-list][item-field foo][/item-list]
%%
-ERROR
+bar
%%
%%
+%%
+On-the-fly arbitrary fields
%%%
000024
%%
-<P>
-<U>replaceHTML</U>
-<PRE MV="calc"> return 'should be normally spaced.'</PRE>
-<XMP MV="calc"> return 'should be normally spaced.'</XMP>
-<DEL MV="calc"> return 'should be normally spaced.'</DEL>
+[calc] $Carts->{main} = [{
+ code => 'onfly',
+ mv_price => 5,
+ description => 'Zum description',
+ foo => 'bar',
+ quantity => 1,
+ }];
+ $Config->{OnFly} = 1;
+ return;[/calc]
+[item-list][item-price][/item-list]
%%
-normally
-%%
-(DEL|XMP|PRE)
+5\.00
%%
%%
+%%
+On-the-fly pricing (requires $ in CommonAdjust)
%%%
000025
%%
@@ -587,47 +552,47 @@
%%%
000042
%%
-[value name=var_name set=val hide=1]<INPUT MV="checked var_name val" NAME=junk>
+[calc] q{[read-cookie MV_SESSION_ID]} =~ /^$Session->{id}/ ; [/calc]
%%
-CHECKED
+^1$
%%
%%
%%
-
+Read-cookie tag
%%%
000043
%%
-[value name=var_name set=off hide=1]<INPUT MV="checked var_name val" NAME=junk>
+[scratch fooer][tmp fooer]barer[/tmp][scratch fooer]
%%
-
+barer$
%%
-CHECKED
+barerbarer
%%
%%
-
+tmp tag, second click tests
%%%
000044
%%
-[value name=var_name set=val hide=1]<OPTION MV="selected var_name val" VALUE=val>
+works on second click: [set-cookie name=WORKS_ON_SECOND_CLICK value="testfoo"][read-cookie WORKS_ON_SECOND_CLICK]
%%
-SELECTED
+testfoo
%%
%%
%%
-
+Set cookie, works on second click
%%%
000045
%%
-[value name=var_name set=off hide=1]<OPTION MV="selected var_name val" NAME=junk>
+[scratch foobaby][tmp-no foobaby][cgi whatever][/tmp-no][scratch foobaby]
%%
-
+.cgi whatever
%%
-SELECTED
+cgi.*cgi
%%
%%
@@ -1944,9 +1909,9 @@
%%
[perl]
$MVSAFE::Safe = 1;
- my $string = q! { key => 'OK' } !;
+ my $hash = { hash => { key => 'OK' } };
- my $list = <<EOF;
+ my $text = <<EOF;
{key2 ERROR}
{key2?}ERROR{/key2?}
{key:}ERROR{/key:}
@@ -1956,7 +1921,7 @@
{key OK}
{key?}OK{/key?}
EOF
- return $Tag->attr_list($list, $string);
+ return $Tag->attr_list($hash, $text);
[/perl]
%%
^\s*OK\s+OK\s+OK\s+OK\s+\OK\s*$
2.38 +2 -9 interchange/lib/Vend/Config.pm
rev 2.38, prev_rev 2.37
Index: Config.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Config.pm,v
retrieving revision 2.37
retrieving revision 2.38
diff -u -r2.37 -r2.38
--- Config.pm 6 Feb 2002 18:23:14 -0000 2.37
+++ Config.pm 18 Feb 2002 01:00:21 -0000 2.38
@@ -1,6 +1,6 @@
# Vend::Config - Configure Interchange
#
-# $Id: Config.pm,v 2.37 2002/02/06 18:23:14 jon Exp $
+# $Id: Config.pm,v 2.38 2002/02/18 01:00:21 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -44,7 +44,7 @@
use Vend::Parse;
use Vend::Util;
-$VERSION = substr(q$Revision: 2.37 $, 10);
+$VERSION = substr(q$Revision: 2.38 $, 10);
my %CDname;
@@ -3086,23 +3086,17 @@
cannest canNest
description Description
documentation Documentation
- endhtml endHTML
gobble Gobble
hasendtag hasEndTag
implicit Implicit
- inserthtml insertHTML
- insidehtml insideHTML
interpolate Interpolate
invalidatecache InvalidateCache
isendanchor isEndAnchor
- lookaheadhtml lookaheadHTML
order Order
posnumber PosNumber
posroutine PosRoutine
maproutine MapRoutine
noreparse NoReparse
- replaceattr replaceAttr
- replacehtml replaceHTML
required Required
routine Routine
version Version
@@ -3113,7 +3107,6 @@
my %tagHash = ( qw!
attrAlias 1
Implicit 1
- replaceAttr 1
! );
my %tagBool = ( qw!
ActionMap 1
2.60 +2 -8 interchange/lib/Vend/Interpolate.pm
rev 2.60, prev_rev 2.59
Index: Interpolate.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.59
retrieving revision 2.60
diff -u -r2.59 -r2.60
--- Interpolate.pm 16 Feb 2002 08:17:14 -0000 2.59
+++ Interpolate.pm 18 Feb 2002 01:00:21 -0000 2.60
@@ -1,6 +1,6 @@
# Vend::Interpolate - Interpret Interchange tags
#
-# $Id: Interpolate.pm,v 2.59 2002/02/16 08:17:14 mheins Exp $
+# $Id: Interpolate.pm,v 2.60 2002/02/18 01:00:21 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -27,7 +27,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.59 $, 10);
+$VERSION = substr(q$Revision: 2.60 $, 10);
@EXPORT = qw (
@@ -2159,12 +2159,6 @@
}
$::Pragma->{$pragma} = $value;
- if($pragma eq 'no_html_parse') {
- $Vend::Parse::find_tag = $value
- ? qr{^([^[]+)}
- : qr{^([^[<]+)}
- ;
- }
return;
}
2.13 +6 -395 interchange/lib/Vend/Parse.pm
rev 2.13, prev_rev 2.12
Index: Parse.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Parse.pm,v
retrieving revision 2.12
retrieving revision 2.13
diff -u -r2.12 -r2.13
--- Parse.pm 9 Feb 2002 04:13:38 -0000 2.12
+++ Parse.pm 18 Feb 2002 01:00:21 -0000 2.13
@@ -1,6 +1,6 @@
# Vend::Parse - Parse Interchange tags
#
-# $Id: Parse.pm,v 2.12 2002/02/09 04:13:38 mheins Exp $
+# $Id: Parse.pm,v 2.13 2002/02/18 01:00:21 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -35,7 +35,7 @@
@ISA = qw(Exporter Vend::Parser);
-$VERSION = substr(q$Revision: 2.12 $, 10);
+$VERSION = substr(q$Revision: 2.13 $, 10);
@EXPORT = ();
@EXPORT_OK = qw(find_matching_end);
@@ -260,68 +260,6 @@
buzzard => 'data table=products column=artist key=',
);
-my %replaceAttr = (
- area => { qw/ a href form action/},
- process => { qw/ form action /},
- checked => { qw/ input checked /},
- selected => { qw/ option selected /},
- );
-
-my %replaceHTML = (
- qw(
- del .*
- pre .*
- xmp .*
- script .*
- )
- );
-
-my %insertHTML = (
- qw(
-
- form process|area
- a area
- input checked
- option selected
- )
- );
-
-my %lookaheadHTML = (
- qw(
-
- if then|elsif|else
- unless then|elsif|else
- )
- );
-
-my %rowfixHTML = ( qw/
- td item_list|loop|sql_list
- / );
-# Only for containers
-my %insideHTML = (
- qw(
- select loop|item_list|tag
- )
-
- );
-
-# Only for containers
-my %endHTML = (
- qw(
-
- tr .*
- td .*
- th .*
- del .*
- script .*
- table if
- object perl
- param perl
- font if
- a if
- )
- );
-
my %Interpolate = (
qw(
@@ -364,6 +302,8 @@
$Initialized = $self;
}
+my %noRearrange = qw/attr_list/;
+
my %Documentation;
use vars '%myRefs';
@@ -372,19 +312,14 @@
addAttr => \%addAttr,
attrAlias => \%attrAlias,
Documentation => \%Documentation,
- endHTML => \%endHTML,
hasEndTag => \%hasEndTag,
+ noRearrange => \%noRearrange,
Implicit => \%Implicit,
- insertHTML => \%insertHTML,
- insideHTML => \%insideHTML,
Interpolate => \%Interpolate,
InvalidateCache => \%InvalidateCache,
- lookaheadHTML => \%lookaheadHTML,
Order => \%Order,
PosNumber => \%PosNumber,
PosRoutine => \%PosRoutine,
- replaceAttr => \%replaceAttr,
- replaceHTML => \%replaceHTML,
Routine => \%Routine,
);
@@ -418,7 +353,7 @@
$tag = $Alias{$tag};
};
if(
- ( ref($_[-1]) && scalar @{$Order{$tag}} > scalar @_ )
+ ( ref($_[-1]) && scalar @{$Order{$tag}} > scalar @_ and ! $noRearrange{$tag})
)
{
my $text;
@@ -562,330 +497,6 @@
}
return;
# syntax color "'
-}
-
-sub html_start {
- my($self, $tag, $attr, $attrseq, $origtext, $end_tag) = @_;
-#::logDebug("HTML tag=$tag Interp='$Interpolate{$tag}' origtext=$origtext attributes:\n" . ::uneval($attr));
- $tag =~ tr/-/_/; # canonical
- $Vend::CurrentTag = $tag = lc $tag;
-
- my $buf = \$self->{_buf};
-
- if (defined $Vend::Cfg->{AdminSub}{$tag}) {
-
- if($Vend::restricted) {
- ::logError(
- "Restricted tag (%s) attempted during restriction '%s'",
- $origtext,
- $Vend::restricted,
- );
- $self->{OUT} .= $origtext;
- return 1;
- }
- elsif (! $Vend::admin) {
- ::response(
- get_locale_message (
- 403,
- "Unauthorized for admin tag %s",
- $tag,
- )
- );
- return ($self->{ABORT} = 1);
- }
-
- }
-
- $end_tag = lc $end_tag;
-#::logDebug("tag=$tag end_tag=$end_tag buf length " . length($$buf)) if $Monitor{$tag};
-#::logDebug("attributes: ", %{$attr}) if $Monitor{$tag};
- my($tmpbuf);
- # $attr is reference to a HASH, $attrseq is reference to an ARRAY
- my($return_html);
-
- unless (defined $Routine{$tag}) {
- if(defined $Alias{$tag}) {
-#::logDebug("origtext: $origtext");
- my $alias = $Alias{$tag};
- $tag =~ s/_/[-_]/g;
- $origtext =~ s/$tag/$alias/i
- or return 0;
- $$buf = $origtext . $$buf;
- return 1;
- }
- elsif ($tag eq 'urldecode') {
- $attr->{urldecode} = 1;
- $return_html = $origtext;
- $return_html =~ s/\s+.*//s;
- }
- else {
- $self->{OUT} .= $origtext;
- return 1;
- }
- }
-
- if(defined $InvalidateCache{$tag} and !$attr->{cache}) {
- $self->{INVALID} = 1;
- }
-
- my $trib;
- foreach $trib (@$attrseq) {
- # Attribute aliases
- if(defined $attrAlias{$tag} and $attrAlias{$tag}{$trib}) {
- my $new = $attrAlias{$tag}{$trib} ;
- $attr->{$new} = delete $attr->{$trib};
- $trib = $new;
- }
- elsif (0 and defined $Alias{$trib}) {
- my $new = $Alias{$trib} ;
- $attr->{$new} = delete $attr->{$trib};
- $trib = $new;
- }
- # Parse tags within tags, only works if the [ is the
- # first character.
- $attr->{$trib} =~ s/%([A-Fa-f0-9]{2})/chr(hex($1))/eg if $attr->{urldecode};
- next unless $attr->{$trib} =~ /\[\w+[-\w]*\s*[\000-\377]*\]/;
-
- my $p = new Vend::Parse;
- $p->parse($attr->{$trib});
- $attr->{$trib} = $p->{OUT};
- $self->{INVALID} += $p->{INVALID};
- }
-
- if($tag eq 'urldecode') {
- $self->{OUT} .= build_html_tag($return_html, $attr, $attrseq);
- return 1;
- }
-
- $attr->{enable_html} = 1 if $Vend::Cfg->{Promiscuous};
- $attr->{decode} = 1 unless defined $attr->{'decode'};
- $attr->{reparse} = 1 unless defined $NoReparse{$tag}
- || defined $attr->{'reparse'};
- $attr->{'undef'} = undef;
-
- my ($routine,@args);
-
- if ($attr->{OLD}) {
- # HTML old-style tag
- $attr->{interpolate} = 1 if defined $Interpolate{$tag};
- if(defined $PosNumber{$tag}) {
- if($PosNumber{$tag} > 1) {
- @args = split /\s+/, $attr->{OLD}, $PosNumber{$tag};
- push(@args, undef) while @args < $PosNumber{$tag};
- }
- elsif ($PosNumber{$tag}) {
- @args = $attr->{OLD};
- }
- }
- @{$attr}{ @{ $Order{$tag} } } = @args;
- $routine = $PosRoutine{$tag} || $Routine{$tag};
- }
- else {
- # New style tag, HTML or otherwise
- $routine = $Routine{$tag};
- $attr->{interpolate} = 1
- if defined $Interpolate{$tag} and ! defined $attr->{interpolate};
- @args = @{$attr}{ @{ $Order{$tag} } };
- }
- $args[scalar @{$Order{$tag}}] = $attr if $addAttr{$tag};
-
- if($tag =~ /^[gb]o/) {
- if($tag eq 'goto') {
- return 1 if resolve_if_unless($attr);
- if(! $args[0]) {
- $$buf = '';
- $Initialized->{_buf} = '';
- $self->{ABORT} = 1
- if $attr->{abort};
- return ($self->{SEND} = 1);
- }
- goto_buf($args[0], \$Initialized->{_buf});
- $self->{ABORT} = 1;
- return 1;
- }
- elsif($tag eq 'bounce') {
- return 1 if resolve_if_unless($attr);
- if(! $attr->{href} and $attr->{page}) {
- $attr->{href} = Vend::Interpolate::tag_area($attr->{page});
- }
- $Vend::StatusLine = '' if ! $Vend::StatusLine;
- $Vend::StatusLine .= <<EOF;
-Status: 302 moved
-Location: $attr->{href}
-EOF
- $$buf = '';
- $Initialized->{_buf} = '';
- return ($self->{SEND} = 1);
- }
- }
-
-#::logDebug("tag=$tag end_tag=$end_tag attributes:\n" . Vend::Util::uneval($attr)) if$Monitor{$tag};
-
- my $prefix = '';
- my $midfix = '';
- my $postfix = '';
- my @out;
-
- if($insertHTML{$end_tag}
- and ! $attr->{noinsert}
- and $tag =~ /^($insertHTML{$end_tag})$/) {
- $origtext =~ s/>\s*$//;
- @out = Text::ParseWords::shellwords($origtext);
- shift @out;
- @out = grep $_ !~ /^[Mm][Vv][=.]/, @out
- unless $attr->{showmv};
- if (defined $replaceAttr{$tag}
- and $replaceAttr{$tag}->{$end_tag}
- and ! $attr->{noreplace})
- {
- my $t = $replaceAttr{$tag}->{$end_tag};
- @out = grep $_ !~ /^($t)\b/i, @out;
- unless(defined $implicitHTML{$t}) {
- $out[0] .= qq{ \U$t="};
- $out[1] = defined $out[1] ? qq{" } . $out[1] : '"';
- }
- else { $midfix = ' ' }
- }
- else {
- $out[0] = " " . $out[0] . " "
- if $out[0];
- }
- if (@out) {
- $out[$#out] .= '>';
- }
- else {
- @out = '>';
- }
-#::logDebug("inserted " . join "|", @out);
- }
-
- if($hasEndTag{$tag}) {
- my $rowfix;
- # Handle embedded tags, but only if interpolate is
- # defined (always if using old tags)
- if (defined $replaceHTML{$end_tag}
- and $tag =~ /^($replaceHTML{$end_tag})$/
- and ! $attr->{noreplace} )
- {
- $origtext = '';
- $tmpbuf = find_html_end($end_tag, $buf);
- $tmpbuf =~ s:</$end_tag\s*>::;
- HTML::Entities::decode($tmpbuf) if $attr->{decode};
- $tmpbuf =~ tr/\240/ /;
- }
- else {
- @out = Text::ParseWords::shellwords($origtext);
- ($attr->{showmv} and
- @out = map {s/^[Mm][Vv]\./mv-/} @out)
- or @out = grep ! /^[Mm][Vv][=.]/, @out;
- $out[$#out] =~ s/([^>\s])\s*$/$1>/;
- $origtext = join " ", @out;
-
- if (defined $lookaheadHTML{$tag} and ! $attr->{nolook}) {
- $tmpbuf = $origtext . find_html_end($end_tag, $buf);
- while($$buf =~ s~^\s*(<([A-Za-z][-A-Z.a-z0-9]*)[^>]*)\s+
- [Mm][Vv]\s*=\s*
- (['"]) \[?
- ($lookaheadHTML{$tag})\b(.*?)
- \]?\3~~ix )
- {
- my $orig = $1;
- my $enclose = $4;
- my $adder = $5;
- my $end = lc $2;
- $tmpbuf .= "[$enclose$adder]" . $orig .
- find_html_end($end, $buf) .
- "[/$enclose]";
- }
- }
- # Syntax color '"
- # GACK!!! No table row attributes in some editors????
- elsif (defined $rowfixHTML{$end_tag}
- and $tag =~ /^($rowfixHTML{$end_tag})$/
- and $attr->{rowfix} )
- {
- $rowfix = 1;
- $tmpbuf = '<tr>' . $origtext . find_html_end('tr', $buf);
-#::logDebug("Tmpbuf: $tmpbuf");
- }
- elsif (defined $insideHTML{$end_tag}
- and ! $attr->{noinside}
- and $tag =~ /^($insideHTML{$end_tag})$/i) {
- $prefix = $origtext;
- $tmpbuf = find_html_end($end_tag, $buf);
- $tmpbuf =~ s:</$end_tag\s*>::;
- $postfix = "</$end_tag>";
- HTML::Entities::decode($tmpbuf) if $attr->{'decode'};
- $tmpbuf =~ tr/\240/ / if $attr->{'decode'};
- }
- else {
- $tmpbuf = $origtext . find_html_end($end_tag, $buf);
- }
- }
-
- $tmpbuf =~ s/%([A-Fa-f0-9]{2})/chr(hex($1))/eg if $attr->{urldecode};
-
- if ($attr->{interpolate}) {
- my $p = new Vend::Parse;
- $p->parse($tmpbuf);
- $tmpbuf = $p->{OUT};
- }
-
- $tmpbuf = $attr->{prepend} . $tmpbuf if defined $attr->{prepend};
- $tmpbuf .= $attr->{append} if defined $attr->{append};
-
- if (! $attr->{reparse}) {
- $self->{OUT} .= $prefix . &{$routine}(@args,$tmpbuf) . $postfix;
- }
- elsif (! defined $rowfix) {
- $$buf = $prefix . &{$routine}(@args,$tmpbuf) . $postfix . $$buf
- }
- else {
- $tmpbuf = &{$routine}(@args,$tmpbuf);
- $tmpbuf =~ s|<tr>||i;
- $$buf = $prefix . $tmpbuf . $postfix . $$buf;
- }
-
-
- }
- else {
- if(! @out and $attr->{prepend} or $attr->{append}) {
- my @tmp;
- @tmp = Text::ParseWords::shellwords($origtext);
- shift @tmp;
- @tmp = grep $_ !~ /^[Mm][Vv][=.]/, @tmp
- unless $attr->{showmv};
- $postfix = $attr->{prepend} ? "<\U$end_tag " . join(" ", @tmp) : '';
- $prefix = $attr->{append} ? "<\U$end_tag " . join(" ", @tmp) : '';
- }
- if(! $attr->{interpolate}) {
- if(@out) {
- $self->{OUT} .= "<\U$end_tag ";
- if ($out[0] =~ / > \s*$ /x ) { } # End of tag, do nothing
- elsif ($out[0] =~ / ^[^"]*"$/x ) { # End of tag
- $self->{OUT} .= shift(@out);
- }
- else {
- unshift(@out, '');
- }
- }
- $self->{OUT} .= $prefix . &$routine( @args ) . $midfix;
- $self->{OUT} .= join(" ", @out) . $postfix;
- }
- else {
- if(@out) {
- $$buf = "<\U$end_tag " . &$routine( @args ) . $midfix . join(" ", @out) . $$buf;
- }
- else {
- $$buf = $prefix . &$routine( @args ) . $postfix . $$buf;
- }
- }
- }
-
- $self->{SEND} = $attr->{'send'} || undef;
-#::logDebug("Returning from $tag");
- return 1;
-
}
sub eval_die {
2.4 +3 -149 interchange/lib/Vend/Parser.pm
rev 2.4, prev_rev 2.3
Index: Parser.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Parser.pm,v
retrieving revision 2.3
retrieving revision 2.4
diff -u -r2.3 -r2.4
--- Parser.pm 8 Feb 2002 05:22:40 -0000 2.3
+++ Parser.pm 18 Feb 2002 01:00:21 -0000 2.4
@@ -1,6 +1,6 @@
# Vend::Parser - Interchange parser class
#
-# $Id: Parser.pm,v 2.3 2002/02/08 05:22:40 mheins Exp $
+# $Id: Parser.pm,v 2.4 2002/02/18 01:00:21 mheins Exp $
#
# Copyright (C) 1997-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -66,7 +66,7 @@
use HTML::Entities ();
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.3 $, 10);
+$VERSION = substr(q$Revision: 2.4 $, 10);
sub new
@@ -82,9 +82,6 @@
shift->parse(undef);
}
-
-use vars qw/$Find_tag/;
-
sub parse
{
my $self = shift;
@@ -96,11 +93,6 @@
return $self;
}
$$buf .= $_[0];
- $Find_tag = $::Pragma->{no_html_parse}
- ? qr{^([^[]+)}
- : qr{^([^[<]+)}
- ;
-#::logDebug("no_html_parse=$::Pragma->{no_html_parse} Find_tag=$Find_tag");
my $eaten;
# Parse html text in $$buf. The strategy is to remove complete
@@ -108,7 +100,7 @@
# it is a token or not, or the $$buf is empty.
while (1) { # the loop will end by returning when text is parsed
# First we try to pull off any plain text (anything before a "<" char)
- if ($$buf =~ s/$Find_tag// ) {
+ if ($$buf =~ s/^([^[]+)// ) {
#my $eat = $1;
#::logDebug("plain eat='$eat'");
#$self->text($eat);
@@ -266,144 +258,6 @@
$$buf = $eaten; # need more data to parse
return $self;
}
- } elsif ($$buf =~ s|^<||) {
- # start tag
- $eaten = '<';
-#::logDebug("do < tag") if ! $Tmp::DoneDebug++;
-
- # This first thing we must find is a tag name. RFC1866 says:
- # A name consists of a letter followed by letters,
- # digits, periods, or hyphens. The length of a name is
- # limited to 72 characters by the `NAMELEN' parameter in
- # the SGML declaration for HTML, 9.5, "SGML Declaration
- # for HTML". In a start-tag, the element name must
- # immediately follow the tag open delimiter `<'.
- if ($$buf =~ s|^(([a-zA-Z][-a-zA-Z0-9._]*)((?:\s+[^>]+)?\s+[mM][Vv]\s*=)\s*)||) {
-#::logDebug("REALLY do < tag") if ! $Tmp::DoneDebug++;
- $eaten .= $1;
- $self->{HTML} = 1;
-
- my ($tag, $end_tag);
- my ($nopush, $element);
- my %attr;
- my @attrseq;
- my $old;
-
- $end_tag = $2;
-#::logDebug("end_tag='$end_tag' eat='$eaten'");
- ( $$buf =~ s|^((['"])(.*?)\2\s*)||s and $tag = $3 )
- or
- ( $$buf =~ s|^(([a-zA-Z][-a-zA-Z0-9._]*)\s*)|| and $tag = $2)
- or ($self->text($eaten), next);
- $eaten .= $1;
- if( index($tag, " ") != -1 ) {
- ($tag, $attr{OLD}) = split /\s+/, $tag, 2;
- }
-#::logDebug("< tag='$tag' eat='$eaten'");
- $tag = lc $tag;
-
- # Then we would like to find some attributes
- #
- # Arrgh!! Since stupid Netscape violates RCF1866 by
- # using "_" in attribute names (like "ADD_DATE") of
- # their bookmarks.html, we allow this too.
- while ( $$buf =~ s|^(([a-zA-Z][-a-zA-Z0-9._]*)\s*)|| ) {
- $eaten .= $1;
-#::logDebug("in parse, eaten=$eaten");
- my $attr = lc $2;
- $attr =~ s/^mv\.?//
- or $tag =~ /^urld/
- or undef $attr;
- $attr =~ s/\.(.*)//
- and $element = $1;
-
- my $val;
-
- # The attribute might take an optional value (first we
- # check for an unquoted value)
- if ($$buf =~ s~(^=\s*([^\!\|\@\"\'\`\]\s][^\]>\s]*)\s*)~~) {
- $eaten .= $1;
- next unless defined $attr;
- $val = $2;
- # or quoted by " or ' or # or $ or |
- } elsif ($$buf =~ s~(^=\s*(["\'])(.*?)\2\s*)~~s) {
- $eaten .= $1;
- next unless defined $attr;
- $val = $3;
- HTML::Entities::decode($val) if $attr{entities};
- # or quoted by `` to send to [calc]
- } elsif ($$buf =~ s~(^=\s*([\`\|]?)(.*?)\2\s*)~~s) {
- $eaten .= $1;
- if ($2 eq '`') {
- $val = Vend::Interpolate::tag_calc($3)
- unless defined $Vend::Cfg->{AdminSub}{calc};
- }
- elsif ($2 eq '|') {
- $val = $3;
- $val =~ s/^\s+//;
- $val =~ s/\s+$//;
- }
- else {
- die "parse error!";
- }
- # truncated just after the '=' or inside the attribute
- } elsif ($$buf =~ m|^(=\s*)$|s or
- $$buf =~ m|^(=\s*[\"\'].*)|s) {
-#::logDebug("Truncated? eaten=$eateni buf=$$buf");
- $$buf = "$eaten$1";
- return $self;
- }
-
- if(defined $element) {
-#::logDebug("Found element: $element val=$val");
- if(! ref $attr{$attr}) {
- if ($element =~ /[A-Za-z]/) {
- $attr{$attr} = { $element => $val };
- }
- else {
- $attr{$attr} = [ ];
- $attr{$attr}->[$element] = $val;
- }
- push (@attrseq, $attr);
- }
- elsif($attr{$attr} =~ /ARRAY/) {
- if($element =~ /\D/) {
- push @{$attr{$attr}}, $val;
- }
- else {
- $attr{$attr}->[$element] = $val;
- }
- }
- elsif ($attr{$attr} =~ /HASH/) {
- $attr{$attr}->{$element} = $val;
- }
- undef $element;
- next;
- }
- $attr{$attr} = $val;
- push(@attrseq, $attr) unless $nopush;
- }
-
- # At the end there should be a closing "\] or >"
- if ($$buf =~ s|^>|| ) {
- $self->start($tag, \%attr, \@attrseq, "$eaten>", $end_tag);
- } elsif (length $$buf) {
-#::logDebug("not conforming, eaten $eaten");
- # Not a conforming start tag, regard it as normal text
- $self->text($eaten);
- } else {
- $$buf = $eaten; # need more data to know
- return $self;
- }
-
- } elsif (length $$buf) {
-#::logDebug("eaten $eaten");
- $self->text($eaten);
- } else {
- #$$buf = $eaten; # need more data to parse
- return $self;
- }
-
} elsif (length $$buf) {
::logDebug("remaining: $$buf");
die $$buf; # This should never happen