[Bps-public-commit] r15781 - in Prophet/trunk: . lib/Prophet/CLI/Command t

jesse at bestpractical.com jesse at bestpractical.com
Sun Sep 7 16:13:26 EDT 2008


Author: jesse
Date: Sun Sep  7 16:13:25 2008
New Revision: 15781

Modified:
   Prophet/trunk/Makefile.PL
   Prophet/trunk/lib/Prophet/CLI.pm
   Prophet/trunk/lib/Prophet/CLI/Command/Shell.pm
   Prophet/trunk/lib/Prophet/CLIContext.pm
   Prophet/trunk/t/01-dependencies.t

Log:
* Cleanups to the CLI context / shell interactions to stop needing to localize @ARGV


Modified: Prophet/trunk/Makefile.PL
==============================================================================
--- Prophet/trunk/Makefile.PL	(original)
+++ Prophet/trunk/Makefile.PL	Sun Sep  7 16:13:25 2008
@@ -15,6 +15,7 @@
 requires('LWP::Simple'); # Part of lib-www-perl
 requires('URI');
 requires('JSON' => '2.00');
+requires('JSON::XS');
 requires('Module::Pluggable');
 requires('File::Find::Rule');
 requires('Proc::InvokeEditor');

Modified: Prophet/trunk/lib/Prophet/CLI.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI.pm	(original)
+++ Prophet/trunk/lib/Prophet/CLI.pm	Sun Sep  7 16:13:25 2008
@@ -96,7 +96,7 @@
 
     $self->dispatcher->run($command, %dispatcher_args);
 
