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	#!/usr/bin/perl
2	use strict;
3	use warnings;
4	use CGI::Carp qw(fatalsToBrowser);
5
6	use FindBin;
7	use lib qq[$FindBin::Bin/../lib];
8	use lib q[/home/wakaba/work/manakai2/lib];
9	use Message::CGI::Util qw/htescape/;
10	use Encode;
11
12	use Message::CGI::HTTP;
13	my $cgi = Message::CGI::HTTP->new;
14
15	my $regexp = decode 'utf-8', $cgi->get_parameter ('s') // '';
16	$regexp = '(?:)' unless length $regexp;
17	my $eregexp = htescape $regexp;
18
19	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
28	eval {
29	$parser->parse ($regexp);
30	};
31
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	<title>Regular expression visualizer: ], $eregexp, q[</title>
37	<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
48	require Regexp::Visualize::Simple;
49	my $v = Regexp::Visualize::Simple->new;
50	$v->push_regexp_node ($parser->root);
51
52	binmode STDOUT, ':encoding(utf-8)';
53	print "Content-Type: application/xhtml+xml; charset=utf-8\n\n";
54
55	print q[<html lang="en" xmlns="http://www.w3.org/1999/xhtml">
56	<head><title>Regular expression visualizer: ], $eregexp, q[</title>
57	<link rel="stylesheet" href="/www/style/html/xhtml"/>
58	</head>
59	<body>
60	<h1>Regular expression visualizer</h1>
61
62	<p>Input: <code>], $eregexp, q[</code></p>];
63
64	while ($v->has_regexp_node) {
65	my ($g, $index) = $v->next_graph;
66
67	print "<section><h2>Regexp #$index</h2>\n\n";
68	print $g->as_svg;
69	print "</section>\n";
70	}
71
72	print q[</body></html>];
73