[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*<
+&lt;.*&gt;.*&#91
 %%
-
+[<>\[]
 %%
 
 %%
-
+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.*<.*>.*<
+&#91;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[?"]
+&#91;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