[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