[Bps-public-commit] Prophet - A disconnected, replicated p2p database branch, master, updated. effe27cf708f7c9cf1aeb843d14acc04f76bb1cf

spang at bestpractical.com spang at bestpractical.com
Fri Jan 30 09:52:03 EST 2009


The branch, master has been updated
       via  effe27cf708f7c9cf1aeb843d14acc04f76bb1cf (commit)
       via  184c5772dc1e378634020c2cc89556957f60b0a4 (commit)
       via  fdb72ca628aeac895e3298efacceebb18074f9ba (commit)
       via  e5c032c57ebf084a0c3c937ccc94897c428c26a6 (commit)
      from  2ca749db17fe0f8271f8ef01e09ca8655fc3bb2e (commit)

Summary of changes:
 lib/Prophet/CLI/Command.pm          |   71 ++++++++++++++-
 lib/Prophet/CLI/Command/Aliases.pm  |    2 +
 lib/Prophet/CLI/Command/Merge.pm    |    1 +
 lib/Prophet/CLI/Command/Pull.pm     |    2 +
 lib/Prophet/CLI/Command/Server.pm   |    2 +
 lib/Prophet/CLI/Command/Settings.pm |    2 +
 lib/Prophet/CLI/Command/Show.pm     |    2 +
 lib/Prophet/CLI/Command/Update.pm   |    2 +
 lib/Prophet/CLIContext.pm           |   40 +++++---
 t/cli-arg-parsing.t                 |  174 +++++++++++++++++++++++++++++++++++
 t/cli-arg-translation.t             |   32 +++++++
 11 files changed, 313 insertions(+), 17 deletions(-)
 create mode 100644 t/cli-arg-parsing.t
 create mode 100644 t/cli-arg-translation.t

- Log -----------------------------------------------------------------
commit e5c032c57ebf084a0c3c937ccc94897c428c26a6
Author: Christine Spang <spang at bestpractical.com>
Date:   Thu Jan 29 21:47:14 2009 +0200

    test coverage for cli arg parsing

