regexp/visualizer/regexp.cgi

#!/usr/bin/perl
use strict;
use warnings;
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/htescape/;
use Encode;

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

my $regexp = decode 'utf-8', $cgi->get_parameter ('s') // '';
$regexp = '(?:)' unless length $regexp;
my $eregexp = htescape $regexp;

my $lang = $cgi->get_parameter ('l') // 'perl58';
my $class = $lang eq 'js'
    ? 'Regexp::Parser::JavaScript'
    : 'Regexp::Parser::Perl58';

use UNIVERSAL::require;
$class->use or die $@;
my $parser = $class->new;

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