regexp/visualizer/regexp.cgi

#!/usr/bin/perl
use strict;
use warnings;
use feature 'state';
use CGI::Carp qw(fatalsToBrowser);

use FindBin;
use lib qq[$FindBin::Bin/../lib];
use lib q[/home/wakaba/work/manakai2/lib];
use Message::CGI::Util qw/percent_decode htescape/;
use Message::CGI::HTTP;

use Regexp::Parser::Perl58;

my $cgi = Message::CGI::HTTP->new;

my $regexp = percent_decode $cgi->get_parameter ('s') // '';
$regexp = '(?:)' unless length $regexp;

my $parser = Regexp::Parser::Perl58->new;

eval {
  $parser->parse ($regexp);
};
my $eregexp = htescape $regexp;

if ($parser->errnum) {
  binmode STDOUT, ':encoding(utf-8)';
  print "Content-Type: text/html; charset=utf-8\n\n";
  print q[<!DOCTYPE HTML><html lang=en>
<title>Regular expression visualizer: $eregexp</title>
<link rel="stylesheet" href="/www/style/html/xhtml"/>
</head>
<body>
<h1>Regular expression visualizer</h1>

<p>Input: <code>], $eregexp, q[</code></p>

<p>Error: ], htescape ($parser->errmsg);
  exit;
}

require Regexp::Visualize::Simple;
my $v = Regexp::Visualize::Simple->new;
$v->push_regexp_node ($parser->root);

binmode STDOUT, ':encoding(utf-8)';
print "Content-Type: application/xhtml+xml; charset=utf-8\n\n";

print q[<html lang="en" xmlns="http://www.w3.org/1999/xhtml">
<head><title>Regular expression visualizer: $eregexp</title>
<link rel="stylesheet" href="/www/style/html/xhtml"/>
</head>
<body>
<h1>Regular expression visualizer</h1>

<p>Input: <code>], $eregexp, q[</code></p>];

while ($v->has_regexp_node) {
  my ($g, $index) = $v->next_graph;

  print "<section><h2>Regexp #$index</h2>\n\n";
  print $g->as_svg;
  print "</section>\n";
}

print q[</body></html>];

1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			use warnings;
4			use feature 'state';
5			use CGI::Carp qw(fatalsToBrowser);
6
7	wakaba	1.3	use FindBin;
8			use lib qq[$FindBin::Bin/../lib];
9	wakaba	1.1	use lib q[/home/wakaba/work/manakai2/lib];
10	wakaba	1.2	use Message::CGI::Util qw/percent_decode htescape/;
11			use Message::CGI::HTTP;
12	wakaba	1.1
13	wakaba	1.3	use Regexp::Parser::Perl58;
14	wakaba	1.1
15	wakaba	1.2	my $cgi = Message::CGI::HTTP->new;
16
17			my $regexp = percent_decode $cgi->get_parameter ('s') // '';
18	wakaba	1.1	$regexp = '(?:)' unless length $regexp;
19
20	wakaba	1.3	my $parser = Regexp::Parser::Perl58->new;
21	wakaba	1.1
22	wakaba	1.3	eval {
23			$parser->parse ($regexp);
24			};
25	wakaba	1.2	my $eregexp = htescape $regexp;
26
27			if ($parser->errnum) {
28			binmode STDOUT, ':encoding(utf-8)';
29			print "Content-Type: text/html; charset=utf-8\n\n";
30			print q[<!DOCTYPE HTML><html lang=en>
31			<title>Regular expression visualizer: $eregexp</title>
32			<link rel="stylesheet" href="/www/style/html/xhtml"/>
33			</head>
34			<body>
35			<h1>Regular expression visualizer</h1>
36
37			<p>Input: <code>], $eregexp, q[</code></p>
38
39			<p>Error: ], htescape ($parser->errmsg);
40			exit;
41			}
42	wakaba	1.1
43	wakaba	1.3	require Regexp::Visualize::Simple;
44			my $v = Regexp::Visualize::Simple->new;
45			$v->push_regexp_node ($parser->root);
46
47	wakaba	1.1	binmode STDOUT, ':encoding(utf-8)';
48			print "Content-Type: application/xhtml+xml; charset=utf-8\n\n";
49
50	wakaba	1.2	print q[<html lang="en" xmlns="http://www.w3.org/1999/xhtml">
51			<head><title>Regular expression visualizer: $eregexp</title>
52			<link rel="stylesheet" href="/www/style/html/xhtml"/>
53	wakaba	1.1	</head>
54	wakaba	1.2	<body>
55			<h1>Regular expression visualizer</h1>
56
57			<p>Input: <code>], $eregexp, q[</code></p>];
58	wakaba	1.1
59	wakaba	1.3	while ($v->has_regexp_node) {
60			my ($g, $index) = $v->next_graph;
61	wakaba	1.1
62	wakaba	1.2	print "<section><h2>Regexp #$index</h2>\n\n";
63	wakaba	1.1	print $g->as_svg;
64			print "</section>\n";
65			}
66
67			print q[</body></html>];
68