Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 327 lines (309 sloc) 9.248 kB
#!/usr/bin/env perl
use Mojolicious::Lite; # strict and warnings are implicit with Mojolicious.
use utf8;
use feature qw( unicode_strings );
use lib 'lib';
use SafeMatchStats;
app->secrets(['No sessions']); # Unimportant: We're not using sessions.
plugin 'PODRenderer';
app->defaults(
nav_bar_items => [
[ q{/} => 'Home' ],
map { [ "/pod/$_" => $_ ] }
qw( perlre perlrequick perlretut
perlreref perlrecharclass perlrebackslash
perlop perlfaq6 perluniprops
),
]
);
app->defaults( MAX_TARGET_LEN => 1024 );
any q{/} => sub {
my $self = shift;
$self->stash( { re_obj => undef, match_success => undef } );
return $self->render('index')
if !length $self->param('regexp');
my $re = SafeMatchStats->new(
{
regex => $self->param('regexp'),
modifiers => $self->param('modifiers') || q{}
}
);
if( length( $self->param('target') )
> $self->app->defaults('MAX_TARGET_LEN' )
) {
$self->stash( match_success => undef )
}
else {
$self->stash( match_success => $re->do_match($self->param('target')) );
$self->stash( re_obj => $re );
}
$self->render('index');
};
get q{/pod/:poddoc} => sub {
my $self = shift;
$self->render( template => 'pod' );
};
any q{/*} => sub {
my $self = shift;
$self->render('index');
};
app->start;
__DATA__
@@ index.html.ep
% layout 'default';
% title 'Perl Regex Tester';
<!-- <h1> <%= title =%> </h1> -->
<h3>
Test Perl regular expressions against target strings.
</h3>
<p>
The regexp engine used is compatible with Perl <%= " $^V" =%>.
</p>
%= form_for '/' => ( method => 'post', class => 'well span5' ) => begin
<p>
Target string:
<br />
<%= text_area
target => 'Just another Perl hacker,',
cols => 80,
rows => 5,
class => 'span4',
maxlength => 1024,
title => 'Enter a string to be targeted in the pattern match.'
=%>
</p>
<p>
Regular Expression:
<br />
<%= text_area
regexp => '\s(\w{4})\b',
cols => 80,
rows => 5,
class => 'span4',
maxlength => 1024,
title =>
'Enter a valid Perl regular expression. Delimiters aren\'t necessary.'
=%>
<br />
<small>
Example: To test "<code>m/pattern/</code>", enter
"<code>pattern</code>" (without quotes).
</small>
</p>
<p>
Modifiers:
<br />
<%= text_field
modifiers =>
cols => '30',
placeholder => 'Valid Modifiers: [gmsixadlu]',
maxlength => '10',
pattern => '(?:[gmsixadlu^-][gmsixadlu-]{0,10})?',
title =>
'Valid modifiers are from the set [gmsixadlu^-], or leave empty.'
%>
%= submit_button 'Attempt Match', class => 'btn btn-primary'
<br />
<small>
Using the <code>/g</code> modifier will run match in list context.
<br />
<code>/r</code> is set by default to enable access to all match
variables.
</small>
</p>
<p>
<h1>
&nbsp; <!-- Oh, the guilt and shame! -->
</h1>
</p>
<div class="float-right span4">
% if( $match_success ) {
<div class = "alert alert-success">
<h2 class="alert-heading">
Match!
</h2>
Check the "Capture variables" and "Debug info" sections for more info.
</div>
% }
% elsif( defined $match_success && ! $match_success ) {
<div class = "alert alert-warning">
<h2 class="alert-heading">
No match!
</h2>
Check the "Debug info" section to see why.
</div>
% }
% elsif( defined param('target') && length(param('target')) > $MAX_TARGET_LEN ) {
<div class="alert alert-error">
<h2 class="alert-heading">
Target too long.
</h2>
This application limits the length of the target string to
<%= $MAX_TARGET_LEN %> max.
</div>
% }
% elsif( param('regexp') && ! defined $match_success ) {
<div class= "alert alert-error">
<h2 class="alert-heading">
Invalid regular expression!
</h2>
This could indicate either a syntax error, or a grossly inefficient
regular expression. Check the syntax, or reduce backtracking.
</div>
% }
% if( defined param('regexp') && length param('regexp' ) ) {
<a href="<%= url_for('/')->query(
target => param('target'), regexp => param('regexp'),
modifiers => param('modifiers') )
=%>">Link to this test</a>
% }
</div>
%end
<%
if( $match_success ) {
local $" = ',';
=%>
<article class="float-right span6">
<div class="well">
<h3>Capture variables:</h3>
<ul>
% if( $re_obj->g_modifier ) {
<li>List Context Return Values
<ul>
% foreach my $rv ( @{$re_obj->match_rv} ) {
<li>[<mark><code><%= $rv =%></code></mark>]</li>
% }
</ul>
</li>
% }
% if( @{$re_obj->digits} > 1 ) {
<li>Digit Captures
<ul>
% foreach my $digit ( 1 .. $#{$re_obj->digits} ) {
<li>
<code>$<%= $digit =%> =></code>
[<mark><code><%= $re_obj->digits->[$digit] =%></code></mark>]
</li>
% }
</ul>
</li>
% }
% if( keys %{$re_obj->hash_plus} ) {
<li>Named Captures
<ul>
% foreach my $name ( keys %{$re_obj->hash_plus} ) {
<li>
$+{<%= $name =%>} =>
[<mark><code><%= $re_obj->hash_plus->{$name} =%></code></mark>]
</li>
% }
</ul>
</li>
% }
% if( defined $re_obj->prematch ) {
<li>
<code>${^PREMATCH} =></code>
[<mark><code><%= $re_obj->prematch =%></code></mark>]
</li>
% }
% if( defined $re_obj->match ) {
<li>
<code>${^MATCH} =></code>
[<mark><code><%= $re_obj->match =%></code></mark>]
</li>
% }
% if( defined $re_obj->postmatch ) {
<li>
<code>${^POSTMATCH} =></code>
[<mark><code><%= $re_obj->postmatch =%></code></mark>]
</li>
% }
% if( defined $re_obj->carat_n ) {
<li>
<code>${^N} =></code>
[<mark><code><%= $re_obj->carat_n =%></code></mark>]
</li>
% }
% foreach my $name ( keys %{$re_obj->hash_minus} ) {
<li>
<code>$-{<%= $name =%>} =></code>
(<code><%= "@{$re_obj->hash_minus->{$name}}" =%></code>)
</li>
% }
% if( @{$re_obj->array_minus} ) {
<li>
<code>@- => </code>
(<code><%= "@{$re_obj->array_minus}" =%></code>)
</li>
% }
% if( @{$re_obj->array_plus} ) {
<li>
<code>@+ => </code>
(<code><%= "@{$re_obj->array_plus}" =%></code>)
</li>
% }
</ul>
</div>
</article>
% }
% if( defined $match_success && defined $re_obj->debug_info ) {
<article class='span6 pre-scrollable'>
<h3>Debug Info:</h3>
<pre><%= $re_obj->debug_info =%></pre>
</article>
% }
@@ pod.html.ep
% layout 'default';
% title 'Documentation Browser';
<h1>
<%= title =%>
</h1>
<div class="container">
<iframe src='/perldoc/<%=$poddoc=%>',
seamless='seamless', height='700', class='span12' >
</iframe>
</div>
@@ layouts/default.html.ep
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
%= stylesheet '/bootstrap/css/bootstrap.min.css'
%= stylesheet '/bootstrap/css/bootstrap-responsive.min.css'
%= stylesheet '/css/page_style_bootstrap1.css'
%= javascript '/bootstrap/js/bootstrap.min.js'
<title><%= title %></title>
</head>
<body style="padding: 80px;">
<header class="container">
<nav class="row">
<div class="navbar navbar-fixed-top">
<div class="navbar-inner">
<div class="container" style="width: auto; padding: 0 20px;">
<a class="brand" href="/">The Perl Regex Tester</a>
<ul class="nav">
% foreach my $item ( @{$nav_bar_items} ) {
<li>
<a href='<%= $item->[0] =%>'><%= $item->[1] =%></a>
</li>
% }
</ul>
</div> <!-- /container -->
</div> <!-- /navbar-inner -->
</div> <!-- /nav-bar -->
</nav>
</header>
<article class="row span12">
<%= content %>
</article>
<footer class="row span12">
<p>
©2012 - David Oswald.
</p>
<p>
Powered by Perl and Mojolicious.
</p>
</footer>
</body>
</html>
Jump to Line
Something went wrong with that request. Please try again.