Improved handling of empty pattern

and separated warning and error messages
master
Hauke D 7 years ago
parent 1aafe2099b
commit 75cc289ad7

@ -44,7 +44,10 @@ textarea.samp_ta {
float: right; float: right;
cursor: pointer; cursor: pointer;
} }
.nomatch { .re_warns {
background-color: rgba(255,255,200,255);
}
.nomatch, .re_errors {
background-color: rgba(255,200,200,255); background-color: rgba(255,200,200,255);
} }
.match { .match {
@ -152,6 +155,7 @@ my $thisurl_ta = $jq->("#thisurl");
my $ta_regex = $jq->("#regex"); my $ta_regex = $jq->("#regex");
my $ta_flags = $jq->("#flags"); my $ta_flags = $jq->("#flags");
my $errmsgs = $jq->("#errmsgs"); my $errmsgs = $jq->("#errmsgs");
my $warnmsgs = $jq->("#warnmsgs");
$ta_regex->change(\&update); $ta_regex->change(\&update);
$ta_regex->keyup( \&update); $ta_regex->keyup( \&update);
$ta_flags->change(\&update); $ta_flags->change(\&update);
@ -163,14 +167,21 @@ sub update {
my $flags = $ta_flags->val; my $flags = $ta_flags->val;
my $regex_str = 'm{'.$regex.'}'.$flags; my $regex_str = 'm{'.$regex.'}'.$flags;
$re_debug and say STDERR "##### ##### ##### $regex_str ##### ##### #####"; $re_debug and say STDERR "##### ##### ##### $regex_str ##### ##### #####";
$re_debug and !length($regex) and say STDERR
"NOTE: The empty regex $regex_str requires a workaround with /(?:)/," # https://www.perlmonks.org/?node_id=1221517
."\n this will be reflected in the debug output";
my $err = ''; my ($warn,$err) = ('','');
$warn .= "Notice: The empty pattern has special behavior, see perlop!\n"
." Here, a workaround is used so it acts as a true empty pattern." unless length $regex;
my $ok = do { my $ok = do {
local $SIG{__WARN__} = sub { $err .= shift }; local $SIG{__WARN__} = sub { $warn .= shift };
eval( ($re_debug?'use re "debug";':'')."''=~$regex_str;1") }; eval( ($re_debug?'use re "debug";':'')."''=~$regex_str;1") };
$ok or $err .= $@||"Unknown error"; $ok or $err .= $@||"Unknown error";
$err =~ s/\bat .+? line \d+(?:\.$|,\h)//mg; s/\bat .+? line \d+(?:\.$|,\h)//mg for $warn,$err;
$ok or $err .= "Matching aborted!";
$errmsgs->text($err); $errmsgs->text($err);
$warnmsgs->text($warn);
return if !$ok; return if !$ok;
my @samps; my @samps;
@ -180,11 +191,12 @@ sub update {
$re_debug and say STDERR "----- ----- ----- ",pp($text)," ----- ----- -----"; $re_debug and say STDERR "----- ----- ----- ",pp($text)," ----- ----- -----";
push @samps, $text; push @samps, $text;
my @m; my @m;
my $code = $flags=~/g/ my $code = ($re_debug?'use re "debug";':'')
? 'push @m,[[@-],[@+]] while $text=~'.$regex_str.'; scalar @m' . (length($regex)?'':"''=~/(?:)/$flags;")
: '$text=~'.$regex_str.' and push @m,[[@-],[@+]]; scalar @m'; . ($flags=~/g/
$re_debug and $code = 'use re "debug";'.$code; ? 'push @m,[[@-],[@+]] while $text=~'.$regex_str.'; scalar @m'
if (eval $code) { : '$text=~'.$regex_str.' and push @m,[[@-],[@+]]; scalar @m');
if (eval $code) { #TODO Later: maybe merge this with the above error checking?
$samptxt->removeClass('nomatch'); $samptxt->removeClass('nomatch');
my %hi; my %hi;
$re_debug and say STDERR '@-/@+ are ',pp(\@m); $re_debug and say STDERR '@-/@+ are ',pp(\@m);
@ -273,7 +285,8 @@ js('$(window)')->on('hashchange',\&hashchange);
><tt style="vertical-align: text-bottom;">}</tt ><tt style="vertical-align: text-bottom;">}</tt
><textarea id="flags" rows="1" cols="5" style="height:1.2em" ><textarea id="flags" rows="1" cols="5" style="height:1.2em"
title="Flags for Regular Expression">gi</textarea></div> title="Flags for Regular Expression">gi</textarea></div>
<pre id="errmsgs" class="nomatch"></pre> <pre id="warnmsgs" class="re_warns"></pre>
<pre id="errmsgs" class="re_errors"></pre>
</div> </div>
<div class="sample"> <div class="sample">

Loading…
Cancel
Save