diff --git a/t/cli-arg-parsing.t b/t/cli-arg-parsing.t
new file mode 100644
index 0000000..9f8a976
--- /dev/null
+++ b/t/cli-arg-parsing.t
@@ -0,0 +1,174 @@
+use warnings;
+use strict;
+use Test::More tests => 47;
+use Test::Exception;
+
+use File::Temp qw'tempdir';
+
+# test coverage for Prophet::CLI::CLIContext arg parsing (parse_args,
+# set_type_and_uuid, setup_from_args)
+
+use_ok('Prophet::CLI');
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
+
+my $cli = Prophet::CLI->new();
+my $cxn = $cli->handle;
+my $app = $cli->app_handle;
+isa_ok( $cxn, 'Prophet::Replica', "Got the cxn" );
+
+$cxn->initialize;
+
+my $context = $cli->context;
+
+# create a record so we have a valid uuid/luid to test
+# set_type_and_uuid with
+use_ok('Prophet::Record');
+my $record = Prophet::Record->new( handle => $cxn, type => 'Person' );
+my $mao = $record->create( props => { name => 'Mao', age => 0.7, species => 'cat' } );
+my $uuid = $record->uuid;
+my $luid = $record->luid;
+
+sub reset_context {
+    my $context = shift;
+
+    $context->clear_args;
+    $context->clear_props;
+    $context->type('reset');
+    $context->uuid('reset');
+    $context->primary_commands([]);
+    $context->prop_set([]);
+}
+
+diag('set_type_and_uuid testing');
+
+diag('setting type with an arg, uuid with luid in luid arg');
+$context->set_arg( type => 'bug');
+$context->set_arg( luid => $luid );
+$context->set_type_and_uuid;
+is($context->uuid, $uuid, 'uuid is correct');
+is($context->type, 'bug', 'type is correct');
+reset_context($context);
+
+diag('setting type with primary command, uuid with luid in id arg');
+$context->primary_commands( [ 'bug', 'search' ] );
+$context->set_arg( id => $luid );
+$context->set_type_and_uuid;
+is($context->uuid, $uuid, 'uuid is correct');
+is($context->type, 'bug', 'type is correct');
+reset_context($context);
+
+diag('set uuid with uuid in id arg');
+$context->set_arg( id => $uuid );
+$context->set_arg( type => 'bug' ); # so it doesn't explode
+$context->set_type_and_uuid;
+is($context->uuid, $uuid, 'uuid is correct');
+reset_context($context);
+
+diag('set uuid with uuid in uuid arg');
+$context->set_arg( uuid => $uuid );
+$context->set_arg( type => 'bug' ); # so it doesn't explode
+$context->set_type_and_uuid;
+is($context->uuid, $uuid, 'uuid is correct');
+reset_context($context);
+
+diag('parse_args testing');
+
+diag('primary commands only');
+$context->parse_args(qw(search));
+is_deeply($context->primary_commands, [ 'search' ], 'primary commands are correct');
+is($context->arg_names, 0, 'no args were set');
+is($context->prop_names, 0, 'no props were set');
+reset_context($context);
+
+diag('primary commands only, grabbing uuid from the CLI');
+$context->parse_args(qw(show 10));
+is_deeply($context->primary_commands, [ 'show' ], 'primary commands are correct');
+is($context->arg('id'), '10', 'id was grabbed from primary commands');
+is($context->prop_names, 0, 'no props were set');
+reset_context($context);
+
+diag('primary commands + args with no values');
+$context->parse_args(qw(show --verbose --test));
+is_deeply($context->primary_commands, [ 'show' ], 'primary commands are correct');
+is($context->arg('verbose'), undef, 'verbose arg set correctly');
+is($context->arg('test'), undef, 'test arg set correctly');
+reset_context($context);
+
+diag('primary commands + mixed args with vals and not');
+$context->parse_args(qw(show --test bar --zap));
+is_deeply($context->primary_commands, [ 'show' ], 'primary commands are correct');
+is($context->arg('zap'), undef, 'zap arg set correctly');
+is($context->arg('test'),'bar', 'test arg set correctly');
+reset_context($context);
+
+diag('primary commands + mixed args with vals and not (swapped)');
+$context->parse_args(qw(show --test --zap bar));
+is_deeply($context->primary_commands, [ 'show' ], 'primary commands are correct');
+is($context->arg('zap'), 'bar', 'zap arg set correctly');
+is($context->arg('test'), undef, 'test arg set correctly');
+reset_context($context);
+
+diag('primary commands + multiple args with vals');
+$context->parse_args(qw(show --test bar --zap baz));
+is_deeply($context->primary_commands, [ 'show' ], 'primary commands are correct');
+is($context->arg('zap'), 'baz', 'zap arg set correctly');
+is($context->arg('test'), 'bar', 'test arg set correctly');
+reset_context($context);
+
+diag('primary commands + props only');
+$context->parse_args(qw(update -- name=Larry species beatle));
+is_deeply($context->primary_commands, [ 'update' ], 'primary commands are correct');
+is($context->prop('name'), 'Larry', 'name prop set correctly');
+is($context->prop('species'), 'beatle', 'species prop set correctly');
+# now check the prop set to check comparators
+is_deeply($context->prop_set->[0], { prop => 'name', cmp => '=', value =>
+        'Larry' }, 'name has correct comparator');
+# if there is no comparator given it defaults to =
+is_deeply($context->prop_set->[1], { prop => 'species', cmp => '=', value =>
+        'beatle' }, 'species has correct comparator');
+reset_context($context);
+
+diag('primary commands + props only (check that comparators are grabbed correctly)');
+
+# removed colour<> red as we don't support not having a space between the
+# prop end and the comparator if there's a space after it
+$context->parse_args(qw(update -- legs!=8 eyes ne 2 spots =~0));
+is_deeply($context->primary_commands, [ 'update' ], 'primary commands are correct');
+is($context->prop('legs'), '8', 'legs prop set correctly');
+is($context->prop('eyes'), '2', 'eyes prop set correctly');
+# is($context->prop('colour'), 'red', 'colour prop set correctly');
+is($context->prop('spots'), '0', 'spots prop set correctly');
+# now check the prop set to check comparators
+is_deeply($context->prop_set->[0], { prop => 'legs', cmp => '!=', value =>
+        '8' }, 'legs has correct comparator');
+is_deeply($context->prop_set->[1], { prop => 'eyes', cmp => 'ne', value =>
+        '2' }, 'eyes has correct comparator');
+is_deeply($context->prop_set->[2], { prop => 'spots', cmp => '=~', value =>
+        '0' }, 'spots has correct comparator');
+# is_deeply($context->prop_set->[3], { prop => 'colour', cmp => '<>', value =>
+#         'red' }, 'colour has correct comparator');
+reset_context($context);
+
+diag('args and props and check --props... the -- should trigger new props with undef values');
+$context->parse_args(qw(update --verbose --props --name --Curly));
+is_deeply($context->primary_commands, [ 'update' ], 'primary commands are correct');
+is($context->arg('verbose'), undef, 'verbose arg set correctly');
+is($context->prop('name'), undef, 'name prop set correctly');
+is($context->prop('Curly'), undef, 'Curly prop set correctly');
+reset_context($context);
+
+diag('errors');
+
+# "10 doesn't look like --argument"
+dies_ok(sub { $context->parse_args(qw(show --verbose update 10)) }, 'dies on parse error');
+reset_context($context);
+
+# XXX other errors?
+
+diag('put it all together with setup_from_args');
+$context->setup_from_args( 'bug', 'show', $luid );
+is_deeply($context->primary_commands, [ 'bug', 'show' ],
+    'primary commands are correct');
+is($context->uuid, $uuid, 'uuid is correct');
+is($context->type, 'bug', 'type is correct');
+reset_context($context);

