[Bps-public-commit] r15532 - in Prophet/trunk: . lib/Prophet/CLI t
sartak at bestpractical.com
sartak at bestpractical.com
Wed Aug 27 11:24:30 EDT 2008
Author: sartak
Date: Wed Aug 27 11:24:30 2008
New Revision: 15532
Added:
Prophet/trunk/lib/Prophet/CLI/Dispatcher.pm
Modified:
Prophet/trunk/ (props changed)
Prophet/trunk/Makefile.PL
Prophet/trunk/lib/Prophet/CLI.pm
Prophet/trunk/t/search.t
Log:
Merge dispatcher branch in!
Modified: Prophet/trunk/Makefile.PL
==============================================================================
--- Prophet/trunk/Makefile.PL (original)
+++ Prophet/trunk/Makefile.PL Wed Aug 27 11:24:30 2008
@@ -23,8 +23,10 @@
requires('MooseX::AttributeHelpers' => '0.12');
requires('MooseX::ClassAttribute' => '0.04');
requires('XML::Atom::SimpleFeed');
+requires('Path::Dispatcher'); # Path::Dispatcher::Declarative
+
use Term::ReadLine; # if we don't do this, ::Perl fails
-features(
+features(
'Improved interactive shell' => [
-default => 1,
'Term::ReadLine::Perl'
Modified: Prophet/trunk/lib/Prophet/CLI.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI.pm (original)
+++ Prophet/trunk/lib/Prophet/CLI.pm Wed Aug 27 11:24:30 2008
@@ -5,6 +5,7 @@
use Prophet;
use Prophet::Replica;
use Prophet::CLI::Command;
+use Prophet::CLI::Dispatcher;
use Prophet::CLIContext;
use List::Util 'first';
@@ -56,15 +57,14 @@
=cut
-our %CMD_MAP = (
- ls => 'search',
- new => 'create',
- edit => 'update',
- rm => 'delete',
- del => 'delete',
- list => 'search',
- display => 'show',
-);
+=head2 dispatcher -> Class
+
+Returns the dispatcher used to dispatch command lines. You'll want to override
+this in your subclass.
+
+=cut
+
+sub dispatcher { "Prophet::CLI::Dispatcher" }
=head2 _get_cmd_obj
@@ -83,50 +83,20 @@
sub _get_cmd_obj {
my $self = shift;
- my $aliases = $self->config->aliases;
- my $tmp = $self->context->primary_commands;
- if (@$tmp && $aliases->{$tmp->[0]}) {
- @ARGV = split ' ', $aliases->{$tmp->[0]};
- return $self->run_one_command;
- }
- my @commands = map { exists $CMD_MAP{$_} ? $CMD_MAP{$_} : $_ } @{ $tmp };
-
- # allow overriding of default command. "./prophet" starts a prophet shell
- @commands = $self->_default_command
- if @commands == 0;
-
- my @possible_classes;
-
- my @to_try = @commands;
+ my $command = join ' ', @{ $self->context->primary_commands };
- while (@to_try) {
-
- # App::SD::CLI::Command::Ticket::Comment::List
- my $cmd = $self->app_class . "::CLI::Command::" . join('::', map { ucfirst lc $_ } @to_try);
-
- push @possible_classes, $cmd;
- shift @to_try;
- # throw away that top-level "Ticket" option
- }
-
- my @extreme_fallback_commands;
-
- # App::SD::CLI::Command::List
- # Prophet::CLI::Command::List
- for my $main ($self->app_class, 'Prophet') {
- push @extreme_fallback_commands, $main . "::CLI::Command::" . ucfirst(lc $commands[-1]);
- }
-
- # App::SD::CLI::Command::NotFound
- # Prophet::CLI::Command::NotFound
- for my $main ($self->app_class, 'Prophet') {
- push @extreme_fallback_commands, $main . "::CLI::Command::NotFound";
- }
+ # yeah this kind of sucks but there's no sane way to tell
+ my $class;
+ my %dispatcher_args = (
+ cli => $self,
+ context => $self->context,
+ got_command => sub { $class = shift },
+ dispatching_on => $self->context->primary_commands,
+ );
- my $class = first { $self->_try_to_load_cmd_class($_) }
- @possible_classes, @extreme_fallback_commands;
+ $self->dispatcher->run($command, %dispatcher_args);
- die "I don't know how to parse '" . join( " ", @{ $self->context->primary_commands } ) . "'. Are you sure that's a valid command?" unless ($class);
+ die "I don't know how to parse '$command'. Are you sure that's a valid command?" unless $class;
my %constructor_args = (
cli => $self,
@@ -147,15 +117,6 @@
return $class->new(%constructor_args);
}
-=head2 _default_command
-
-Returns the "default" command for use when no arguments were specified on the
-command line. In Prophet, it's "shell" but your subclass can change that.
-
-=cut
-
-sub _default_command { "shell" }
-
sub _try_to_load_cmd_class {
my $self = shift;
my $class = shift;
Added: Prophet/trunk/lib/Prophet/CLI/Dispatcher.pm
==============================================================================
--- (empty file)
+++ Prophet/trunk/lib/Prophet/CLI/Dispatcher.pm Wed Aug 27 11:24:30 2008
@@ -0,0 +1,68 @@
+package Prophet::CLI::Dispatcher;
+use strict;
+use warnings;
+use Path::Dispatcher::Declarative -base;
+
+# "ticket display $ID" -> "ticket display --id=$ID"
+on qr{ (.*) \s+ ( \d+ | [A-Z0-9]{36} ) $ }x => sub {
+ my %args = @_;
+ $args{cli}->set_arg(id => $2);
+ run($1, %args);
+};
+
+on qr{^(\w+)} => sub {
+ my %args = @_;
+
+ my $cmd = __PACKAGE__->resolve_builtin_aliases($1);
+
+ my @possible_classes = (
+ ("Prophet::CLI::Command::" . ucfirst lc $cmd),
+ "Prophet::CLI::Command::Notound",
+ );
+
+ my $cli = $args{cli};
+
+ for my $class (@possible_classes) {
+ if ($cli->_try_to_load_cmd_class($class)) {
+ return $args{got_command}->($class);
+ }
+ }
+};
+
+on qr{^\s*$} => sub {
+ run(__PACKAGE__->default_command, @_);
+
+};
+
+my %CMD_MAP = (
+ ls => 'search',
+ new => 'create',
+ edit => 'update',
+ rm => 'delete',
+ del => 'delete',
+ list => 'search',
+ display => 'show',
+);
+
+sub resolve_builtin_aliases {
+ my $self = shift;
+ my @cmds = @_;
+
+ if (my $replacement = $CMD_MAP{ lc $cmds[-1] }) {
+ $cmds[-1] = $replacement;
+ }
+
+ return wantarray ? @cmds : $cmds[-1];
+}
+
+=head2 default_command
+
+Returns the "default" command for use when no arguments were specified on the
+command line. In Prophet, it's "shell" but your subclass can change that.
+
+=cut
+
+sub default_command { "shell" }
+
+1;
+
Modified: Prophet/trunk/t/search.t
==============================================================================
--- Prophet/trunk/t/search.t (original)
+++ Prophet/trunk/t/search.t Wed Aug 27 11:24:30 2008
@@ -15,7 +15,7 @@
"Found our records",
);
- run_output_matches('prophet', [qw(search --type Bug -- status=new)],
+ run_output_matches('prophet', [qw(ls --type Bug -- status=new)],
[qr/first ticket summary/],
"found the only ticket with status=new",
);
More information about the Bps-public-commit
mailing list