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

spang at bestpractical.com spang at bestpractical.com
Fri Jan 23 11:22:11 EST 2009


The branch, master has been updated
       via  38b32f579539110fa9126c55da403da949837f62 (commit)
       via  d847b1ebfa303ddf302816bb7c1ef8619cbd32e3 (commit)
       via  91053086ecc371ca405e88f710b10ee52ff1db1f (commit)
       via  71808fb208926e589c00c91ff61dd99c89e4ebde (commit)
       via  433469d87c9914f493d308187d8bbbbe617f7210 (commit)
       via  809e9fb975dc215b340daed56b9bca9c422d1d31 (commit)
       via  229ec7fa56deef3725536d97347d8a5218dfafa3 (commit)
      from  d1494e53005afb7d6be7ad296704f84019f6e534 (commit)

Summary of changes:
 lib/Prophet/CLI/Command/Log.pm        |   12 +
 lib/Prophet/CLI/Command/Settings.pm   |   41 +++-
 lib/Prophet/Replica/prophet.pm        |   19 +-
 lib/Prophet/Test.pm                   |  359 ++++++++++++++++++++++++---------
 t/Settings/t/sync-database-settings.t |    2 +-
 t/database-settings.t                 |    4 +-
 t/export.t                            |    4 +-
 t/non-conflicting-merge.t             |    4 +-
 t/publish-html.t                      |    3 +-
 t/publish-pull.t                      |    7 +-
 t/real-conflicting-merge.t            |    4 +-
 t/search.t                            |   24 +-
 t/simple-conflicting-merge.t          |    6 +-
 t/simple-push.t                       |    6 +-
 14 files changed, 350 insertions(+), 145 deletions(-)

- Log -----------------------------------------------------------------
commit 229ec7fa56deef3725536d97347d8a5218dfafa3
Author: Christine Spang <spang at bestpractical.com>
Date:   Thu Jan 22 15:56:08 2009 +0200

    move some pod that is in the wrong place

diff --git a/lib/Prophet/Replica/prophet.pm b/lib/Prophet/Replica/prophet.pm
index 302f79a..dc8f864 100644
--- a/lib/Prophet/Replica/prophet.pm
+++ b/lib/Prophet/Replica/prophet.pm
@@ -602,16 +602,6 @@ sub _write_changeset {
 
 }
 
