# Copyright 2002-2007 Interchange Development Group and others

#

# This program is free software; you can redistribute it and/or modify

# it under the terms of the GNU General Public License as published by

# the Free Software Foundation; either version 2 of the License, or

# (at your option) any later version. See the LICENSE file for details.

UserTag catch Order label

UserTag catch addAttr

UserTag catch hasEndTag

UserTag catch Version 1.7

UserTag catch Routine <<EOR

sub {

my ($label, $opt, $body) = @_;

$label = 'default' unless $label;

my $patt;

my $error;

return pull_else($body)

unless $error = $Vend::Session->{try}{$label};

$body = pull_if($body);

if ( $opt->{exact} ) {

#----------------------------------------------------------------

# 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/\|$//;

$patt = qr($patt);

#----------------------------------------------------------------

}

my @found;

while ($body =~ s{

\[/

(.+?)

/\]

(.*?)

\[/

(?:\1)?/?

\]}{}sx ) {

my $re;

my $emsg = $2;

eval {

$re = qr{$1}

};

next if $@;

if($emsg =~ $patt) {

push @found, $emsg;

}

next unless $error =~ $re;

push @found, $emsg;

last;

}

if(@found) {

$body = join $opt->{joiner} || "\n", @found;

}

else {

$body =~ s/\$ERROR\$/$error/g;

}

$body =~ s/\s+$//;

$body =~ s/^\s+//;

if($opt->{error_set}) {

set_error($body, $opt->{error_set});

}

if($opt->{error_scratch}) {

$::Scratch->{$opt->{error_scratch}} = 1;

}

return '' if $opt->{hide};

return $body;

}

EOR