[Bps-public-commit] r15414 - in Prophet/trunk/lib/Prophet: CLI
jesse at bestpractical.com
jesse at bestpractical.com
Sun Aug 24 18:54:40 EDT 2008
Author: jesse
Date: Sun Aug 24 18:54:39 2008
New Revision: 15414
Added:
Prophet/trunk/lib/Prophet/CLIContext.pm
Modified:
Prophet/trunk/lib/Prophet/CLI.pm
Prophet/trunk/lib/Prophet/CLI/Command.pm
Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm
Log:
* Add a "CLI Context" object to handle args, props, uuid and types
Modified: Prophet/trunk/lib/Prophet/CLI.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI.pm (original)
+++ Prophet/trunk/lib/Prophet/CLI.pm Sun Aug 24 18:54:39 2008
@@ -5,6 +5,7 @@
use Prophet;
use Prophet::Replica;
use Prophet::CLI::Command;
+use Prophet::CLIContext;
use List::Util 'first';
@@ -31,73 +32,17 @@
},
);
-has uuid => (
- is => 'rw',
- isa => 'Str',
- predicate => 'has_uuid',
- documentation => "This is the uuid set by the user from the commandline",
-);
-
-has type => (
- is => 'rw',
- isa => 'Str',
- documentation => "This is the type set by the user from the commandline",
-);
-
-has primary_commands => (
- is => 'rw',
- isa => 'ArrayRef',
- documentation => "The commands the user executes from the commandline",
-);
-
-has args => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => 'HashRef',
- default => sub { {} },
- provides => {
- set => 'set_arg',
- get => 'arg',
- exists => 'has_arg',
- delete => 'delete_arg',
- keys => 'arg_names',
- clear => 'clear_args',
- },
- documentation => "This is a reference to the key-value pairs passed in on the commandline",
-);
-has props => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => 'HashRef',
- default => sub { {} },
- provides => {
- set => 'set_prop',
- get => 'prop',
- exists => 'has_prop',
- delete => 'delete_prop',
- keys => 'prop_names',
- clear => 'clear_props',
- },
-);
-
-# clear the prop_set too!
-after clear_props => sub { my $self = shift; $self->prop_set( ( ) ); };
+has context => (
+ is => 'rw',
+ isa => 'Prophet::CLIContext',
+ handles => [qw/has_arg set_arg arg delete_arg arg_hash prop_get set_prop prop_set prop_names props/],
+ lazy => 1,
+ default => sub {
+ return Prophet::CLIContext->new( app_handle => shift->app_handle);
+ }
-has prop_set => (
- metaclass => 'Collection::Array',
- is => 'rw',
- isa => 'ArrayRef',
- default => sub { [] },
- auto_deref => 1,
- provides => {
- push => 'add_to_prop_set',
- },
);
-after add_to_prop_set => sub {
- my $self = shift; my $args = shift; $self->set_prop($args->{prop} => $args->{value})
-};
-
has interactive_shell => (
is => 'rw',
@@ -106,7 +51,6 @@
);
-
=head2 _record_cmd
handles the subcommand for a particular type
@@ -141,7 +85,7 @@
my $self = shift;
my $aliases = $self->config->aliases;
- my $tmp = $self->primary_commands;
+ my $tmp = $self->context->primary_commands;
if (@$tmp && $aliases->{$tmp->[0]}) {
@ARGV = split ' ', $aliases->{$tmp->[0]};
return $self->run_one_command;
@@ -183,12 +127,13 @@
my $class = first { $self->_try_to_load_cmd_class($_) }
@possible_classes, @extreme_fallback_commands;
- die "I don't know how to parse '" . join( " ", @{ $self->primary_commands } ) . "'. Are you sure that's a valid command?" unless ($class);
+ die "I don't know how to parse '" . join( " ", @{ $self->context->primary_commands } ) . "'. Are you sure that's a valid command?" unless ($class);
my %constructor_args = (
cli => $self,
- commands => $self->primary_commands,
- type => $self->type,
+ context => $self->context,
+ commands => $self->context->primary_commands,
+ type => $self->context->type,
);
# undef causes type constraint violations
@@ -197,8 +142,8 @@
if !defined($constructor_args{$key});
}
- $constructor_args{uuid} = $self->uuid
- if $self->has_uuid;
+ $constructor_args{uuid} = $self->context->uuid
+ if $self->context->has_uuid;
return $class->new(%constructor_args);
}
@@ -225,129 +170,6 @@
return undef;
}
-=head2 cmp_regex
-
-Returns the regex to use for matching property key/value separators.
-
-=cut
-
-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.
-
-If a key is not given a value on the command line, its value is set to undef.
-
-More complicated separators such as =~ (for regexes) are also handled (see
-L</cmp_regex> for details).
-
-=cut
-
-sub parse_args {
- my $self = shift;
-
- my @primary;
- push @primary, shift @ARGV while ( $ARGV[0] && $ARGV[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}\-)/i;
-
- my $collecting_props = 0;
-
- $self->primary_commands( \@primary );
- my $cmp_re = $self->cmp_regex;
-
- while (my $name = shift @ARGV) {
- die "$name doesn't look like --argument"
- if !$collecting_props && $name !~ /^--/;
-
- if ($name eq '--' || $name eq '--props') {
- $collecting_props = 1;
- next;
- }
-
- my $cmp = '=';
- my $val;
-
- ($name, $cmp, $val) = ($1, $2, $3)
- if $name =~ /^(.*?)($cmp_re)(.*)$/;
- $name =~ s/^--//;
-
- # 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] !~ /^--/;
-
- 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] !~ /^--/) {
- $cmp = $val;
- $val = shift @ARGV;
- }
- else {
- # perhaps they said "foo =~bar"..
- $cmp = $1 if $val =~ s/^($cmp_re)//;
- }
- }
- }
-
- if ($collecting_props) {
- $self->add_to_prop_set({
- prop => $name,
- cmp => $cmp,
- value => $val,
- });
- }
- else {
- $self->set_arg($name => $val);
- }
- }
-}
-
-=head2 set_type_and_uuid
-
-When working with individual records, it is often the case that we'll be
-expecting a --type argument and then a mess of other key-value pairs.
-
-This routine figures out and sets C<type> and C<uuid> from the arguments given
-on the command-line, if possible. Being unable to figure out a uuid is fatal.
-
-=cut
-
-sub set_type_and_uuid {
- my $self = shift;
-
- if (my $id = $self->delete_arg('id')) {
- if ($id =~ /^(\d+)$/) {
- $self->set_arg(luid => $id);
- } else {
- $self->set_arg(uuid => $id);
- }
- }
-
- if ( my $uuid = $self->delete_arg('uuid')) {
- $self->uuid($uuid);
- }
- elsif ( my $luid = $self->delete_arg('luid')) {
- my $uuid = $self->handle->find_uuid_by_luid(luid => $luid);
- die "I have no UUID mapped to the local id '$luid'\n" if !defined($uuid);
- $self->uuid($uuid);
- }
- if ( my $type = $self->delete_arg('type') ) {
- $self->type($type);
- } elsif($self->primary_commands->[-2]) {
- $self->type($self->primary_commands->[-2]);
- }
-}
=head2 run_one_command
@@ -364,60 +186,17 @@
sub run_one_command {
my $self = shift;
- { # really, we shouldn't be doing this stuff from the command dispatcher
- $self->type('');
- $self->clear_args();
- $self->clear_props();
- }
+ # really, we shouldn't be doing this stuff from the command dispatcher
+ $self->context(Prophet::CLIContext->new( app_handle => $self->app_handle));
+
- $self->parse_args();
- $self->set_type_and_uuid();
+ $self->context->parse_args();
+ $self->context->set_type_and_uuid();
if ( my $cmd_obj = $self->_get_cmd_obj() ) {
$cmd_obj->run();
}
}
-=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.
-
-If C<type>, C<uuid>, or C<primary_commands> are not passed in, the values
-from the previous command run are used.
-
-=cut
-
-sub mutate_attributes {
- my $self = shift;
- my %args = @_;
-
- $self->clear_args();
- $self->clear_props();
-
- if (my $cmd_args = $args{args}) {
- foreach my $arg (keys %$cmd_args) {
- if ($arg eq 'uuid') {
- $self->uuid($cmd_args->{$arg});
- }
- $self->set_arg($arg => $cmd_args->{$arg});
- }
- }
- if (my $props = $args{props}) {
- foreach my $prop (@$props) {
- my $key = $prop->{prop};
- my $value = $prop->{value};
- $self->set_prop($key => $value);
- }
- }
- if (my $type = $args{type}) {
- $self->type($type);
- }
-
- if (my $primary_commands = $args{primary_commands}) {
- $self->primary_commands($primary_commands);
- }
-}
-
=head2 invoke [outhandle], ARGV
Run the given command. If outhandle is true, select that as the file handle
Modified: Prophet/trunk/lib/Prophet/CLI/Command.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI/Command.pm (original)
+++ Prophet/trunk/lib/Prophet/CLI/Command.pm Sun Aug 24 18:54:39 2008
@@ -15,6 +15,17 @@
],
);
+has context => (
+ is => 'rw',
+ isa => 'Prophet::CLIContext',
+ lazy => 1,
+ default => sub {
+ return Prophet::CLIContext->new( app_handle => shift->app_handle);
+ }
+
+);
+
+
sub fatal_error {
my $self = shift;
my $reason = shift;
Modified: Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm (original)
+++ Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm Sun Aug 24 18:54:39 2008
@@ -12,7 +12,7 @@
my @args;
push @args, '--recursive';
- push @args, '--verbose' if $self->has_arg('verbose');
+ push @args, '--verbose' if $self->context->has_arg('verbose');
push @args, '--';
Added: Prophet/trunk/lib/Prophet/CLIContext.pm
==============================================================================
--- (empty file)
+++ Prophet/trunk/lib/Prophet/CLIContext.pm Sun Aug 24 18:54:39 2008
@@ -0,0 +1,252 @@
+package Prophet::CLIContext;
+use Moose;
+use MooseX::ClassAttribute;
+
+has app_handle => (
+ is => 'rw',
+ isa => 'Prophet::App',
+ lazy => 1,
+ handles => [qw/handle resdb_handle config/],
+ weak_ref => 1,
+ default => sub {
+ return $_[0]->app_class->new;
+ },
+);
+
+has uuid => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_uuid',
+ documentation => "This is the uuid set by the user from the commandline",
+);
+
+has type => (
+ is => 'rw',
+ isa => 'Str',
+ documentation => "This is the type set by the user from the commandline",
+);
+
+has args => (
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => 'HashRef',
+ default => sub { {} },
+ provides => {
+ set => 'set_arg',
+ get => 'arg',
+ exists => 'has_arg',
+ delete => 'delete_arg',
+ keys => 'arg_names',
+ clear => 'clear_args',
+ },
+ documentation =>
+ "This is a reference to the key-value pairs passed in on the commandline",
+);
+
+has props => (
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => 'HashRef',
+ default => sub { {} },
+ provides => {
+ set => 'set_prop',
+ get => 'prop',
+ exists => 'has_prop',
+ delete => 'delete_prop',
+ keys => 'prop_names',
+ clear => 'clear_props',
+ },
+);
+
+# clear the prop_set too!
+after clear_props => sub { my $self = shift; $self->prop_set( () ); };
+
+has prop_set => (
+ metaclass => 'Collection::Array',
+ is => 'rw',
+ isa => 'ArrayRef',
+ default => sub { [] },
+ auto_deref => 1,
+ provides => { push => 'add_to_prop_set', },
+);
+after add_to_prop_set => sub {
+ my $self = shift;
+ my $args = shift;
+ $self->set_prop( $args->{prop} => $args->{value} );
+};
+
+has primary_commands => (
+ is => 'rw',
+ isa => 'ArrayRef',
+ documentation => "The commands the user executes from the commandline",
+);
+
+=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.
+
+If C<type>, C<uuid>, or C<primary_commands> are not passed in, the values
+from the previous command run are used.
+
+=cut
+
+sub mutate_attributes {
+ my $self = shift;
+ my %args = @_;
+
+ $self->clear_args();
+ $self->clear_props();
+
+ if ( my $cmd_args = $args{args} ) {
+ foreach my $arg ( keys %$cmd_args ) {
+ if ( $arg eq 'uuid' ) {
+ $self->uuid( $cmd_args->{$arg} );
+ }
+ $self->set_arg( $arg => $cmd_args->{$arg} );
+ }
+ }
+ if ( my $props = $args{props} ) {
+ foreach my $prop (@$props) {
+ my $key = $prop->{prop};
+ my $value = $prop->{value};
+ $self->set_prop( $key => $value );
+ }
+ }
+ if ( my $type = $args{type} ) {
+ $self->type($type);
+ }
+
+ if ( my $primary_commands = $args{ $self->primary_commands } ) {
+ $self->primary_commands( $primary_commands );
+ }
+}
+
+=head2 cmp_regex
+
+Returns the regex to use for matching property key/value separators.
+
+=cut
+
+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.
+
+If a key is not given a value on the command line, its value is set to undef.
+
+More complicated separators such as =~ (for regexes) are also handled (see
+L</cmp_regex> for details).
+
+=cut
+
+sub parse_args {
+ my $self = shift;
+
+ my @primary;
+ push @primary, shift @ARGV while ( $ARGV[0] && $ARGV[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}\-)/i;
+
+ my $collecting_props = 0;
+
+ $self->primary_commands( \@primary );
+ my $cmp_re = $self->cmp_regex;
+
+ while ( my $name = shift @ARGV ) {
+ die "$name doesn't look like --argument"
+ if !$collecting_props && $name !~ /^--/;
+
+ if ( $name eq '--' || $name eq '--props' ) {
+ $collecting_props = 1;
+ next;
+ }
+
+ my $cmp = '=';
+ my $val;
+
+ ( $name, $cmp, $val ) = ( $1, $2, $3 )
+ if $name =~ /^(.*?)($cmp_re)(.*)$/;
+ $name =~ s/^--//;
+
+ # 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] !~ /^--/;
+
+ 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] !~ /^--/ ) {
+ $cmp = $val;
+ $val = shift @ARGV;
+ } else {
+
+ # perhaps they said "foo =~bar"..
+ $cmp = $1 if $val =~ s/^($cmp_re)//;
+ }
+ }
+ }
+
+ if ($collecting_props) {
+ $self->add_to_prop_set(
+ { prop => $name,
+ cmp => $cmp,
+ value => $val,
+ }
+ );
+ } else {
+ $self->set_arg( $name => $val );
+ }
+ }
+}
+
+=head2 set_type_and_uuid
+
+When working with individual records, it is often the case that we'll be
+expecting a --type argument and then a mess of other key-value pairs.
+
+This routine figures out and sets C<type> and C<uuid> from the arguments given
+on the command-line, if possible. Being unable to figure out a uuid is fatal.
+
+=cut
+
+sub set_type_and_uuid {
+ my $self = shift;
+
+ if ( my $id = $self->delete_arg('id') ) {
+ if ( $id =~ /^(\d+)$/ ) {
+ $self->set_arg( luid => $id );
+ } else {
+ $self->set_arg( uuid => $id );
+ }
+ }
+
+ if ( my $uuid = $self->delete_arg('uuid') ) {
+ $self->uuid($uuid);
+ } elsif ( my $luid = $self->delete_arg('luid') ) {
+ my $uuid = $self->handle->find_uuid_by_luid( luid => $luid );
+ die "I have no UUID mapped to the local id '$luid'\n"
+ if !defined($uuid);
+ $self->uuid($uuid);
+ }
+ if ( my $type = $self->delete_arg('type') ) {
+ $self->type($type);
+ } elsif ( $self->primary_commands->[-2] ) {
+ $self->type( $self->primary_commands->[-2] );
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
More information about the Bps-public-commit
mailing list