-=head2 traverse_changesets { after => SEQUENCE_NO, callback => sub { } } 
-
-Walks through all changesets after $after, calling $callback on each.
-
-
-=cut
-
-# each record is : local-replica-seq-no : original-uuid : original-seq-no : cas key
-#                  4                    16              4                 20
-
 use constant CHG_RECORD_SIZE => ( 4 + 16 + 4 + 20 );
 
 sub _get_changeset_index_entry {
@@ -645,6 +635,15 @@ sub _get_changeset_index_entry {
     return $changeset;
 }
 
+=head2 traverse_changesets { after => SEQUENCE_NO, callback => sub { } } 
+
+Walks through all changesets after $after, calling $callback on each.
+
+=cut
+
+# each record is : local-replica-seq-no : original-uuid : original-seq-no : cas key
+#                  4                    16              4                 20
+
 sub traverse_changesets {
     my $self = shift;
     my %args = validate(

commit 809e9fb975dc215b340daed56b9bca9c422d1d31
Author: Christine Spang <spang at bestpractical.com>
Date:   Thu Jan 22 15:58:16 2009 +0200

    validate log command arguments

diff --git a/lib/Prophet/CLI/Command/Log.pm b/lib/Prophet/CLI/Command/Log.pm
index f381d1d..e380b37 100644
--- a/lib/Prophet/CLI/Command/Log.pm
+++ b/lib/Prophet/CLI/Command/Log.pm
@@ -4,6 +4,9 @@ extends 'Prophet::CLI::Command';
 
 sub run {
     my $self   = shift;
+
+    $self->validate_args;
+
     my $handle = $self->handle;
     my $newest = $self->arg('last') || $handle->latest_sequence_no;
     my $start  = $newest - ( $self->arg('count') || '20' );
@@ -19,6 +22,15 @@ sub run {
 
 }
 
+sub validate_args {
+    my $self = shift;
+    if ($self->has_arg('last') && $self->arg('last') !~ /\d+/) {
+        die "Value passed to --last must be a number.\n";
+    }
+    if ($self->has_arg('count') && $self->arg('count') !~ /\d+/) {
+        die "Value passed to --count must be a number.\n";
+    }
+}
 
 sub handle_changeset {
     my $self      = shift;

commit 433469d87c9914f493d308187d8bbbbe617f7210
Author: Christine Spang <spang at bestpractical.com>
Date:   Fri Jan 23 12:35:23 2009 +0200

    better user feedback in settings command

diff --git a/lib/Prophet/CLI/Command/Settings.pm b/lib/Prophet/CLI/Command/Settings.pm
index 2e7494c..f7005b4 100644
--- a/lib/Prophet/CLI/Command/Settings.pm
+++ b/lib/Prophet/CLI/Command/Settings.pm
@@ -16,11 +16,16 @@ sub run {
     }
 
     my $settings = $self->app_handle->database_settings;
-    my %settings_by_name = map { $settings->{$_}->[0] => $_ } keys %$settings;
 
     if ( $self->context->has_arg('set') ) {
         for my $name ( $self->context->prop_names ) {
-            my $uuid      = $settings->{$name}->[0];
+            my $uuid;
+            if ($settings->{$name}) {
+                $uuid      = $settings->{$name}->[0];
+            } else {
+                print "Setting \"$name\" does not exist, skipping.\n";
+                next;
+            }
             my $s         = $self->app_handle->setting( uuid => $uuid );
             my $old_value = $s->get_raw;
             my $new_value = $self->context->props->{$name};
@@ -28,7 +33,9 @@ sub run {
               . " from $old_value to $new_value.\n";
             if ( $old_value ne $new_value ) {
                 $s->set( from_json( $new_value, { utf8 => 1 } ) );
-                print "Changed " . $name . " from $old_value to $new_value.\n";
+                print " -> Changed.\n";
+            } else {
+                print " -> No change needed.\n";
             }
         }
         return;
@@ -121,20 +128,38 @@ sub process_template {
 
     no warnings 'uninitialized';
     my $settings = $self->app_handle->database_settings;
+    my %settings_by_uuid = map { uc($settings->{$_}->[0]) => $_ } keys %$settings;
+
+    my $settings_changed = 0;
 
     for my $uuid ( keys %$config ) {
-        my $s         = $self->app_handle->setting( uuid => $uuid );
+        # the parsed template could conceivably contain nonexistent uuids
+        my $s;
+        if ($settings_by_uuid{uc($uuid)}) {
+            $s = $self->app_handle->setting( uuid => $uuid );
+        } else {
+            print "Setting with uuid \"$uuid\" does not exist.\n";
+            next;
+        }
         my $old_value = $s->get_raw;
         my $new_value = $config->{$uuid}->[1];
         chomp $new_value;
         if ( $old_value ne $new_value ) {
-            $s->set( from_json( $new_value, { utf8 => 1 } ) );
-            print "Changed "
-              . $config->{$uuid}->[0]
-              . " from $old_value to $new_value.\n";
+            eval {
+                $s->set( from_json( $new_value, { utf8 => 1 } ) );
+                print "Changed "
+                . $config->{$uuid}->[0]
+                . " from $old_value to $new_value.\n";
+                $settings_changed++;
+            };
+            if ($@) {
+                # error parsing the JSON
+                print 'An error occured setting '.$settings_by_uuid{$uuid}." to $new_value: $@";
+            }
         }
 
     }
+    print "No settings changed.\n" unless $settings_changed;
     return 1;
 }
 

commit 71808fb208926e589c00c91ff61dd99c89e4ebde
Author: Christine Spang <spang at bestpractical.com>
Date:   Fri Jan 23 12:41:22 2009 +0200

    clean up Prophet::Test for my own sanity

diff --git a/lib/Prophet/Test.pm b/lib/Prophet/Test.pm
index 485c832..7496e0e 100644
--- a/lib/Prophet/Test.pm
+++ b/lib/Prophet/Test.pm
@@ -20,7 +20,15 @@ use Prophet::CLI;
 
 our $REPO_BASE = File::Temp::tempdir();
 Test::More->import;
-diag( "Replicas can be found in " . $REPO_BASE );
+diag( "Replicas can be found in $REPO_BASE" );
+
+{
+    no warnings 'redefine';
+    require Test::More;
+    sub Test::More::diag {    # bad bad bad # convenient convenient convenient
+        Test::More->builder->diag(@_) if ( $Test::Harness::Verbose || $ENV{'TEST_VERBOSE'} );
+    }
+}
 
 our $EDIT_TEXT = sub { shift };
 do {
@@ -31,10 +39,22 @@ do {
     };
 };
 
+=head2 set_editor($code)
+
+Sets the subroutine that Prophet should use instead of
+C<Prophet::CLI::Command::edit_text> (as this routine invokes an interactive
+editor) to $code.
+
+=cut
+
 sub set_editor {
     $EDIT_TEXT = shift;
 }
 
+=head2 import_extra($class, $args)
+
+=cut
+
 sub import_extra {
     my $class = shift;
     my $args  = shift;
@@ -48,20 +68,15 @@ sub import_extra {
         *Test::Builder::plan = sub { };
     }
 
-
-
-    
     delete $ENV{'PROPHET_APP_CONFIG'};
     $ENV{'EMAIL'} = 'nobody at example.com';
 }
 
-{
-    no warnings 'redefine';
-    require Test::More;
-    sub Test::More::diag {    # bad bad bad # convenient convenient convenient
-        Test::More->builder->diag(@_) if ( $Test::Harness::Verbose || $ENV{'TEST_VERBOSE'} );
-    }
-}
+=head2 in_gladiator($code)
+
+Run the given code using L<Devel::Gladiator>.
+
+=cut
 
 sub in_gladiator (&) {
     my $code = shift;
@@ -70,7 +85,7 @@ sub in_gladiator (&) {
     my $types;
     eval { require Devel::Gladiator; };
     if ($@) {
-        warn 'Get Devel::Gladiator from http://code.sixapart.com/svn/Devel-Gladiator/trunk/ and harass sky at crucially.net to CPAN it';
+        warn 'Devel::Gladiator not found';
         return $code->();
     }
     for ( @{ Devel::Gladiator::walk_arena() } ) {
@@ -86,34 +101,80 @@ sub in_gladiator (&) {
 
 }
 
-=head2 run_script SCRIPT_NAME [@ARGS]
+=head2 run_script($script, $args, $stdout, $stderr)
+
+Runs the script $script as a perl script, setting the @INC to the same as
+our caller.
 
-Runs the script SCRIPT_NAME as a perl script, setting the @INC to the same as our caller
+$script is the name of the script to be run (such as 'prophet'). $args is a
+reference to an array of arguments to pass to the script. $stdout and $stderr
+are both optional; if passed in, they will be passed to L<IPC::Run3>'s run3
+subroutine as its $stdout and $stderr args.  Otherwise, this subroutine will
+create scalar references to pass to run3 instead (which are treated as strings
+for STDOUT/STDERR to be written to).
+
+Returns run3's return value and, if no $stdout and $stderr were passed in, the
+STDOUT and STDERR of the script that was run.
 
 =cut
 
 sub run_script {
     my $script = shift;
     my $args = shift || [];
-    my ( $stdout, $stderr );
+    my ( $stdout, $stderr ) = @_;
+    my ( $new_stdout, $new_stderr, $return_stdouterr );
+    if (!ref($stdout) && !ref($stderr)) {
+        ($stdout, $stderr, $return_stdouterr) = (\$new_stdout, \$new_stderr, 1);
+    }
     my @cmd = _get_perl_cmd($script);
 
     local $ENV{IN_PROPHET_TEST_COMMAND} = 1;
 
     #    diag(join(' ', @cmd, @$args));
-    my $ret = run3 [ @cmd, @$args ], undef, \$stdout, \$stderr;
-    Carp::croak $stderr          if $?;
+    my $ret = run3 [ @cmd, @$args ], undef, $stdout, $stderr;
+    # we don't actually want to die if the run command returned an error code
+    # Carp::croak $stderr          if $?;
     #diag( "STDOUT: " . $stdout ) if ($stdout);
     #diag( "STDERR: " . $stderr ) if ($stderr);
 
     #Test::More::diag $stderr;
-    return ( $ret, $stdout, $stderr );
+    return $return_stdouterr ? ( $ret, $$stdout, $$stderr ) : $ret;
 }
 
-=head2 run_ok SCRIPT_NAME [@ARGS] (<- optional hashref), optional message
+our $RUNCNT;
+
+sub _get_perl_cmd {
+    my ($tmp, $i) = (Prophet::Util->updir($0), 0);
+    while ( ! -d File::Spec->catdir($tmp, 'bin') && $i++ < 10 ) {
+        $tmp = Prophet::Util->updir($tmp);
+    }
+    
+    my $base_dir = File::Spec->catdir($tmp, 'bin');
+    die "couldn't find bin dir" unless -d $base_dir;
+
+    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, File::Spec->catdir($base_dir => $script);
+    return @cmd;
+}
+
+=head2 run_ok($script, $args, $msg)
 
 Runs the script, checking that it didn't error out.
 
+$script is the name of the script to be run (e.g. 'prophet'). $args
+is an optional reference to an array of arguments to pass to the
+script when it is run. $msg is an optional message to print with
+the test. If $args is not specified, you can still pass in
+a $msg.
+
+Returns nothing of interest.
+
 =cut
 
 sub run_ok {
@@ -125,20 +186,67 @@ sub run_ok {
 
     lives_and {
         local $Test::Builder::Level = $Test::Builder::Level + 1;
-        my ( $ret, $stdout, $stderr ) = ( run_script( $script, $args ), $msg );
-
-        diag("STDOUT: " . $stdout) if ($stdout);
-        diag("STDERR: " . $stderr) if ($stderr);
+        my ( $ret, $stdout, $stderr ) = run_script( $script, $args );
+        # diag("STDOUT: " . $stdout) if ($stdout);
+        # diag("STDERR: " . $stderr) if ($stderr);
         ok($ret, $msg);
     };
 }
 
-=head2 _mk_cmp_closure EXPECTED, ERROR
+=head2 is_script_output($scriptname \@args, \@stdout_match, \@stderr_match, $msg)
+
+Runs $scriptname, checking to see that its output matches.
+
+$args is an array reference of args to pass to the script. $stdout_match and
+$stderr_match are references to arrays of expected lines. $msg is a string
+message to display with the test. $stderr_match and $msg are optional. (As is
+$stdout_match if for some reason you expect your script to have no output at
+all. But that would be silly, wouldn't it?)
+
+Allows regex matches as well as string equality (lines in $stdout_match and
+$stderr_match may be Regexp objects).
+
+=cut
+
+sub is_script_output {
+    my ( $script, $args, $exp_stdout, $exp_stderr, $msg ) = @_;
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+    my $stdout_err = [];
+    $exp_stderr ||= [];
+
+    my $ret = run_script($script, $args,
+        _mk_cmp_closure( $exp_stdout, $stdout_err ),    # stdout
+        _mk_cmp_closure( $exp_stderr, $stdout_err ),    # stderr
+    );
+
+    for my $line (@$exp_stdout) {
+        next if !defined $line;
+        push @$stdout_err, "got nothing, expected: $line";
+    }
+
+    my $test_name = join( ' ', $msg ? "$msg:" : '', $script, @$args );
+    is(scalar(@$stdout_err), 0, $test_name);
+
+    if (@$stdout_err) {
+        diag( "Different in line: " . join( "\n", @$stdout_err ) );
+    }
+}
+
+=head2 _mk_cmp_closure($expected, $error)
+
+$expected is a reference to an array of expected output lines, and
+$error is an array reference for storing error messages.
 
-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.
+Returns a subroutine that takes a line of output and compares it
+to the next line in $expected. You can, for example, pass this
+subroutine to L<IPC::Run3>::run3 and it will compare the output
+of the script being run to the expected output. After the script
+is done running, errors will be in $error.
+
+If a line in $expected is a Regexp reference (made with e.g.
+qr/foo/), the subroutine will check for a regexp match rather
+than string equality.
 
 =cut
 
@@ -146,7 +254,7 @@ sub _mk_cmp_closure {
     my ( $exp, $err ) = @_;
     my $line = 0;
 
-    $exp = ref($exp) eq 'ARRAY' ? $exp : [$exp];
+    $exp = [$exp] if ref($exp) ne 'ARRAY';
 
     sub {
         my $output = shift;
@@ -158,64 +266,19 @@ sub _mk_cmp_closure {
         }
         my $item = shift @$exp;
         push @$err, "$line: got ($output), expect ($item)\n"
-            unless ref($item)
+            unless ref($item) eq 'Regexp'
             ? ( $output =~ m/$item/ )
             : ( $output eq $item );
-        }
-}
-
-our $RUNCNT;
-
-sub _get_perl_cmd {
-    my ($tmp, $i) = (Prophet::Util->updir($0), 0);
-    while ( ! -d File::Spec->catdir($tmp, 'bin') && $i++ < 10 ) {
-        $tmp = Prophet::Util->updir($tmp);
-    }
-    
-    my $base_dir = File::Spec->catdir($tmp, 'bin');
-    die "couldn't find bin dir" unless -d $base_dir;
-
-    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, File::Spec->catdir($base_dir => $script);
-    return @cmd;
 }
 
-=head2 is_script_output SCRIPTNAME \@ARGS, \@STDOUT_MATCH, \@STDERR_MATCH, $MSG
+=head2 run_output_matches($script, $args, $exp_stdout, $exp_stderr, $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>.
+A wrapper around L<is_script_output> that also checks to make sure
+the test runs without throwing an exception.
 
 =cut
 
-sub is_script_output {
-    my ( $script, $arg, $exp_stdout, $exp_stderr, $msg ) = @_;
-    local $Test::Builder::Level = $Test::Builder::Level + 1;
-
-    my $stdout_err = [];
-    $exp_stderr ||= [];
-    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
-
-    for my $line(@$exp_stdout) {
-        next if !defined $line;
-        push @$stdout_err, "got nothing, expected: $line";
-    }
-
-    my $test_name = join( ' ', $msg ? "$msg:" : '', $script, @$arg );
-    is(scalar(@$stdout_err), 0, $test_name);
-    if (@$stdout_err) {
-        diag( "Different in line: " . join( "\n", @$stdout_err ) );
-    }
-}
-
 sub run_output_matches {
     my ( $script, $args, $expected, $stderr, $msg ) = @_;
     local $Test::Builder::Level = $Test::Builder::Level + 1;
@@ -225,19 +288,35 @@ sub run_output_matches {
     };
 }
 
+=head2 run_output_matches_unordered($scriptname, \@args, \@exp_stdout)
+
+Runs the given script and checks to make sure that the output
+matches, but the output lines don't necessarily have to be in the same order.
+
+$scriptname is the name of the script to be run (e.g. 'prophet'), $args
+is a reference to an array of arguments to pass to the command, and
+$exp_stdout is a reference to an array of expected output lines.
+
+Line matches are determined through string equality.
+
+=cut
+
 sub run_output_matches_unordered {
     my $cmd = shift;
     my $args = shift;
     my $output = shift;
-    my ($val, $out, $err)  = run_script( $cmd, $args);
+    my ($val, $out, $err)  = run_script( $cmd, $args );
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
-    is_deeply([sort split(/\n/,$out)], [sort @$output]);
+
+    my @sorted_out = sort split(/\n/,$$out);
+    my @sorted_exp = sort @$output;
+    is_deeply(\@sorted_out, \@sorted_exp);
 }
 
-=head2 repo_path_for $USERNAME
+=head2 repo_path_for($username)
 
-Returns a path on disk for where $USERNAME's replica is stored
+Returns a path on disk for where $username's replica is stored.
 
 =cut
 
@@ -246,9 +325,10 @@ sub repo_path_for {
     return File::Spec->catdir($REPO_BASE => $username);
 }
 
-=head2 repo_uri_for $USERNAME
+=head2 repo_uri_for($username)
 
-Returns a subversion file:// URI for $USERNAME'S replica
+Returns a file:// URI for $USERNAME'S replica (with the correct replica
+type prefix).
 
 =cut
 
@@ -263,26 +343,45 @@ sub repo_uri_for {
     return Prophet::App->default_replica_type . ':file://' . $path;
 }
 
+=head2 replica_uuid
+
+Returns the UUID of the test replica.
+
+=cut
+
 sub replica_uuid {
     my $self = shift;
     my $cli  = Prophet::CLI->new();
     return $cli->handle->uuid;
 }
 
+=head2 database_uuid
+
+Returns the UUID of the test database.
+
+=cut
+
 sub database_uuid {
     my $self = shift;
     my $cli  = Prophet::CLI->new();
     return eval { $cli->handle->db_uuid};
 }
 
+=head2 replica_last_rev
+
+Returns the sequence number of the last change in the test replica.
+
+=cut
+
 sub replica_last_rev {
     my $cli = Prophet::CLI->new();
     return $cli->handle->latest_sequence_no;
 }
 
-=head2 as_user USERNAME CODEREF
+=head2 as_user($username, $coderef)
 
-Run this code block as USERNAME.  This routine sets up the %ENV hash so that when we go looking for a repository, we get the user's repo.
+Run this code block as $username.  This routine sets up the %ENV hash so that
+when we go looking for a repository, we get the user's repo.
 
 =cut
 
@@ -304,17 +403,32 @@ sub as_user {
     return $ret;
 }
 
+=head2 replica_uuid_for($username)
+
+Returns the UUID of the given user's test replica.
+
+=cut
+
 sub replica_uuid_for {
     my $user = shift;
     return $REPLICA_UUIDS{$user};
 }
 
+=head2 database_uuid_for($username)
+
+Returns the UUID of the given user's test database.
+
+=cut
+
 sub database_uuid_for {
     my $user = shift;
     return $DATABASE_UUIDS{$user};
 }
 
-=head2 ensure_new_revisions { CODE }, $numbers_of_new_revisions, $msg
+=head2 ok_added_revisions( { CODE }, $numbers_of_new_revisions, $msg)
+
+Checks that the given code block adds the given number of changes to the test
+replica. $msg is optional and will be printed with the test if given.
 
 =cut
 
@@ -326,9 +440,30 @@ sub ok_added_revisions (&$$) {
     is( replica_last_rev(), $last_rev + $num, $msg );
 }
 
-=head2 serialize_conflict Prophet::Conflict
-
-returns a simple, serialized version of a Prophet::Conflict object suitable for comparison in tests
+=head2 serialize_conflict($conflict_obj)
+
+Returns a simple, serialized version of a L<Prophet::Conflict> object suitable
+for comparison in tests.
+
+The serialized version is a hash reference containing the following keys:
+    meta => { original_source_uuid => 'source_replica_uuid' }
+    records => { 'record_uuid' =>
+                   { change_type => 'type',
+                     props => { propchange_name => { source_old => 'old_val',
+                                                     source_new => 'new_val',
+                                                     target_old => 'target_val',
+                                                   }
+                              }
+                   },
+                 'another_record_uuid' =>
+                   { change_type => 'type',
+                     props => { propchange_name => { source_old => 'old_val',
+                                                     source_new => 'new_val',
+                                                     target_old => 'target_val',
+                                                   }
+                              }
+                   },
+               }
 
 =cut
 
@@ -351,16 +486,24 @@ sub serialize_conflict {
     return $conflicts;
 }
 
+=head2 serialize_changeset($changeset_obj)
+
+Returns a simple, serialized version of a L<Prophet::ChangeSet> object
+suitable for comparison in tests (a hash).
+
+=cut
+
 sub serialize_changeset {
-    my $cs = shift;
+    my ($cs) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );
 
     return $cs->as_hash;
 }
 
-=head2 run_command arguments -> stdout
+=head2 run_command($command, @args)
 
-Run the given command using a new L<Prophet::CLI> object. Returns the standard
-output of that command.
+Run the given command with (optionally) the given args using a new
+L<Prophet::CLI> object. Returns the standard output of that command
+in scalar form.
 
 Examples:
 
@@ -378,6 +521,12 @@ sub run_command {
 {
     my $connection = lazy { Prophet::CLI->new->handle };
 
+=head2 load_record($type, $uuid)
+
+Loads and returns a record object for the record with the given type and uuid.
+
+=cut
+
     sub load_record {
         my $type = shift;
         my $uuid = shift;
@@ -390,8 +539,7 @@ sub run_command {
 
 =head2 as_alice CODE, as_bob CODE, as_charlie CODE, as_david CODE
 
-Runs CODE as alice, bob, charlie or david
-
+Runs CODE as alice, bob, charlie or david.
 
 =cut
 
@@ -400,11 +548,11 @@ sub as_bob (&)    { as_user( bob     => shift ) }
 sub as_charlie(&) { as_user( charlie => shift ) }
 sub as_david(&)   { as_user( david   => shift ) }
 
-END {
-    for (qw(alice bob charlie david)) {
+# END {
+#     for (qw(alice bob charlie david)) {
 
-        #     as_user( $_, sub { rmtree [ $ENV{'PROPHET_REPO'} ] } );
-    }
-}
+#         #     as_user( $_, sub { rmtree [ $ENV{'PROPHET_REPO'} ] } );
+#     }
+# }
 
 1;

commit 91053086ecc371ca405e88f710b10ee52ff1db1f
Author: Christine Spang <spang at bestpractical.com>
Date:   Fri Jan 23 13:25:05 2009 +0200

    make run_output_matches_unordered behave exactly like run_output_matches
    (with the exception of not requiring the lines to be in the same order,
    of course) -- especially, it now supports regex matches as well as
    regular equality

diff --git a/lib/Prophet/Test.pm b/lib/Prophet/Test.pm
index 7496e0e..da0a37c 100644
--- a/lib/Prophet/Test.pm
+++ b/lib/Prophet/Test.pm
@@ -220,17 +220,7 @@ sub is_script_output {
         _mk_cmp_closure( $exp_stderr, $stdout_err ),    # stderr
     );
 
-    for my $line (@$exp_stdout) {
-        next if !defined $line;
-        push @$stdout_err, "got nothing, expected: $line";
-    }
-
-    my $test_name = join( ' ', $msg ? "$msg:" : '', $script, @$args );
-    is(scalar(@$stdout_err), 0, $test_name);
-
-    if (@$stdout_err) {
-        diag( "Different in line: " . join( "\n", @$stdout_err ) );
-    }
+    _check_cmp_closure_output($script, $msg, $args, $exp_stdout, $stdout_err);
 }
 
 =head2 _mk_cmp_closure($expected, $error)
@@ -272,6 +262,30 @@ sub _mk_cmp_closure {
     }
 }
 
+# factored out so it can be shared between is_script_output
+# and run_script_matches_unordered
+
+# XXX note that this sub doesn't check to make sure we got
+# all the errors we were expecting (there can be more lines
+# in the expected stderr than the received stderr as long
+# as they match up until the end of the received stderr --
+# the same isn't true of stdout)
+sub _check_cmp_closure_output {
+    my ($script, $msg, $args, $exp_stdout, $stdout_err) = @_;
+
+    for my $line (@$exp_stdout) {
+        next if !defined $line;
+        push @$stdout_err, "got nothing, expected: $line";
+    }
+
+    my $test_name = join( ' ', $msg ? "$msg:" : '', $script, @$args );
+    is(scalar(@$stdout_err), 0, $test_name);
+
+    if (@$stdout_err) {
+        diag( "Different in line: " . join( "\n", @$stdout_err ) );
+    }
+}
+
 =head2 run_output_matches($script, $args, $exp_stdout, $exp_stderr, $msg)
 
 A wrapper around L<is_script_output> that also checks to make sure
@@ -288,30 +302,35 @@ sub run_output_matches {
     };
 }
 
-=head2 run_output_matches_unordered($scriptname, \@args, \@exp_stdout)
-
-Runs the given script and checks to make sure that the output
-matches, but the output lines don't necessarily have to be in the same order.
-
-$scriptname is the name of the script to be run (e.g. 'prophet'), $args
-is a reference to an array of arguments to pass to the command, and
-$exp_stdout is a reference to an array of expected output lines.
+=head2 run_output_matches_unordered($script, $args, $exp_stdout, $exp_stderr, $msg)
 
-Line matches are determined through string equality.
+This subroutine has exactly the same functionality as run_output_matches, but
+doesn't impose a line ordering when comparing the expected and received
+outputs.
 
 =cut
 
 sub run_output_matches_unordered {
-    my $cmd = shift;
-    my $args = shift;
-    my $output = shift;
+    my ($cmd, $args, $stdout, $stderr, $msg) = @_;
+
     my ($val, $out, $err)  = run_script( $cmd, $args );
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
-    my @sorted_out = sort split(/\n/,$$out);
-    my @sorted_exp = sort @$output;
-    is_deeply(\@sorted_out, \@sorted_exp);
+    # in order to not force an ordering on the output, we sort both
+    # the expected and received output before comparing them
+    my $sorted_exp_out = [sort @$stdout];
+    my $sorted_exp_err = [sort @$stderr];
+
+    # compare and put errors into $error
+    my $error = [];
+    my $check_exp_out = _mk_cmp_closure($sorted_exp_out, $error);
+    my $check_exp_err = _mk_cmp_closure($sorted_exp_err, $error);
+
+    map { $check_exp_out->($_) } sort split(/\n/,$$out);
+    map { $check_exp_err->($_) } sort split(/\n/,$$err);
+
+    _check_cmp_closure_output($cmd, $msg, $args, $sorted_exp_out, $error);
 }
 
 =head2 repo_path_for($username)

commit d847b1ebfa303ddf302816bb7c1ef8619cbd32e3
Author: Christine Spang <spang at bestpractical.com>
Date:   Fri Jan 23 14:22:29 2009 +0200

    fix some run_output_matches miscalls that were resulting in the
    messages not being displayed (maybe these tests were written before
    run_output_matches supported checkind stderr?)

diff --git a/t/Settings/t/sync-database-settings.t b/t/Settings/t/sync-database-settings.t
index 3d83e01..9753416 100644
--- a/t/Settings/t/sync-database-settings.t
+++ b/t/Settings/t/sync-database-settings.t
@@ -10,7 +10,7 @@ use lib 't/Settings/lib';
 as_alice {
     run_ok('settings', [qw(init)]);
     run_ok( 'settings', [qw(create --type Bug -- --status new --from alice )], "Created a record as alice" );
-    run_output_matches( 'settings', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'settings', [qw(search --type Bug --regex .)], [qr/new/], [], "Found our record" );
     my ($return, $stdout, $stderr) = run_script('settings', [qw(settings --show)]);
     like($stdout, qr/default_status: \["new"\]/, "the original milestone list is there");
     run_ok('settings', [qw(settings --set -- default_status ["open"])]);
diff --git a/t/database-settings.t b/t/database-settings.t
index 658c1c4..0c0f1a9 100644
--- a/t/database-settings.t
+++ b/t/database-settings.t
@@ -79,7 +79,7 @@ exit;
    
     # just for good measure, create a ticket
     run_ok( 'prophet', [qw(create --type Bug -- --status new --from alice )], "Created a record as alice" );
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], [], " Found our record" );
 
 
 };
@@ -92,7 +92,7 @@ as_bob {
     # pull from alice
     run_ok( 'prophet', ['clone', '--from', "file://".$alice_cli->app_handle->handle->fs_root] );
     run_ok( 'prophet', [qw(create --type Bug -- --status open --from bob )], "Created a record as bob" );
-    run_output_matches( 'prophet', [qw(search --type Bug --regex open)], [qr/open/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex open)], [qr/open/], [], "Found our record" );
 
     
 
diff --git a/t/export.t b/t/export.t
index ea53520..a17e1ba 100644
--- a/t/export.t
+++ b/t/export.t
@@ -9,7 +9,7 @@ use Test::Exception;
 as_alice {
     run_ok('prophet', [qw(init)]);
     run_ok( 'prophet', [qw(create --type Bug -- --status new --from alice )], "Created a record as alice" );
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], [], " Found our record" );
 };
 
 diag('Bob syncs from alice');
@@ -45,7 +45,7 @@ as_bob {
               'from: alice',
               'original_replica: ' . replica_uuid_for('alice'),
               'status: stalled',
-        ],
+        ], [],
         'content is correct'
     );
 
diff --git a/t/non-conflicting-merge.t b/t/non-conflicting-merge.t
index d2f6a7f..ca47afa 100644
--- a/t/non-conflicting-merge.t
+++ b/t/non-conflicting-merge.t
@@ -8,7 +8,7 @@ use Prophet::Test tests => 24;
 as_alice {
     run_ok( 'prophet', ['init']);
     run_ok( 'prophet', [qw(create --type Bug -- --status new --from alice )], "Created a record as alice" );
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], [], "Found our record" );
 
     # update the record
     # show the record history
@@ -18,7 +18,7 @@ as_alice {
 as_bob {
     run_ok( 'prophet', [qw(init)]);
     run_ok( 'prophet', [qw(create --type Bug -- --status open --from bob )], "Created a record as bob" );
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/open/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/open/], [], "Found our record" );
 
     # update the record
     # show the record history
diff --git a/t/publish-html.t b/t/publish-html.t
index 2469a0b..dfa89c7 100644
--- a/t/publish-html.t
+++ b/t/publish-html.t
@@ -16,9 +16,10 @@ as_alice {
     run_output_matches( 'prophet',
         [qw(create --type Bug -- --status new --from alice --summary), 'this is a template test'],
         [qr/Created Bug \d+ \((\S+)\)(?{ $bug_uuid = $1 })/],
+        [],
         "Created a Bug record as alice");
     ok($bug_uuid, "got a uuid for the Bug record");
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], [], " Found our record" );
 
     run_ok( 'prophet', [qw(publish --html --to), $alice_published] );
 };
diff --git a/t/publish-pull.t b/t/publish-pull.t
index b47972a..dfd3ada 100644
--- a/t/publish-pull.t
+++ b/t/publish-pull.t
@@ -17,7 +17,7 @@ as_alice {
         [qr/Created Bug \d+ \((\S+)\)(?{ $bug_uuid = $1 })/],
         "Created a Bug record as alice");
     ok($bug_uuid, "got a uuid for the Bug record");
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], [], " Found our record" );
     run_ok( 'prophet', [qw(publish --to), $alice_published] );
 };
 
