[Bps-public-commit] r16055 - in Prophet/branches/dispatcher: lib/Prophet
sartak at bestpractical.com
sartak at bestpractical.com
Thu Sep 25 14:33:46 EDT 2008
Author: sartak
Date: Thu Sep 25 14:33:38 2008
New Revision: 16055
Modified:
Prophet/branches/dispatcher/ (props changed)
Prophet/branches/dispatcher/lib/Prophet/CLI.pm
Log:
r72448 at onn: sartak | 2008-09-25 14:26:54 -0400
Begin gutting how command dispatch works
Modified: Prophet/branches/dispatcher/lib/Prophet/CLI.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/CLI.pm (original)
+++ Prophet/branches/dispatcher/lib/Prophet/CLI.pm Thu Sep 25 14:33:38 2008
@@ -66,70 +66,6 @@
sub dispatcher_class { "Prophet::CLI::Dispatcher" }
-=head2 _get_cmd_obj
-
-Attempts to determine a command object based on aliases and the currently
-set commands, arguments, and properties. Returns the class on success;
-dies on failure.
-
-This routine will use a C<CLI::Command::Shell> class if no arguments are
-specified.
-
-This routine will use a C<CLI::Command::NotFound> class as a last resort, so
-failure should occur rarely if ever.
-
-=cut
-
-sub _get_cmd_obj {
- my $self = shift;
-
- my $command = join ' ', @{ $self->context->primary_commands };
-
- # 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,
- );
-
- $self->dispatcher_class->run($command, %dispatcher_args);
- die "I don't know how to parse '$command'. Are you sure that's a valid command?\n" unless $class;
-
- my %constructor_args = (
- cli => $self,
- context => $self->context,
- commands => $self->context->primary_commands,
- type => $self->context->type,
- );
-
- # undef causes type constraint violations
- for my $key (keys %constructor_args) {
- delete $constructor_args{$key}
- if !defined($constructor_args{$key});
- }
-
- $constructor_args{uuid} = $self->context->uuid
- if $self->context->has_uuid;
-
- return $class->new(%constructor_args);
-}
-
-sub _try_to_load_cmd_class {
- my $self = shift;
- my $class = shift;
- Prophet::App->try_to_require($class);
- return $class if $class->isa('Prophet::CLI::Command');
-
- warn "Invalid class $class - not a subclass of Prophet::CLI::Command."
- if $class !~ /::$/ # don't warn about "Prophet::CLI::Command::" (which happens on "./bin/sd")
- && Prophet::App->already_required($class);
-
- return undef;
-}
-
-
=head2 run_one_command
Runs a command specified by commandline arguments given in an
@@ -148,13 +84,21 @@
my $self = shift;
my @args = (@_);
- # really, we shouldn't be doing this stuff from the command dispatcher
+ # really, we shouldn't be doing this stuff from the command dispatcher
+
+ $self->context(Prophet::CLIContext->new( app_handle => $self->app_handle));
+ $self->context->setup_from_args(@args);
+
+ my $args = $self->context->primary_commands;
+ my $command = join ' ', @$args;
+
+ my $dispatcher = $self->dispatcher_class->new(
+ cli => $self,
+ context => $self->context,
+ dispatching_on => $args,
+ );
- $self->context(Prophet::CLIContext->new( app_handle => $self->app_handle));
- $self->context->setup_from_args(@args);
- if ( my $cmd_obj = $self->_get_cmd_obj() ) {
- $cmd_obj->run();
- }
+ $dispatcher->run($command, %dispatcher_args);
}
=head2 invoke outhandle, ARGV_COMPATIBLE_ARRAY
More information about the Bps-public-commit
mailing list