retester

#!/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>