added experimental --verbose option to routes command

mojolicious · Nov 2, 2011 · 699f21e · 699f21e
1 parent 9126818
commit 699f21e
Show file tree

Hide file tree

Showing 5 changed files with 57 additions and 49 deletions.
diff --git a/Changes b/Changes
@@ -1,6 +1,7 @@
 This file documents the revision history for Perl extension Mojolicious.
 
 2.22    2011-11-02 00:00:00
+        - Added EXPERIMENTAL --verbose flag to routes command.
         - Fixed a few template inheritance bugs. (ruz)
 
 2.21    2011-11-02 00:00:00

diff --git a/Makefile.PL b/Makefile.PL
@@ -42,6 +42,7 @@ WriteMakefile(
 
   EXE_FILES => ['script/hypnotoad', 'script/mojo', 'script/morbo'],
   PREREQ_PM => {
+    're'                     => 0,
     'B'                      => 0,
     'Carp'                   => 0,
     'Config'                 => 0,

diff --git a/lib/Mojolicious/Command/routes.pm b/lib/Mojolicious/Command/routes.pm
@@ -1,95 +1,101 @@
 package Mojolicious::Command::routes;
 use Mojo::Base 'Mojo::Command';
 
-use Mojo::Server;
+use re 'regexp_pattern';
+use Getopt::Long 'GetOptions';
 
 has description => <<'EOF';
 Show available routes.
 EOF
 has usage => <<"EOF";
-usage: $0 routes
+usage: $0 routes [OPTIONS]
+
+These options are available:
+  --verbose   Print additional details about routes.
 EOF
 
 # "I'm finally richer than those snooty ATM machines."
 sub run {
   my $self = shift;
 
+  # Options
+  local @ARGV = @_;
+  my $verbose;
+  GetOptions(verbose => sub { $verbose = 1 });
+
   # Check if application has routes
   my $app = $self->app;
   die "Application has no routes.\n" unless $app->can('routes');
 
   # Walk and draw
   my $routes = [];
   $self->_walk($_, 0, $routes) for @{$app->routes->children};
-  $self->_draw($routes);
+  $self->_draw($routes, $verbose);
 }
 
 sub _draw {
-  my ($self, $routes) = @_;
+  my ($self, $routes, $verbose) = @_;
 
   # Length
-  my $pl = my $nl = my $ml = 0;
+  my @length = (0, 0, 0);
   for my $node (@$routes) {
 
-    # Path
-    my $l = length $node->[0];
-    $pl = $l if $l > $pl;
-
-    # Name
-    my $l2 = length($node->[1]->name);
-    $l2 += 2 if $node->[1]->has_custom_name;
-    $nl = $l2 if $l2 > $nl;
+    # Pattern
+    my $len = length $node->[0];
+    $length[0] = $len if $len > $length[0];
 
     # Methods
-    my $l3 =
-      defined($node->[1]->via)
-      ? length(join ',', @{$node->[1]->via})
-      : length('*');
-    $ml = $l3 if $l3 > $ml;
+    unless (defined $node->[1]->via) { $len = length '*' }
+    else { $len = length(join ',', @{$node->[1]->via}) }
+    $length[1] = $len if $len > $length[1];
+
+    # Name
+    $len = length $node->[1]->name;
+    $len += 2 if $node->[1]->has_custom_name;
+    $length[2] = $len if $len > $length[2];
   }
 
   # Draw
   foreach my $node (@$routes) {
-
-    # Regex
-    $node->[1]->pattern->_compile;
-    my $regex = $node->[1]->pattern->regex;
+    my @parts;
 
     # Pattern
-    my $pattern = $node->[0];
-    my $pp = ' ' x ($pl - length $pattern);
+    push @parts, $node->[0];
+    $parts[-1] .= ' ' x ($length[0] - length $parts[-1]);
+
+    # Methods
+    my $methods;
+    unless (defined $node->[1]->via) { $methods = '*' }
+    else { $methods = uc join ',', @{$node->[1]->via} }
+    push @parts, $methods . ' ' x ($length[1] - length $methods);
 
     # Name
     my $name = $node->[1]->name;
     $name = qq/"$name"/ if $node->[1]->has_custom_name;
-    my $np = ' ' x ($nl - length $name);
+    push @parts, $name . ' ' x ($length[2] - length $name);
 
-    # Methods
-    my $methods =
-      defined $node->[1]->via
-      ? uc join ',', @{$node->[1]->via}
-      : '*';
-    my $mp = ' ' x ($ml - length $methods);
+    # Regex
+    (my $pattern = $node->[1]->pattern)->match('/');
+    my $regex  = (regexp_pattern $pattern->regex)[0];
+    my $format = (regexp_pattern $pattern->format)[0];
+    my $req    = $pattern->reqs->{format};
+    $format = defined $req ? '' : "(?:$format)?" unless $req;
+    push @parts, $node->[1]->is_endpoint ? "$regex$format" : $regex
+      if $verbose;
 
     # Route
-    say "$pattern$pp  $methods$mp  $name$np  $regex";
+    say join('  ', @parts);
   }
 }
 
 # "I surrender, and volunteer for treason!"
 sub _walk {
   my ($self, $node, $depth, $routes) = @_;
 
-  # Line
-  my $pattern = $node->pattern->pattern || '/';
-  my $line    = '';
-  my $i       = $depth * 2;
-  if ($i) {
-    $line .= ' ' x $i;
-    $line .= '+';
-  }
-  $line .= $pattern;
-  push @$routes, [$line, $node];
+  # Pattern
+  my $prefix = '';
+  if (my $i = $depth * 2) { $prefix .= ' ' x $i . '+' }
+  push @$routes, [$prefix . ($node->pattern->pattern || '/'), $node];
 
   # Walk
   $depth++;

diff --git a/lib/Mojolicious/Guides/Routing.pod b/lib/Mojolicious/Guides/Routing.pod
@@ -792,10 +792,10 @@ snowman very sad.
 The C<routes> command can be used from the command line to list all available
 routes together with name and underlying regular expressions.
 
-  $ script/myapp routes
-  /foo/:name        GET   fooname        (?-xism:^/foo/([^\/\.]+))
-  /baz/*everything  POST  bazeverything  (?-xism:^/baz/(.+))
-  /bar/(.test)      *     bartest        (?-xism:^/bar/([^\/]+))
+  $ script/myapp routes -v
+  /foo/:name        GET   fooname        ^/foo/([^/\.]+))(?:\.([^/]+)$)?
+  /baz/*everything  POST  bazeverything  ^/baz/(.+))(?:\.([^/]+)$)?
+  /bar/(.test)      *     bartest        ^/bar/([^/]+))(?:\.([^/]+)$)?
 
 =head1 MORE
 

diff --git a/lib/Mojolicious/Routes/Pattern.pm b/lib/Mojolicious/Routes/Pattern.pm
@@ -2,7 +2,7 @@ package Mojolicious::Routes::Pattern;
 use Mojo::Base -base;
 
 has defaults => sub { {} };
-has format   => sub {qr#\.([^/\)]+)$#};
+has format   => sub {qr#\.([^/]+)$#};
 has [qw/pattern regex/];
 has quote_end      => ')';
 has quote_start    => '(';
@@ -40,7 +40,7 @@ sub parse {
   $self->reqs($reqs);
 
   # Format in pattern
-  if ($pattern =~ $self->format) {
+  if ($pattern =~ m#\.([^/\)]+)$#) {
     $reqs->{format} = quotemeta($self->{strict} = $1);
   }
 
@@ -126,7 +126,7 @@ sub _compile {
   my $reqs = $self->reqs;
   if (!exists $reqs->{format} || $reqs->{format}) {
     my $format =
-      defined $reqs->{format} ? _compile_req($reqs->{format}) : '([^/\)]+)';
+      defined $reqs->{format} ? _compile_req($reqs->{format}) : '([^/]+)';
     $self->format(qr#\.$format$#);
   }