[Bps-public-commit] r16764 - in Prophet/trunk: . lib/Prophet/CLI lib/Prophet/CLI/Command lib/Prophet/Replica lib/Prophet/Replica/svn
sartak at bestpractical.com
sartak at bestpractical.com
Sat Nov 8 03:19:30 EST 2008
Author: sartak
Date: Sat Nov 8 03:19:30 2008
New Revision: 16764
Added:
Prophet/trunk/lib/Prophet/CLI/Parameters.pm
Removed:
Prophet/trunk/lib/Prophet/CLI/Command/NotFound.pm
Modified:
Prophet/trunk/ (props changed)
Prophet/trunk/lib/Prophet/App.pm
Prophet/trunk/lib/Prophet/CLI.pm
Prophet/trunk/lib/Prophet/CLI/Dispatcher.pm
Prophet/trunk/lib/Prophet/CLIContext.pm
Prophet/trunk/lib/Prophet/Change.pm
Prophet/trunk/lib/Prophet/Config.pm
Prophet/trunk/lib/Prophet/Replica.pm
Prophet/trunk/lib/Prophet/Replica/prophet.pm
Prophet/trunk/lib/Prophet/Replica/svn/Util.pm
Prophet/trunk/lib/Prophet/Test.pm
Log:
r75206 at onn: sartak | 2008-11-08 03:18:47 -0500
Revert mismerge
Modified: Prophet/trunk/lib/Prophet/App.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/App.pm (original)
+++ Prophet/trunk/lib/Prophet/App.pm Sat Nov 8 03:19:30 2008
@@ -46,6 +46,18 @@
Prophet::App
+=head1 SYNOPSIS
+
+=head1 METHODS
+
+=head2 BUILD
+
+=cut
+
+=head2 default_replica_type
+
+Returns a string of the the default replica type for this application.
+
=cut
sub default_replica_type {
@@ -53,18 +65,29 @@
return $ENV{'PROPHET_REPLICA_TYPE'} || DEFAULT_REPLICA_TYPE;
}
+=head2 require
+
+=cut
+
sub require {
my $self = shift;
my $class = shift;
$self->_require(module => $class);
}
+=head2 try_to_require
+
+=cut
+
sub try_to_require {
my $self = shift;
my $class = shift;
$self->_require(module => $class, quiet => 1);
}
+=head2 _require
+
+=cut
sub _require {
my $self = shift;
Modified: Prophet/trunk/lib/Prophet/CLI.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI.pm (original)
+++ Prophet/trunk/lib/Prophet/CLI.pm Sat Nov 8 03:19:30 2008
@@ -47,7 +47,7 @@
has interactive_shell => (
is => 'rw',
isa => 'Bool',
- default => sub { 0}
+ default => 0,
);
@@ -57,78 +57,14 @@
=cut
-=head2 dispatcher -> Class
+=head2 dispatcher_class -> Class
Returns the dispatcher used to dispatch command lines. You'll want to override
this in your subclass.
=cut
-sub dispatcher { "Prophet::CLI::Dispatcher" }
-
-=head2 _get_cmd_obj
-
-Attempts to determine a command object based on aliases and the currently
-set commands, arguments, and properties. Returns the class on success;
-dies on failure.
-
-This routine will use a C<CLI::Command::Shell> class if no arguments are
-specified.
-
-This routine will use a C<CLI::Command::NotFound> class as a last resort, so
-failure should occur rarely if ever.
-
-=cut
-
-sub _get_cmd_obj {
- my $self = shift;
-
- my $command = join ' ', @{ $self->context->primary_commands };
-
- # yeah this kind of sucks but there's no sane way to tell
- my $class;
- my %dispatcher_args = (
- cli => $self,
- context => $self->context,
- got_command => sub { $class = shift },
- dispatching_on => $self->context->primary_commands,
- );
-
- $self->dispatcher->run($command, %dispatcher_args);
- 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,
- context => $self->context,
- commands => $self->context->primary_commands,
- type => $self->context->type,
- );
-
- # undef causes type constraint violations
- for my $key (keys %constructor_args) {
- delete $constructor_args{$key}
- if !defined($constructor_args{$key});
- }
-
- $constructor_args{uuid} = $self->context->uuid
- if $self->context->has_uuid;
-
- return $class->new(%constructor_args);
-}
-
-sub _try_to_load_cmd_class {
- my $self = shift;
- my $class = shift;
- Prophet::App->try_to_require($class);
- return $class if $class->isa('Prophet::CLI::Command');
-
- warn "Invalid class $class - not a subclass of Prophet::CLI::Command."
- if $class !~ /::$/ # don't warn about "Prophet::CLI::Command::" (which happens on "./bin/sd")
- && Prophet::App->already_required($class);
-
- return undef;
-}
-
+sub dispatcher_class { "Prophet::CLI::Dispatcher" }
=head2 run_one_command
@@ -150,11 +86,17 @@
# really, we shouldn't be doing this stuff from the command dispatcher
- $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();
- }
+ $self->context(Prophet::CLIContext->new(app_handle => $self->app_handle));
+ $self->context->setup_from_args(@args);
+
+ my $dispatcher = $self->dispatcher_class->new(cli => $self);
+
+ my $command = join ' ', @{ $self->context->primary_commands };
+ my $dispatch = $dispatcher->dispatch($command);
+
+ die "The command you ran, '$command', could not be found. Perhaps running '$0 help' would help?\n" unless $dispatch->has_matches;
+
+ $dispatch->run($dispatcher);
}
=head2 invoke outhandle, ARGV_COMPATIBLE_ARRAY
@@ -181,6 +123,7 @@
__PACKAGE__->meta->make_immutable;
no Moose;
+no MooseX::ClassAttribute;
1;
Modified: Prophet/trunk/lib/Prophet/CLI/Dispatcher.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI/Dispatcher.pm (original)
+++ Prophet/trunk/lib/Prophet/CLI/Dispatcher.pm Sat Nov 8 03:19:30 2008
@@ -1,70 +1,91 @@
package Prophet::CLI::Dispatcher;
-use strict;
-use warnings;
use Path::Dispatcher::Declarative -base;
+use Moose;
+with 'Prophet::CLI::Parameters';
# "ticket display $ID" -> "ticket display --id=$ID"
-on qr{ (.*) \s+ ( \d+ | [A-Z0-9]{36} ) $ }x => sub {
- my %args = @_;
- $args{cli}->set_arg(id => $2);
- run($1, %args);
+on qr{^ (.*) \s+ ( \d+ | [A-Z0-9]{36} ) $ }x => sub {
+ my $self = shift;
+ $self->context->set_arg(id => $2);
+ run($1, $self, @_);
};
-on qr{^(\w+)} => sub {
- my %args = @_;
+on [ ['create', 'new'] ] => run_command("Create");
+on [ ['show', 'display'] ] => run_command("Show");
+on [ ['update', 'edit'] ] => run_command("Update");
+on [ ['delete', 'del', 'rm'] ] => run_command("Delete");
+on [ ['search', 'list', 'ls' ] ] => run_command("Search");
+
+on merge => run_command("Merge");
+on pull => run_command("Pull");
+on publish => run_command("Publish");
+on server => run_command("Server");
+on config => run_command("Config");
+on settings => run_command("Settings");
+on log => run_command("Log");
+on shell => run_command("Shell");
- my $cmd = __PACKAGE__->resolve_builtin_aliases($1);
+on export => sub {
+ my $self = shift;
+ $self->cli->handle->export_to(path => $self->context->arg('path'));
+};
- my @possible_classes = (
- ("Prophet::CLI::Command::" . ucfirst lc $cmd),
- "Prophet::CLI::Command::NotFound",
- );
+on push => sub {
+ my $self = shift;
- my $cli = $args{cli};
+ die "Please specify a --to.\n" if !$self->context->has_arg('to');
- for my $class (@possible_classes) {
- if ($cli->_try_to_load_cmd_class($class)) {
- return $args{got_command}->($class);
- }
- }
+ $self->context->set_arg(from => $self->cli->app_handle->default_replica_type.":file://".$self->cli->handle->fs_root);
+ $self->context->set_arg(db_uuid => $self->cli->handle->db_uuid);
+ run('merge', $self, @_);
};
-on qr{^\s*$} => sub {
- run(__PACKAGE__->default_command, @_);
+on history => sub {
+ my $self = shift;
+ $self->context->require_uuid;
+ my $record = $self->context->_load_record;
+ $self->record($record);
+ print $record->history_as_string;
};
-my %CMD_MAP = (
- ls => 'search',
- new => 'create',
- edit => 'update',
- rm => 'delete',
- del => 'delete',
- list => 'search',
- display => 'show',
-);
-
-sub resolve_builtin_aliases {
- my $self = shift;
- my @cmds = @_;
+sub run_command {
+ my $name = shift;
- if (my $replacement = $CMD_MAP{ lc $cmds[-1] }) {
- $cmds[-1] = $replacement;
- }
+ return sub {
+ my $self = shift;
- @cmds = map { ucfirst lc } @cmds;
+ my %constructor_args = (
+ cli => $self->cli,
+ context => $self->context,
+ commands => $self->context->primary_commands,
+ type => $self->context->type,
+ uuid => $self->context->uuid,
+ );
+
+ # undef causes type constraint violations
+ for my $key (keys %constructor_args) {
+ delete $constructor_args{$key}
+ if !defined($constructor_args{$key});
+ }
- return wantarray ? @cmds : $cmds[-1];
+ my @classes = $self->class_names($name);
+ for my $class (@classes) {
+ Prophet::App->try_to_require($class) or next;
+ $class->new(%constructor_args)->run;
+ last;
+ }
+ };
}
-=head2 default_command
-
-Returns the "default" command for use when no arguments were specified on the
-command line. In Prophet, it's "shell" but your subclass can change that.
-
-=cut
+sub class_names {
+ my $self = shift;
+ my $command = shift;
+ return "Prophet::CLI::Command::$command";
+}
-sub default_command { "shell" }
+__PACKAGE__->meta->make_immutable;
+no Moose;
1;
Added: Prophet/trunk/lib/Prophet/CLI/Parameters.pm
==============================================================================
--- (empty file)
+++ Prophet/trunk/lib/Prophet/CLI/Parameters.pm Sat Nov 8 03:19:30 2008
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+package Prophet::CLI::Parameters;
+use Moose::Role;
+
+has cli => (
+ is => 'rw',
+ isa => 'Prophet::CLI',
+ required => 1,
+);
+
+has context => (
+ is => 'rw',
+ isa => 'Prophet::CLIContext',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ $self->cli->context;
+ },
+);
+
+no Moose::Role;
+
+1;
+
Modified: Prophet/trunk/lib/Prophet/CLIContext.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLIContext.pm (original)
+++ Prophet/trunk/lib/Prophet/CLIContext.pm Sat Nov 8 03:19:30 2008
@@ -266,5 +266,6 @@
__PACKAGE__->meta->make_immutable;
no Moose;
+no MooseX::ClassAttribute;
1;
Modified: Prophet/trunk/lib/Prophet/Change.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Change.pm (original)
+++ Prophet/trunk/lib/Prophet/Change.pm Sat Nov 8 03:19:30 2008
@@ -135,8 +135,7 @@
return {
record_type => $self->record_type,
change_type => $self->change_type,
- prop_changes => $props
-
+ prop_changes => $props,
};
}
@@ -181,8 +180,11 @@
my $class = shift;
my $uuid = shift;
my $hashref = shift;
- my $self = $class->new(
- { record_type => $hashref->{'record_type'}, record_uuid => $uuid, change_type => $hashref->{'change_type'} } );
+ my $self = $class->new( {
+ record_type => $hashref->{'record_type'},
+ record_uuid => $uuid,
+ change_type => $hashref->{'change_type'},
+ } );
for my $prop ( keys %{ $hashref->{'prop_changes'} } ) {
$self->add_prop_change(
name => $prop,
Modified: Prophet/trunk/lib/Prophet/Config.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Config.pm (original)
+++ Prophet/trunk/lib/Prophet/Config.pm Sat Nov 8 03:19:30 2008
@@ -1,15 +1,16 @@
package Prophet::Config;
use Moose;
use MooseX::AttributeHelpers;
+use File::Spec;
use Path::Class;
-
has app_handle => (
is => 'ro',
weak_ref => 1,
isa => 'Prophet::App',
required => 0
);
+
has config_files => (
is => 'rw',
isa => 'ArrayRef' ,
@@ -33,10 +34,15 @@
return $_[0]->config->{_aliases};
}
-sub app_config_file {
+sub app_config_file {
my $self = shift;
- $ENV{'PROPHET_APP_CONFIG'} || file( $self->app_handle->handle->fs_root => "prophetrc" ) ;
+ return $self->file_if_exists($ENV{'PROPHET_APP_CONFIG'})
+ || $self->file_if_exists(
+ File::Spec->catfile(
+ $self->app_handle->handle->fs_root => 'prophetrc' ))
+ || $self->file_if_exists(
+ File::Spec->catfile( $ENV{'HOME'} => '.prophetrc' ));
}
#my $singleton;
@@ -82,6 +88,20 @@
return defined($friendly) ? $friendly : $uuid;
}
+=head2 file_if_exists FILENAME
+
+Returns the given filename if it exists on the filesystem, and an
+empty string otherwise.
+
+=cut
+
+sub file_if_exists {
+ my $self = shift;
+ my $file = shift || ''; # quiet warnings
+
+ return (-e $file) ? $file : '';
+}
+
__PACKAGE__->meta->make_immutable;
no Moose;
@@ -95,14 +115,15 @@
=head1 SYNOPSIS
- In ~/.prophetrc:
+ In the Prophet config file (see L</app_config_file>):
- prefer_luids: 1
+ prefer_luids: 1
+ summary_format_ticket = %4s },$luid | %-11.11s,status | %-70.70s,summary
=head1 DESCRIPTION
-This class represents configuration of Prophet and the application built on top
-of it.
+This class represents the configuration of Prophet and the application built on
+top of it.
=head1 METHODS
@@ -114,8 +135,9 @@
=head2 app_config_file
-The file which controls configuration for this application.
-C<$PROPHET_REPO/prophetrc>.
+The file which controls configuration for this application
+(the $PROPHET_APP_CONFIG environmental variable, C<$PROPHET_REPO/prophetrc>,
+or C<$HOME/.prophetrc>, in that order).
=head2 load_from_files [files]
@@ -136,7 +158,7 @@
=head2 list
-List all configuration options
+Lists all configuration options.
=head2 display_name_for_uuid UUID
Modified: Prophet/trunk/lib/Prophet/Replica.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica.pm (original)
+++ Prophet/trunk/lib/Prophet/Replica.pm Sat Nov 8 03:19:30 2008
@@ -467,7 +467,10 @@
$self->traverse_changesets(
after => $args{for}->last_changeset_from_source( $self->uuid ),
- callback => sub { $args{callback}->( $_[0] ) if $self->should_send_changeset( changeset => $_[0], to => $args{for});
+ callback => sub {
+ $args{callback}->( $_[0] ) if $self->should_send_changeset(
+ changeset => $_[0], to => $args{for}
+ );
}
);
}
Modified: Prophet/trunk/lib/Prophet/Replica/prophet.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica/prophet.pm (original)
+++ Prophet/trunk/lib/Prophet/Replica/prophet.pm Sat Nov 8 03:19:30 2008
@@ -639,8 +639,8 @@
$self->log("Traversing changesets between $first_rev and $latest");
for my $rev ( $first_rev .. $latest ) {
my $changeset = $self->_get_changeset_index_entry(
- sequence_no => $rev,
- index_file => $chgidx
+ sequence_no => $rev,
+ index_file => $chgidx
);
$args{callback}->($changeset);
Modified: Prophet/trunk/lib/Prophet/Replica/svn/Util.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica/svn/Util.pm (original)
+++ Prophet/trunk/lib/Prophet/Replica/svn/Util.pm Sat Nov 8 03:19:30 2008
@@ -193,5 +193,6 @@
__PACKAGE__->meta->make_immutable;
no Moose;
+no MooseX::ClassAttribute;
1;
Modified: Prophet/trunk/lib/Prophet/Test.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Test.pm (original)
+++ Prophet/trunk/lib/Prophet/Test.pm Sat Nov 8 03:19:30 2008
@@ -127,6 +127,15 @@
};
}
+=head2 _mk_cmp_closure EXPECTED, ERROR
+
+Takes references to an array of expected output lines and an array of
+error messages. Returns a subroutine that takes a list
+of output lines and compares them to its expected output lines,
+storing error messages for lines that don't match in ERROR.
+
+=cut
+
sub _mk_cmp_closure {
my ( $exp, $err ) = @_;
my $line = 0;
@@ -149,14 +158,6 @@
}
}
-=head2 is_script_output SCRIPTNAME \@ARGS, \@STDOUT_MATCH, \@STDERR_MATCH, $MSG
-
-Runs the script, checking to see that its output matches
-
-
-
-=cut
-
our $RUNCNT;
sub _get_perl_cmd {
@@ -173,6 +174,13 @@
return @cmd;
}
+=head2 is_script_output SCRIPTNAME \@ARGS, \@STDOUT_MATCH, \@STDERR_MATCH, $MSG
+
+Runs the script, checking to see that its output matches. Error messages
+for lines that don't match are stored in C<\@STDOUT_MATCH>.
+
+=cut
+
sub is_script_output {
my ( $script, $arg, $exp_stdout, $exp_stderr, $msg ) = @_;
@@ -183,7 +191,7 @@
my @cmd = _get_perl_cmd($script);
my $ret = run3 [ @cmd, @$arg ], undef, _mk_cmp_closure( $exp_stdout, $stdout_err ), # stdout
- _mk_cmp_closure( $exp_stderr, $stdout_err ); # stderr
+ _mk_cmp_closure( $exp_stderr, $stdout_err ); # stderr
for my $line(@$exp_stdout) {
next if !defined $line;
@@ -193,7 +201,7 @@
my $test_name = join( ' ', $msg ? "$msg:" : '', $script, @$arg );
is(scalar(@$stdout_err), 0, $test_name);
if (@$stdout_err) {
- diag( "Different in line: " . join( ',', @$stdout_err ) );
+ diag( "Different in line: " . join( "\n", @$stdout_err ) );
}
}
More information about the Bps-public-commit
mailing list