@@ -25,12 +25,13 @@ my $path =$alice_published;
 
 as_bob {
     run_ok( 'prophet', ['clone', '--from', "file://$path"] );
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], [], " Found our record" );
 };
 as_alice {
     run_output_matches( 'prophet',
         [qw(create --type Pullall -- --status new --from alice )],
         [qr/Created Pullall \d+ \((\S+)\)(?{ $pullall_uuid = $1 })/],
+        [],
         "Created a Pullall record as alice");
     ok($pullall_uuid, "got a uuid $pullall_uuid for the Pullall record");
 
@@ -39,7 +40,7 @@ as_alice {
 
 as_bob {
     run_ok( 'prophet', ['pull', '--all'] );
-    run_output_matches( 'prophet', [qw(search --type Pullall --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Pullall --regex .)], [qr/new/], [], " Found our record" );
 };
 
 
diff --git a/t/real-conflicting-merge.t b/t/real-conflicting-merge.t
index e5d3702..599b2f1 100644
--- a/t/real-conflicting-merge.t
+++ b/t/real-conflicting-merge.t
@@ -40,7 +40,7 @@ as_bob {
           'from: alice',
           'original_replica: ' . replica_uuid_for('alice'),
           'status: stalled',
-        ],
+        ], [],
         'content is correct'
     );
 };