commit fdb72ca628aeac895e3298efacceebb18074f9ba
Author: Christine Spang <spang at bestpractical.com>
Date:   Thu Jan 29 22:11:45 2009 +0200

    tests for upcoming arg translation

diff --git a/t/cli-arg-translation.t b/t/cli-arg-translation.t
new file mode 100644
index 0000000..a22f9ab
--- /dev/null
+++ b/t/cli-arg-translation.t
@@ -0,0 +1,32 @@
+use warnings;
+use strict;
+use Test::More tests => 7;
+
+use File::Temp qw'tempdir';
+
+# test coverage for Prophet::CLI::Command arg translation
+
+use_ok('Prophet::CLI');
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
+
+my $cli = Prophet::CLI->new();
+my $cxn = $cli->handle;
+isa_ok( $cxn, 'Prophet::Replica', "Got the cxn" );
+
+use_ok('Prophet::CLI::Command');
+
+my $context = $cli->context;
+
+diag('Checking default arg translations');
+$context->set_arg('a');
+$context->set_arg('v');
+my $command = Prophet::CLI::Command->new( handle => $cxn, context => $context );
+
+is($command->has_arg('all'), 1, 'translation of -a to --all correct');
+is($command->has_arg('verbose'), 1, 'translation of -v to --verbose correct');
+
+diag('Checking a subclass arg translation (with value)');
+use_ok('Prophet::CLI::Command::Server');
+$context->set_arg( p => '8080');
+my $server = Prophet::CLI::Command->new( handle => $cxn, context => $context );
+is($command->context->arg('port'), '8080', 'translation of -p to --port correct');

