/[suikacvs]/webroot/regexp/visualizer/regexp.cgi
Suika

Diff of /webroot/regexp/visualizer/regexp.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by wakaba, Sun Dec 7 11:46:05 2008 UTC revision 1.4 by wakaba, Mon Dec 8 12:21:26 2008 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3  use warnings;  use warnings;
 use feature 'state';  
4  use CGI::Carp qw(fatalsToBrowser);  use CGI::Carp qw(fatalsToBrowser);
5    
6  use FindBin;  use FindBin;
7  use lib qq[$FindBin::Bin/../lib];  use lib qq[$FindBin::Bin/../lib];
8  use lib q[/home/wakaba/work/manakai2/lib];  use lib q[/home/wakaba/work/manakai2/lib];
9  use Message::CGI::Util qw/percent_decode htescape/;  use Message::CGI::Util qw/htescape/;
10  use Message::CGI::HTTP;  use Encode;
   
 use Regexp::Parser::Perl58;  
11    
12    use Message::CGI::HTTP;
13  my $cgi = Message::CGI::HTTP->new;  my $cgi = Message::CGI::HTTP->new;
14    
15  my $regexp = percent_decode $cgi->get_parameter ('s') // '';  my $regexp = decode 'utf-8', $cgi->get_parameter ('s') // '';
16  $regexp = '(?:)' unless length $regexp;  $regexp = '(?:)' unless length $regexp;
17    my $eregexp = htescape $regexp;
18    
19  my $parser = Regexp::Parser::Perl58->new;  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 {  eval {
29    $parser->parse ($regexp);    $parser->parse ($regexp);
30  };  };
 my $eregexp = htescape $regexp;  
31    
32  if ($parser->errnum) {  if ($parser->errnum) {
33    binmode STDOUT, ':encoding(utf-8)';    binmode STDOUT, ':encoding(utf-8)';
34    print "Content-Type: text/html; charset=utf-8\n\n";    print "Content-Type: text/html; charset=utf-8\n\n";
35    print q[<!DOCTYPE HTML><html lang=en>    print q[<!DOCTYPE HTML><html lang=en>
36  <title>Regular expression visualizer: $eregexp</title>  <title>Regular expression visualizer: ], $eregexp, q[</title>
37  <link rel="stylesheet" href="/www/style/html/xhtml"/>  <link rel="stylesheet" href="/www/style/html/xhtml"/>
38  </head>  </head>
39  <body>  <body>
# Line 48  binmode STDOUT, ':encoding(utf-8)'; Line 53  binmode STDOUT, ':encoding(utf-8)';
53  print "Content-Type: application/xhtml+xml; charset=utf-8\n\n";  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">  print q[<html lang="en" xmlns="http://www.w3.org/1999/xhtml">
56  <head><title>Regular expression visualizer: $eregexp</title>  <head><title>Regular expression visualizer: ], $eregexp, q[</title>
57  <link rel="stylesheet" href="/www/style/html/xhtml"/>  <link rel="stylesheet" href="/www/style/html/xhtml"/>
58  </head>  </head>
59  <body>  <body>
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24