@@ -57,7 +57,7 @@ as_alice {
               'from: alice',
               'original_replica: ' . replica_uuid_for('alice'),
               'status: open',
-        ],
+        ], [],
         'content is correct'
     );
 
diff --git a/t/search.t b/t/search.t
index a13c2b4..6d47185 100644
--- a/t/search.t
+++ b/t/search.t
@@ -12,62 +12,62 @@ as_alice {
     run_output_matches('prophet', [qw(search --type Bug --regex .)],
         [qr/first ticket summary/,
          qr/other ticket summary/,
-         qr/bad ticket summary/],
+         qr/bad ticket summary/], [],
         "Found our records",
     );
 
     run_output_matches('prophet', [qw(ls --type Bug -- status=new)],
-        [qr/first ticket summary/],
+        [qr/first ticket summary/], [],
         "found the only ticket with status=new",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- status=open)],
-        [qr/other ticket summary/],
+        [qr/other ticket summary/], [],
         "found the only ticket with status=open",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- status=closed)],
-        [],
+        [], [],
         "found no tickets with status=closed",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- status=new status=open)],
-        [qr/first ticket summary/, qr/other ticket summary/],
+        [qr/first ticket summary/, qr/other ticket summary/], [],
         "found two tickets with status=new OR status=open",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- status!=new)],
