[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