diff --git a/web/regex_demo.html b/web/regex_demo.html index 10a59bc..5109e6e 100644 --- a/web/regex_demo.html +++ b/web/regex_demo.html @@ -45,11 +45,15 @@ textarea.samp_ta { cursor: pointer; } .re_warns { + clear: both; background-color: rgba(255,255,200,255); } -.nomatch, .re_errors { +.re_errors { background-color: rgba(255,200,200,255); } +.nomatch { + background-color: rgba(200,200,200,255); +} .match { background-color: lightblue; border: 1px solid blue; @@ -93,6 +97,8 @@ sub sample_init { my $closebtn = $jq->('
', {html=>"🗙",class=>"closebtn", title=>"Delete Sample"}); $closebtn->appendTo($samp); + $jq->('
', {class=>'re_warns'})->appendTo($samp);
+	$jq->('
', {class=>'re_errors'})->appendTo($samp);
 	$samp->click(sub {
 		return if $samp_ta->is(':visible');
 		$samp_ta->height($samptxt->height);
@@ -195,7 +201,6 @@ $precode_ta->keyup( \&update);
 my $thisurl_ta = $jq->("#thisurl");
 my $ta_regex = $jq->("#regex");
 my $ta_flags = $jq->("#flags");
-my $errmsgs = $jq->("#errmsgs");
 my $warnmsgs = $jq->("#warnmsgs");
 $ta_regex->change(\&update);
 $ta_regex->keyup( \&update);
@@ -207,6 +212,21 @@ $ta_regex->on('input', sub {
 	$ta_regex->height($ta_regex->[0]->{scrollHeight});
 });
 
+sub run_code {
+	my ($code,$inp) = @_;
+	my @warns;
+	my $ok = do {
+		local $SIG{__WARN__} = sub { push @warns, shift };
+		package run_code;
+		our $input = $inp;
+		our @output = ();
+		eval "$code;1" };
+	my $err = $ok ? undef : $@||"Unknown error";
+	defined && s/\bat .+? line \d+(?:\.$|,\h)//mg for (@warns,$err);
+	chomp(@warns);
+	return { warns=>\@warns, $ok ? (out=>\@run_code::output) : (err=>$err) }
+}
+
 sub update {
 	my $regex = $ta_regex->val;
 	my $flags = $ta_flags->val;
@@ -218,41 +238,34 @@ sub update {
 		"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";
 	
-	# check regex for syntax errors
-	my ($warn,$err) = ('','');
+	my $warn = '';
 	$warn .= "Notice: The empty pattern has special behavior, see perlop!\n"
 		."        Here, a workaround is used so it acts as a true empty pattern.\n" unless length $regex;
 	$warn .= "\\n is recommended over literal newlines\n" if $regex=~/\n/ && $flags!~/x/;
 	$warn .= "\\t is recommended over literal tabs\n" if $regex=~/\t/ && $flags!~/x/;
-	my $ok = do {
-		local $SIG{__WARN__} = sub { $warn .= shift };
-		eval( $precode.($re_debug?'use re "debug";':'')."''=~$regex_str;1") };
-	$ok or $err .= $@||"Unknown error";
-	s/\bat .+? line \d+(?:\.$|,\h)//mg for $warn,$err;
-	$ok or $err .= "Matching aborted!";
-	$errmsgs->text($err);
 	$warnmsgs->text($warn);
-	return if !$ok;
 	
 	# apply regex to the samples and do highlighting
 	my @samps;
-	for my $samptxt ($jq->('.samptxt')->@*) {
-		$samptxt = $jq->($samptxt);
+	for my $sample (map {$jq->($_)} $jq->('.sample')->@*) {
+		my $samptxt = $sample->children('.samptxt');
+		my $re_warns = $sample->children('.re_warns');
+		my $re_errs = $sample->children('.re_errors');
 		my $text = $samptxt->text;
 		$re_debug and say STDERR "----- ----- ----- ",pp($text)," ----- ----- -----";
 		push @samps, $text;
-		my @m;
 		my $code = $precode . ($re_debug?'use re "debug";':'')
 			. (length($regex)?'':"''=~/(?:)/$flags;")
-			. ($flags=~/g/
-				? 'push @m,[[@-],[@+]] while $text=~'.$regex_str.'; scalar @m'
-				: '$text=~'.$regex_str.' and push @m,[[@-],[@+]]; scalar @m');
-		if (eval $code) { #TODO Later: maybe merge this with the above error checking?
+			. 'push @output,[[@-],[@+]] ' . ($flags=~/g/?'while':'if') . ' $input=~'.$regex_str;
+		my $rv = run_code($code, $text);
+		$re_warns->text( join "\n", $rv->{warns}->@* );
+		if ( $rv->{out} && $rv->{out}->@* ) {
+			$re_errs->text('');
 			$samptxt->removeClass('nomatch');
 			my %hi;
-			$re_debug and say STDERR '@-/@+ are ',pp(\@m);
-			for my $i (0..$#m) {
-				my ($s,$e) = $m[$i]->@*;
+			$re_debug and say STDERR '@-/@+ are ',pp($rv->{out});
+			for my $i (0..$#{$rv->{out}}) {
+				my ($s,$e) = $rv->{out}[$i]->@*;
 				for my $j (0..$#$e) { # Use @+ to count all capture groups instead of @-!
 					next if !defined($$s[$j]) && !defined($$e[$j]);
 					my $name = "Match ".($i+1).($j?" Capture Group $j":"");
@@ -280,8 +293,9 @@ sub update {
 			$samptxt->html($html);
 		}
 		else {
+			$re_errs->text($rv->{out} ? '' : $rv->{err});
+			$rv->{out} && $samptxt->addClass('nomatch');
 			$samptxt->text($text);
-			$samptxt->addClass('nomatch');
 		}
 	}
 	
@@ -394,7 +408,6 @@ my $x = "foo";  # example
 	>

-