-        [qr/other ticket summary/, qr/bad ticket summary/],
+        [qr/other ticket summary/, qr/bad ticket summary/], [],
         "found two tickets with status!=new",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- status=~n)],
-        [qr/first ticket summary/, qr/other ticket summary/],
+        [qr/first ticket summary/, qr/other ticket summary/], [],
         "found two tickets with status=~n",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- summary=~first|bad)],
-        [qr/first ticket summary/, qr/bad ticket summary/],
+        [qr/first ticket summary/, qr/bad ticket summary/], [],
         "found two tickets with status=~first|stalled",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- status !=new summary=~first|bad)],
-        [qr/bad ticket summary/],
+        [qr/bad ticket summary/], [],
         "found two tickets with status=~first|bad",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- status ne new summary =~ first|bad)],
-        [qr/bad ticket summary/],
+        [qr/bad ticket summary/], [],
         "found two tickets with status=~first|bad",
     );
 
     run_output_matches('prophet', [qw(search --type Bug -- cmp ne)],
-        [qr/bad ticket summary/],
+        [qr/bad ticket summary/], [],
         "found the ticket with cmp=ne (which didn't treat 'ne' as a comparator)",
     );
 
     run_output_matches('prophet', [qw(search --type Bug --regex=new -- status=~n)],
-        [qr/first ticket summary/],
+        [qr/first ticket summary/], [],
         "found a ticket with regex and props working together",
     );
 };
