#!/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; my $footer = q[ ]; my @error; $parser->onerror (sub { my %args = @_; my $r = '

'; if ($args{level} eq 'w') { $r .= 'Warning: '; } else { $r .= 'Error: '; } $r .= htescape sprintf $args{type}, @{$args{args}}; $r .= ':

';
  $r .= htescape substr ${$args{valueref}}, 0, $args{pos_start};
  $r .= '';
  $r .= htescape substr ${$args{valueref}},
      $args{pos_start}, $args{pos_end} - $args{pos_start};
  $r .= '';
  $r .= htescape substr ${$args{valueref}}, $args{pos_end};
  $r .= '

'; push @error, $r; }); eval { $parser->parse ($regexp); }; if ($parser->errnum) { binmode STDOUT, ':encoding(utf-8)'; print "Content-Type: text/html; charset=utf-8\n\n"; print q[ Regular expression visualizer: ], $eregexp, q[

Regular expression visualizer

Input: ], $eregexp, q[

Error:

]; print join '', @error; print q[]; print $footer; 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[ Regular expression visualizer: ], $eregexp, q[

Regular expression visualizer

Input: ], $eregexp, q[

]; if (@error) { print q[

]; print join '', @error; print q[]; } while ($v->has_regexp_node) { my ($g, $index) = $v->next_graph; print "

Regexp #$index

\n\n"; print $g->as_svg; print "

\n"; } print $footer; print q[];