[interchange-cvs] interchange - heins modified code/SystemTag/catch.coretag

interchange-core@interchange.redhat.com interchange-core@interchange.redhat.com
Fri Jun 28 15:35:00 2002


User:      heins
Date:      2002-06-28 19:34:29 GMT
Modified:  code/SystemTag catch.coretag
Log:
* Change [catch ] yet again to work, and add $ERROR$ anchor so you can
  insert the error in the catch message.

Revision  Changes    Path
1.2       +17 -6     interchange/code/SystemTag/catch.coretag


rev 1.2, prev_rev 1.1
Index: catch.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/SystemTag/catch.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- catch.coretag	29 Jan 2002 05:52:38 -0000	1.1
+++ catch.coretag	28 Jun 2002 19:34:29 -0000	1.2
@@ -8,8 +8,9 @@
 	my ($label, $opt, $body) = @_;
 	$label = 'default' unless $label;
 	my $patt;
+	my $error;
 	return pull_else($body) 
-		unless $patt = $Vend::Session->{try}{$label};
+		unless $error = $Vend::Session->{try}{$label};
 
 	$body = pull_if($body);
 
@@ -17,6 +18,7 @@
 		#----------------------------------------------------------------
 		# Convert multiple errors to 'or' list and compile it.
 		# Note also the " at (eval ...)" kludge to strip the line numbers
+		$patt = $error;
 		$patt =~ s/(?: +at +\(eval .+\).+)?\n\s*/|/g;
 		$patt =~ s/^\s*//;
 		$patt =~ s/\|$//;
@@ -24,7 +26,7 @@
 		#----------------------------------------------------------------
 	}
 
-	my $found;
+	my @found;
 	while ($body =~ s{
 						\[/
 							(.+?)
@@ -34,16 +36,25 @@
 						(?:\1)?/?
 						\]}{}sx ) {
 		my $re;
-		my $error = $2;
+		my $emsg = $2;
 		eval {
 			$re = qr{$1}
 		};
 		next if $@;
-		next unless $patt =~ $re;
-		$found = $error;
+		if($emsg =~ $patt) {
+			push @found, $emsg;
+		}
+		next unless $error =~ $re;
+		push @found, $emsg;
 		last;
 	}
-	$body = $found if $found;
+
+	if(@found) {
+		$body = join $opt->{joiner} || "\n", @found;
+	}
+	else {
+		$body =~ s/\$ERROR\$/$error/g;
+	}
 
 	$body =~ s/\s+$//;
 	$body =~ s/^\s+//;