-    die "I don't know how to parse '$command'. 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?\n" unless $class;
 
     my %constructor_args = (
         cli      => $self,
@@ -133,25 +133,25 @@
 
 =head2 run_one_command
 
-Runs a command specified by commandline arguments given in ARGV. To use in
-a commandline front-end, create a L<Prophet::CLI> object and pass in
+Runs a command specified by commandline arguments given in an
+ARGV-like array of argumnents and key value pairs . To use in a
+commandline front-end, create a L<Prophet::CLI> object and pass in
 your main app class as app_class, then run this routine.
 
 Example:
 
  my $cli = Prophet::CLI->new({ app_class => 'App::SD' });
-$cli->run_one_command;
+$cli->run_one_command(@ARGV);
 
 =cut
 
 sub run_one_command {
     my $self = shift;
+    my @args = (@_ || @ARGV);
      #  really, we shouldn't be doing this stuff from the command dispatcher
-     $self->context(Prophet::CLIContext->new( app_handle => $self->app_handle)); 
-	
 
-    $self->context->parse_args();
-    $self->context->set_type_and_uuid();
+   $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();
     }

Modified: Prophet/trunk/lib/Prophet/CLI/Command/Shell.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI/Command/Shell.pm	(original)
+++ Prophet/trunk/lib/Prophet/CLI/Command/Shell.pm	Sun Sep  7 16:13:25 2008
@@ -47,15 +47,15 @@
 sub eval {
     my $self = shift;
     my $line = shift;
+ 
 
+    # XXX TODO - really, we should be replacing the context and cli objects here and handing fresh ones in for the this eval
     $self->context->clear_args;
     $self->context->clear_props;
 
-    local @ARGV = split ' ', $line;
-
     eval {
         local $SIG{__DIE__} = 'DEFAULT';
-        $self->cli->run_one_command;
+        $self->cli->run_one_command(split ' ', $line);
     };
     warn $@ if $@;
 }
@@ -68,13 +68,13 @@
     print $self->preamble . "\n";
 
     $self->cli->interactive_shell(1);
-    while (defined(local $_ = $self->read)) {
-        next if /^\s*$/;
+    while ( defined(my $cmd = $self->read)) {
+        next if $cmd =~ /^\s*$/;
 
-        last if /^\s*q(?:uit)?\s*$/i
-             || /^\s*exit\s*$/i;
+        last if $cmd =~ /^\s*q(?:uit)?\s*$/i
+             || $cmd =~ /^\s*exit\s*$/i;
 
-        $self->eval($_);
+        $self->eval($cmd);
     }
 }
 

Modified: Prophet/trunk/lib/Prophet/CLIContext.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLIContext.pm	(original)
+++ Prophet/trunk/lib/Prophet/CLIContext.pm	Sun Sep  7 16:13:25 2008
@@ -130,12 +130,30 @@
 
 sub cmp_regex { '!=|<>|=~|!~|=|\bne\b' }
 
-=head2 parse_args
 
-This routine pulls arguments (specified by --key=value or --key value) and
-properties (specified by --props key=value or -- key=value) passed on the
-command line out of ARGV and sticks them in L</args> or L</props> and
-L</prop_set> as necessary. Argument keys have leading "--" stripped.
+=head2 setup_from_args
+
+Sets up this context object's arguments and key/value pairs from an array that looks like an @ARGV.
+
+=cut
+
+sub setup_from_args {
+    my $self = shift;
+    $self->parse_args(@ARGV);
+    $self->set_type_and_uuid();
+
+}
+
+
+
+
+=head2 parse_args @args
+
+This routine pulls arguments (specified by --key=value or --key
+value) and properties (specified by --props key=value or -- key=value)
+as passed on the command line out of ARGV (or something else emulating
+ARGV) and sticks them in L</args> or L</props> and L</prop_set> as
+necessary. Argument keys have leading "--" stripped.
 
 If a key is not given a value on the command line, its value is set to undef.
 
@@ -145,10 +163,10 @@
 =cut
 
 sub parse_args {
-    my $self = shift;
-
+    my $self = shift; 
+    my @args = (@_);
     my @primary;
-    push @primary, shift @ARGV while ( $ARGV[0] && $ARGV[0] !~ /^--/ );
+    push @primary, shift @args while ( $args[0] && $args[0] !~ /^--/ );
 
     # "ticket show 4" should DWIM and "ticket show --id=4"
     $self->set_arg( id => pop @primary )
@@ -159,7 +177,7 @@
     $self->primary_commands( \@primary );
     my $cmp_re = $self->cmp_regex;
 
-    while ( my $name = shift @ARGV ) {
+    while ( my $name = shift @args ) {
         die "$name doesn't look like --argument"
             if !$collecting_props && $name !~ /^--/;
 
@@ -178,17 +196,17 @@
         # no value specified, pull it from the next argument, unless the next
         # argument is another option
         if ( !defined($val) ) {
-            $val = shift @ARGV
-                if @ARGV && $ARGV[0] !~ /^--/;
+            $val = shift @args
+                if @args && $args[0] !~ /^--/;
 
             no warnings 'uninitialized';
 
             # but wait! does the value look enough like a comparator? if so,
             # shift off another one (if we can)
             if ($collecting_props) {
-                if ( $val =~ /^(?:$cmp_re)$/ && @ARGV && $ARGV[0] !~ /^--/ ) {
+                if ( $val =~ /^(?:$cmp_re)$/ && @args && $args[0] !~ /^--/ ) {
                     $cmp = $val;
-                    $val = shift @ARGV;
+                    $val = shift @args;
                 } else {
 
                     # perhaps they said "foo =~bar"..

Modified: Prophet/trunk/t/01-dependencies.t
==============================================================================
--- Prophet/trunk/t/01-dependencies.t	(original)
+++ Prophet/trunk/t/01-dependencies.t	Sun Sep  7 16:13:25 2008
@@ -14,6 +14,7 @@
 use File::Find;
 eval 'use Module::CoreList';
 if ($@) { plan skip_all => 'Module::CoreList not installed' }
+if (! -d 'inc/.author') { plan skip_all => 'These tests only run for module auhtors'}
 
 plan 'no_plan';
 



More information about the Bps-public-commit mailing list