diff --git a/t/simple-conflicting-merge.t b/t/simple-conflicting-merge.t
index 4bdbfa0..a7ec66d 100644
--- a/t/simple-conflicting-merge.t
+++ b/t/simple-conflicting-merge.t
@@ -11,7 +11,7 @@ use_ok('Prophet::Replica');
 as_alice {
     run_ok( 'prophet' , ['init']);
     run_ok( 'prophet', [qw(create --type Bug -- --status new --from alice )], "Created a record as alice" );
-    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], " Found our record" );
+    run_output_matches( 'prophet', [qw(search --type Bug --regex .)], [qr/new/], [], "Found our record" );
 };
 
 diag('Bob syncs from alice');
@@ -38,7 +38,7 @@ as_bob {
               'from: alice',
               'original_replica: ' . replica_uuid_for('alice'),
               'status: stalled',
-        ],
+        ], [],
         'content is correct'
     );
 };
@@ -61,7 +61,7 @@ as_alice {
               'from: alice',
               'original_replica: ' . replica_uuid_for('alice'),
               'status: stalled',
-        ],
+        ], [],
         'content is correct'
     );
 
diff --git a/t/simple-push.t b/t/simple-push.t
index 9537dd0..abf3b94 100644
--- a/t/simple-push.t
+++ b/t/simple-push.t
@@ -14,7 +14,7 @@ as_alice {
     );
     run_output_matches(
         'prophet', [qw(search --type Bug --regex .)],
-        [qr/new/], " Found our record"
+        [qr/new/], [], "Found our record"
     );
 
     # update the record
@@ -31,11 +31,11 @@ as_bob {
         "Created a record as bob"
     );
     run_output_matches( 'prophet', [qw(search --type Bug --regex new-alice)],
-        [ qr/new-alice/ ], " Found our record"
+        [ qr/new-alice/ ], [], "Found our record"
     );
 
     run_output_matches( 'prophet', [qw(search --type Bug --regex open-bob)],
-        [ qr/open-bob/ ], " Found our record"
+        [ qr/open-bob/ ], [], "Found our record"
     );
 
 

commit 38b32f579539110fa9126c55da403da949837f62
Merge: d847b1e... d1494e5...
Author: Christine Spang <spang at bestpractical.com>
Date:   Fri Jan 23 18:21:56 2009 +0200

    Merge branch 'master' of code.bestpractical.com:/git/prophet


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



More information about the Bps-public-commit mailing list