commit 184c5772dc1e378634020c2cc89556957f60b0a4
Author: Christine Spang <spang at bestpractical.com>
Date:   Thu Jan 29 22:16:30 2009 +0200

    implemented support for arg translations (mostly for shortcuts like -a => all etc

diff --git a/lib/Prophet/CLI/Command.pm b/lib/Prophet/CLI/Command.pm
index eadceb2..24456c4 100644
--- a/lib/Prophet/CLI/Command.pm
+++ b/lib/Prophet/CLI/Command.pm
@@ -1,5 +1,6 @@
 package Prophet::CLI::Command;
 use Moose;
+use MooseX::ClassAttribute;
 
 use Params::Validate qw(validate);
 
@@ -15,7 +16,7 @@ has cli => (
 has context => (
     is => 'rw',
     isa => 'Prophet::CLIContext',
-    handles => [ 
+    handles => [
         qw/args  set_arg  arg  has_arg  delete_arg  arg_names/,
         qw/props set_prop prop has_prop delete_prop prop_names/,
         'add_to_prop_set', 'prop_set',
@@ -23,6 +24,73 @@ has context => (
 
 );
 
+class_has ARG_TRANSLATIONS => (
+    is => 'rw',
+    isa => 'HashRef',
+    default => sub { { 'v' => 'verbose', 'a' => 'all' } },
+    documentation => 'A hash of arguments that will be translated on '.
+                     'command instantiation',
+);
+
+=head2 register_arg_translations
+
+This is the Prophet CLI's way of supporting short forms for arguments,
+e.g. you want to let '-v' be able to used for the same purpose as
+'--verbose' without dirtying your code checking both or manually
+setting them if they exist. We want it to be as easy as possible
+to have short commands.
+
+To use, have your command subclass do:
+
+    __PACKAGE__->register_arg_translations( f => 'file' );
+
+You can register as many translations at a time as you want.
+The arguments will be translated when the command object is
+instantiated. If an arg already exists in the arg translation
+table, it is overwritten with the new value.
+
+=cut
+
+sub register_arg_translations {
+    my $class = shift;
+    my %args = @_;
+
+    $class->ARG_TRANSLATIONS({ %{$class->ARG_TRANSLATIONS}, %args });
+}
+
+=head2 clear_arg_translations
+
+Don't like the defaults? Get rid of 'em.
+
+Example:
+
+    __PACKAGE__->clear_arg_translations;
+
+=cut
+
+sub clear_arg_translations {
+    my $class = shift;
+
+    $class->ARG_TRANSLATIONS({});
+}
+
+sub _translate_args {
+    my $self = shift;
+
+    for my $arg (keys %{$self->ARG_TRANSLATIONS}) {
+        $self->set_arg($self->ARG_TRANSLATIONS->{$arg}, $self->arg($arg))
+            if $self->has_arg($arg);
+    }
+}
+
+# run arg translations on object instantiation
+sub BUILD {
+    my $self = shift;
+
+    $self->_translate_args();
+
+    return $self;
+}
 
 sub fatal_error {
     my $self   = shift;
@@ -194,6 +262,7 @@ sub prompt_Yn {
 
 __PACKAGE__->meta->make_immutable;
 no Moose;
+no MooseX::ClassAttribute;
 
 1;
 
diff --git a/lib/Prophet/CLI/Command/Aliases.pm b/lib/Prophet/CLI/Command/Aliases.pm
index e8a2963..ef114e3 100644
--- a/lib/Prophet/CLI/Command/Aliases.pm
+++ b/lib/Prophet/CLI/Command/Aliases.pm
@@ -5,6 +5,8 @@ use Params::Validate qw/validate/;
 extends 'Prophet::CLI::Command';
 with 'Prophet::CLI::TextEditorCommand';
 
+__PACKAGE__->register_arg_translations( a => 'add', d => 'delete', s => 'show' );
+
 sub run {
     my $self     = shift;
     my $template = $self->make_template;
diff --git a/lib/Prophet/CLI/Command/Merge.pm b/lib/Prophet/CLI/Command/Merge.pm
index 78a7382..5d201f2 100644
--- a/lib/Prophet/CLI/Command/Merge.pm
+++ b/lib/Prophet/CLI/Command/Merge.pm
@@ -5,6 +5,7 @@ extends 'Prophet::CLI::Command';
 has source => ( isa => 'Prophet::Replica', is => 'rw');
 has target => ( isa => 'Prophet::Replica', is => 'rw');
 
+__PACKAGE__->register_arg_translations( f => 'force' );
 
 sub run {
     my $self = shift;
diff --git a/lib/Prophet/CLI/Command/Pull.pm b/lib/Prophet/CLI/Command/Pull.pm
index 2c8fd51..23b2fb6 100644
--- a/lib/Prophet/CLI/Command/Pull.pm
+++ b/lib/Prophet/CLI/Command/Pull.pm
@@ -2,6 +2,8 @@ package Prophet::CLI::Command::Pull;
 use Moose;
 extends 'Prophet::CLI::Command::Merge';
 
+__PACKAGE__->register_arg_translations( l => 'local' );
+
 sub run {
     my $self = shift;
     my @from;
diff --git a/lib/Prophet/CLI/Command/Server.pm b/lib/Prophet/CLI/Command/Server.pm
index 2b9c15e..185106b 100644
--- a/lib/Prophet/CLI/Command/Server.pm
+++ b/lib/Prophet/CLI/Command/Server.pm
@@ -2,6 +2,8 @@ package Prophet::CLI::Command::Server;
 use Moose;
 extends 'Prophet::CLI::Command';
 
+__PACKAGE__->register_arg_translations( p => 'port', w => 'writable' );
+
 use Prophet::Server;
 
 sub run {
diff --git a/lib/Prophet/CLI/Command/Settings.pm b/lib/Prophet/CLI/Command/Settings.pm
index f7005b4..8ef303b 100644
--- a/lib/Prophet/CLI/Command/Settings.pm
+++ b/lib/Prophet/CLI/Command/Settings.pm
@@ -6,6 +6,8 @@ use JSON;
 extends 'Prophet::CLI::Command';
 with 'Prophet::CLI::TextEditorCommand';
 
+__PACKAGE__->register_arg_translations( s => 'show' );
+
 sub run {
     my $self     = shift;
     my $template = $self->make_template;
diff --git a/lib/Prophet/CLI/Command/Show.pm b/lib/Prophet/CLI/Command/Show.pm
index c53647e..a3ab94b 100644
--- a/lib/Prophet/CLI/Command/Show.pm
+++ b/lib/Prophet/CLI/Command/Show.pm
@@ -4,6 +4,8 @@ use Params::Validate;
 extends 'Prophet::CLI::Command';
 with 'Prophet::CLI::RecordCommand';
 
+__PACKAGE__->register_arg_translations( 'b' => 'batch' );
+
 sub run {
     my $self = shift;
 
diff --git a/lib/Prophet/CLI/Command/Update.pm b/lib/Prophet/CLI/Command/Update.pm
index 85f9147..dabf3ce 100644
--- a/lib/Prophet/CLI/Command/Update.pm
+++ b/lib/Prophet/CLI/Command/Update.pm
@@ -3,6 +3,8 @@ use Moose;
 extends 'Prophet::CLI::Command';
 with 'Prophet::CLI::RecordCommand';
 
+__PACKAGE__->register_arg_translations( e => 'edit' );
+
 sub edit_record {
     my $self   = shift;
     my $record = shift;
diff --git a/lib/Prophet/CLIContext.pm b/lib/Prophet/CLIContext.pm
index 58a6dd1..9c497b2 100644
--- a/lib/Prophet/CLIContext.pm
+++ b/lib/Prophet/CLIContext.pm
@@ -83,8 +83,8 @@ has primary_commands => (
 
 =head2 mutate_attributes ( args => $hashref, props => $hashref, type => 'str' )
 
-A hook for running a second command from within a command without having       
-to use the commandline argument parsing.  
+A hook for running a second command from within a command without having
+to use the commandline argument parsing.
 
 If C<type>, C<uuid>, or C<primary_commands> are not passed in, the values
 from the previous command run are used.
@@ -133,7 +133,8 @@ sub cmp_regex { '!=|<>|=~|!~|=|\bne\b' }
 
 =head2 setup_from_args
 
-Sets up this context object's arguments and key/value pairs from an array that looks like an @ARGV.
+Sets up this context object's arguments and key/value pairs from an array that
+looks like an @ARGV.
 
 =cut
 
@@ -167,10 +168,10 @@ sub require_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.
+value or -k 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 "--" or "-" stripped.
 
 If a key is not given a value on the command line, its value is set to undef.
 
@@ -180,14 +181,14 @@ L</cmp_regex> for details).
 =cut
 
 sub parse_args {
-    my $self = shift; 
+    my $self = shift;
     my @args = (@_);
     my @primary;
-    push @primary, shift @args while ( $args[0] && $args[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 )
-        if @primary && $primary[-1] =~ /^(?:\d+|[0-9a-f]{8}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{12})$/i;
+    $self->set_arg( id => pop @primary ) if @primary && $primary[-1] =~
+        /^(?:\d+|[0-9a-f]{8}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{12})$/i;
 
     my $collecting_props = 0;
 
@@ -196,7 +197,7 @@ sub parse_args {
 
     while ( my $name = shift @args ) {
         die "$name doesn't look like --argument"
-            if !$collecting_props && $name !~ /^--/;
+            if !$collecting_props && $name !~ /^-/;
 
         if ( $name eq '--' || $name eq '--props' ) {
             $collecting_props = 1;
@@ -208,13 +209,13 @@ sub parse_args {
 
         ( $name, $cmp, $val ) = ( $1, $2, $3 )
             if $name =~ /^(.*?)($cmp_re)(.*)$/;
-        $name =~ s/^--//;
+        $name =~ s/^(?:--|-)//;
 
         # no value specified, pull it from the next argument, unless the next
         # argument is another option
         if ( !defined($val) ) {
             $val = shift @args
-                if @args && $args[0] !~ /^--/;
+                if @args && $args[0] !~ /^-/;
 
             no warnings 'uninitialized';
 

commit effe27cf708f7c9cf1aeb843d14acc04f76bb1cf
Author: Christine Spang <spang at bestpractical.com>
Date:   Fri Jan 30 11:49:13 2009 +0200

    put the long regex to match ids into a constant

diff --git a/lib/Prophet/CLIContext.pm b/lib/Prophet/CLIContext.pm
index 9c497b2..72a5e87 100644
--- a/lib/Prophet/CLIContext.pm
+++ b/lib/Prophet/CLIContext.pm
@@ -124,12 +124,19 @@ sub mutate_attributes {
 
 =head2 cmp_regex
 
-Returns the regex to use for matching property key/value separators.
+The regex to use for matching property key/value separators.
 
 =cut
 
-sub cmp_regex { '!=|<>|=~|!~|=|\bne\b' }
+use constant cmp_regex => '!=|<>|=~|!~|=|\bne\b';
 
+=head2 id_regex
+
+The regex to use for matching the id argument (luid / uuid).
+
+=cut
+
+use constant id_regex => '^(?:\d+|[0-9a-f]{8}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{12})$';
 
 =head2 setup_from_args
 
@@ -187,8 +194,8 @@ sub parse_args {
     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 ) if @primary && $primary[-1] =~
-        /^(?:\d+|[0-9a-f]{8}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{12})$/i;
+    my $id_re = $self->id_regex;
+    $self->set_arg( id => pop @primary ) if @primary && $primary[-1] =~ /$id_re/i;
 
     my $collecting_props = 0;
 

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list