[Bps-public-commit] r11388 - in SVN-PropDB: . bin lib/Prophet lib/Prophet/Test
jesse at bestpractical.com
jesse at bestpractical.com
Wed Apr 2 06:27:16 EDT 2008
Author: jesse
Date: Wed Apr 2 06:27:16 2008
New Revision: 11388
Added:
SVN-PropDB/bin/prophet (contents, props changed)
Modified:
SVN-PropDB/ (props changed)
SVN-PropDB/lib/Prophet/CLI.pm
SVN-PropDB/lib/Prophet/Sync/Source.pm
SVN-PropDB/lib/Prophet/Test.pm
SVN-PropDB/lib/Prophet/Test/Participant.pm
Log:
r28984 at 31b: jesse | 2008-04-02 00:27:01 -1000
* create a single master 'prophet' command. move all the logic to CLI.pm. Update chicken tests to use the cli object rather than spawning
Added: SVN-PropDB/bin/prophet
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/prophet Wed Apr 2 06:27:16 2008
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Prophet::CLI;
+my $cli = Prophet::CLI->new();
+my $cmd = shift @ARGV;
+$cli->parse_record_cmd_args();
+
+if (my $sub = $cli->can('do_'.$cmd)) {
+ $sub->($cli);
+ } else {
+ die "I don't know how to do the $cmd";
+ }
+
+
+
Modified: SVN-PropDB/lib/Prophet/CLI.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/CLI.pm (original)
+++ SVN-PropDB/lib/Prophet/CLI.pm Wed Apr 2 06:27:16 2008
@@ -10,11 +10,13 @@
use Prophet::Handle;
use Prophet::Record;
use Prophet::Collection;
+use Prophet::Sync::Source;
sub new {
my $class = shift;
- my $self = $class->SUPER::new(@_);
- $self->handle; $self->resdb_handle;
+ my $self = $class->SUPER::new(@_);
+ $self->handle;
+ $self->resdb_handle;
return $self;
}
@@ -25,27 +27,24 @@
sub handle {
my $self = shift;
- unless ($self->_handle) {
- my $root = $ENV{'PROPHET_REPO'} || dir($ENV{'HOME'},'.prophet');
- my $path = $ENV{'PROPHET_REPO_PATH'} ||'_prophet';
- $self->_handle( Prophet::Handle->new( repository => $root, db_root => $path ));
+ unless ( $self->_handle ) {
+ my $root = $ENV{'PROPHET_REPO'} || dir( $ENV{'HOME'}, '.prophet' );
+ my $path = $ENV{'PROPHET_REPO_PATH'} || '_prophet';
+ $self->_handle( Prophet::Handle->new( repository => $root, db_root => $path ) );
}
return $self->_handle();
}
-
sub resdb_handle {
my $self = shift;
- unless ($self->_resdb_handle) {
- my $root = ($ENV{'PROPHET_REPO'} || dir($ENV{'HOME'},'.prophet'))."_res";
- my $path = $ENV{'PROPHET_REPO_PATH'} ||'_prophet';
- $self->_resdb_handle( Prophet::Handle->new( repository => $root, db_root => $path ));
+ unless ( $self->_resdb_handle ) {
+ my $root = ( $ENV{'PROPHET_REPO'} || dir( $ENV{'HOME'}, '.prophet' ) ) . "_res";
+ my $path = $ENV{'PROPHET_REPO_PATH'} || '_prophet';
+ $self->_resdb_handle( Prophet::Handle->new( repository => $root, db_root => $path ) );
}
return $self->_resdb_handle();
}
-
-
=head2 parse_args
This routine pulls arguments passed on the command line out of ARGV and sticks them in L</args>. The keys have leading "--" stripped.
@@ -55,8 +54,8 @@
sub parse_args {
my $self = shift;
- %{$self->{'args'}} = @ARGV;
- for my $name ( keys %{$self->{'args'}} ) {
+ %{ $self->{'args'} } = @ARGV;
+ for my $name ( keys %{ $self->{'args'} } ) {
die "$name doesn't look like --prop-name" if ( $name !~ /^--/ );
$name =~ /^--(.*)$/;
$self->{args}->{$1} = delete $self->{'args'}->{$name};
@@ -75,12 +74,10 @@
$self->parse_args();
if ( my $uuid = delete $self->{args}->{uuid} ) {
- $self->uuid( $uuid);
+ $self->uuid($uuid);
}
if ( $self->{args}->{type} ) {
$self->type( delete $self->{args}->{'type'} );
- } else {
- die 'Node "--type" argument is mandatory';
}
}
@@ -90,11 +87,113 @@
=cut
-
sub args {
my $self = shift;
return $self->{'args'};
}
+sub do_create {
+ my $cli = shift;
+ my $record = Prophet::Record->new( handle => $cli->handle, type => $cli->type );
+ my ( $id, $results ) = $record->create( props => $cli->args );
+ print "Created " . $cli->type . " " . $record->uuid . "\n";
+
+}
+
+sub do_search {
+ my $cli = shift;
+
+ my $regex;
+ unless ( $regex = $cli->args->{regex} ) {
+ die "Specify a regular expression and we'll search for records matching that regex";
+ }
+
+ my $records = Prophet::Collection->new( handle => $cli->handle, type => $cli->type );
+ $records->matching(
+ sub {
+ my $item = shift;
+ my $props = $item->get_props;
+ map { return 1 if $props->{$_} =~ $regex } keys %$props;
+ return 0;
+ }
+ );
+
+ for ( @{ $records->as_array_ref } ) {
+ printf( "%s %s %s \n", $_->uuid, $_->prop('summary') || "(no summary)", $_->prop('status') || '(no status)' );
+ }
+}
+
+sub do_update {
+ my $cli = shift;
+
+ my $record = Prophet::Record->new( handle => $cli->handle, type => $cli->type );
+ $record->load( uuid => $cli->uuid );
+ $record->set_props( props => $cli->args );
+
+}
+
+sub do_delete {
+ my $cli = shift;
+
+ my $record = Prophet::Record->new( handle => $cli->handle, type => $cli->type );
+ $record->load( uuid => $cli->uuid );
+ if ( $record->delete ) {
+ print $record->type . " " . $record->uuid . " deleted.\n";
+ } else {
+ print $record->type . " " . $record->uuid . "could not be deleted.\n";
+ }
+
+}
+
+sub do_show {
+ my $cli = shift;
+
+ my $record = Prophet::Record->new( handle => $cli->handle, type => $cli->type );
+ $record->load( uuid => $cli->uuid );
+ print "id: " . $record->uuid . "\n";
+ my $props = $record->get_props();
+ for ( keys %$props ) {
+ print $_. ": " . $props->{$_} . "\n";
+ }
+
+}
+
+sub do_merge {
+ my $cli = shift;
+
+ my $opts = $cli->args();
+
+ my $source = Prophet::Sync::Source->new( { url => $opts->{'from'} } );
+ my $target = Prophet::Sync::Source->new( { url => $opts->{'to'} } );
+
+ if ( $target->uuid eq $source->uuid ) {
+ fatal_error( "You appear to be trying to merge two identical replicas. "
+ . "Either you're trying to merge a replica to itself or "
+ . "someone did a bad job cloning your database" );
+ }
+
+ if ( !$target->accepts_changesets ) {
+ fatal_error( $target->url . " does not accept changesets. Perhaps it's unwritable or something" );
+ }
+
+ $target->import_changesets(
+ from => $source,
+ use_resdb => 1,
+ $ENV{'PROPHET_RESOLVER'}
+ ? ( resolver_class => 'Prophet::Resolver::' . $ENV{'PROPHET_RESOLVER'} )
+ : ( ( $opts->{'prefer'} eq 'to' ? ( resolver_class => 'Prophet::Resolver::AlwaysTarget' ) : () ),
+ ( $opts->{'prefer'} eq 'from' ? ( resolver_class => 'Prophet::Resolver::AlwaysSource' ) : () )
+ )
+ );
+
+
+ sub fatal_error {
+ my $reason = shift;
+ die $reason . "\n";
+
+ }
+
+}
+
1;
Modified: SVN-PropDB/lib/Prophet/Sync/Source.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Sync/Source.pm (original)
+++ SVN-PropDB/lib/Prophet/Sync/Source.pm Wed Apr 2 06:27:16 2008
@@ -4,7 +4,7 @@
package Prophet::Sync::Source;
use base qw/Class::Accessor/;
use Params::Validate qw(:all);
-
+use UNIVERSAL::require;
=head1 NAME
@@ -43,7 +43,9 @@
sub rebless_to_replica_type {
my $self = shift;
- bless $self, 'Prophet::Sync::Source::SVN';
+ my $class = 'Prophet::Sync::Source::SVN';
+ $class->require;
+ bless $self, $class;
}
Modified: SVN-PropDB/lib/Prophet/Test.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Test.pm (original)
+++ SVN-PropDB/lib/Prophet/Test.pm Wed Apr 2 06:27:16 2008
@@ -109,10 +109,16 @@
=cut
+our $RUNCNT;
+
sub _get_perl_cmd {
my $script = shift;
my @cmd = ($^X, (map { "-I$_" } @INC));
push @cmd, '-MDevel::Cover' if $INC{'Devel/Cover.pm'};
+ if ($INC{'Devel/DProf.pm'}) {
+ push @cmd, '-d:DProf';
+ $ENV{'PERL_DPROF_OUT_FILE_NAME'} = 'tmon.out.'.$$.'.'.$RUNCNT++;
+ }
push @cmd, 'bin/'.$script;
return @cmd;
}
Modified: SVN-PropDB/lib/Prophet/Test/Participant.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Test/Participant.pm (original)
+++ SVN-PropDB/lib/Prophet/Test/Participant.pm Wed Apr 2 06:27:16 2008
@@ -22,7 +22,7 @@
sub _setup {
my $self = shift;
- as_user($self->name, sub { run_ok('prophet-node-search', [qw(--type Bug --regex .)])});
+ as_user($self->name, sub { call_func_ok( [qw(search --type Bug --regex .)])});
}
@@ -79,7 +79,9 @@
return undef unless ($args->{record});
$self->record_action('delete_record', $args);
- run_ok('prophet-node-delete', [qw(--type Scratch --uuid), $args->{record}]);
+ call_func_ok( [qw(delete --type Scratch --uuid), $args->{record}]);
+
+
}
sub create_record {
@@ -87,7 +89,7 @@
my $args = shift;
@{$args->{props}} = _random_props() unless $args->{props};
- my ($ret, $out, $err) = run_script('prophet-node-create', [qw(--type Scratch), @{$args->{props}} ]);
+ my ($ret, $out, $err) = call_func_ok( [qw(create --type Scratch), @{$args->{props}} ]);
ok($ret, $self->name . " created a record");
if ($out =~ /Created\s+(.*?)\s+(.*)$/i) {
@@ -103,16 +105,15 @@
$args->{record} ||= get_random_local_record();
return undef unless($args->{'record'});
- my ($ok, $stdout, $stderr) = run_script('prophet-node-show', [qw(--type Scratch --uuid), $args->{record}]);
-
+ my ($ok, $stdout, $stderr) = call_func_ok([qw(update --type Scratch --uuid), $args->{record}]);
+
my %props = map { split(/: /,$_,2) } split(/\n/,$stdout);
delete $props{id};
%{$args->{props}} =_permute_props(%props) unless $args->{props};
%props = %{ $args->{props} };
- run_ok( 'prophet-node-update',
- [ qw(--type Scratch --uuid), $args->{record},
+ call_func_ok( [ qw(update --type Scratch --uuid), $args->{record},
map { '--' . $_ => $props{$_} } keys %props ], $self->name . " updated a record" );
$self->record_action('update_record', $args);
@@ -126,21 +127,20 @@
$self->record_action('sync_from_peer', $args);
- @_ = ( 'prophet-merge',
- [ '--prefer', 'to', '--from', repo_uri_for($from),
+ @_ = (
+ ['merge', '--prefer', 'to', '--from', repo_uri_for($from),
'--to', repo_uri_for($self->name) ], $self->name . " sync from " . $from . " ran ok!" );
- goto \&run_ok;
+ goto \&call_func_ok;
}
sub get_random_local_record {
- my ($ok, $stdout, $stderr) = run_script('prophet-node-search', [qw(--type Scratch --regex .)]);
+ my ($ok, $stdout, $stderr) = call_func_ok([qw(search --type Scratch --regex .)]);
my $update_record = (shuffle( map { $_ =~ /^(\S*)/ } split(/\n/,$stdout)))[0];
return $update_record;
}
-sub sync_from_all_peers {}
sub dump_state {
my $self = shift;
my $cli = Prophet::CLI->new();
@@ -176,5 +176,31 @@
$self->arena->record($self->name, $action, @arg);
}
+use IO::String;
+
+sub call_func_ok {
+ my @args = @{ shift @_ };
+ my $cmd = shift @args;
+ local (@ARGV) = (@args);
+ my $cli = Prophet::CLI->new();
+ $cli->parse_record_cmd_args();
+
+ my $str;
+ my $str_fh = IO::String->new($str);
+
+ my $old_fh = select($str_fh);
+
+ my $ret;
+ if ( my $sub = $cli->can( 'do_' . $cmd ) ) {
+ $ret = $sub->($cli);
+ } else {
+ die "I don't know how to do the $cmd";
+ }
+ select($old_fh) if defined $old_fh;
+ ok(1, join(" ", $cmd, @ARGV));
+
+ return ( $ret, $str, undef);
+}
+
1;
More information about the Bps-public-commit
mailing list