[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