[Bps-public-commit] r16429 - in Prophet/branches/dispatcher: doc lib/Prophet lib/Prophet/CLI lib/Prophet/Replica lib/Prophet/Resolver lib/Prophet/Test t

sartak at bestpractical.com sartak at bestpractical.com
Tue Oct 21 11:50:28 EDT 2008


Author: sartak
Date: Tue Oct 21 11:50:28 2008
New Revision: 16429

Added:
   Prophet/branches/dispatcher/doc/merging-and-conflicts
   Prophet/branches/dispatcher/lib/Prophet/CLI/TextEditorCommand.pm
   Prophet/branches/dispatcher/lib/Prophet/DatabaseSetting.pm
   Prophet/branches/dispatcher/t/database-settings.t
Modified:
   Prophet/branches/dispatcher/   (props changed)
   Prophet/branches/dispatcher/Makefile.PL
   Prophet/branches/dispatcher/lib/Prophet/App.pm
   Prophet/branches/dispatcher/lib/Prophet/CLIContext.pm
   Prophet/branches/dispatcher/lib/Prophet/Change.pm
   Prophet/branches/dispatcher/lib/Prophet/ChangeSet.pm
   Prophet/branches/dispatcher/lib/Prophet/Collection.pm
   Prophet/branches/dispatcher/lib/Prophet/Record.pm
   Prophet/branches/dispatcher/lib/Prophet/Replica.pm
   Prophet/branches/dispatcher/lib/Prophet/Replica/prophet.pm
   Prophet/branches/dispatcher/lib/Prophet/Replica/svn.pm
   Prophet/branches/dispatcher/lib/Prophet/ReplicaExporter.pm
   Prophet/branches/dispatcher/lib/Prophet/Resolver/FromResolutionDB.pm
   Prophet/branches/dispatcher/lib/Prophet/Test.pm
   Prophet/branches/dispatcher/lib/Prophet/Test/Arena.pm
   Prophet/branches/dispatcher/t/01-dependencies.t

Log:
Bring Prophet-dispatcher up to trunk

Modified: Prophet/branches/dispatcher/Makefile.PL
==============================================================================
--- Prophet/branches/dispatcher/Makefile.PL	(original)
+++ Prophet/branches/dispatcher/Makefile.PL	Tue Oct 21 11:50:28 2008
@@ -9,13 +9,13 @@
 requires('IPC::Run3');
 requires('Data::UUID');
 requires('Path::Class');
-build_requires('Test::Exception');
+build_requires('Test::Exception' => '0.26' );
 requires('Term::ReadKey');
 requires('Digest::SHA1');  # Core in 5.10
 requires('LWP::Simple'); # Part of lib-www-perl
 requires('URI');
 requires('JSON' => '2.00');
-requires('JSON::XS' => '2.01');
+requires('JSON::XS' => '2.2222');
 requires('Module::Pluggable');
 requires('File::Find::Rule');
 requires('Proc::InvokeEditor');

Added: Prophet/branches/dispatcher/doc/merging-and-conflicts
==============================================================================
--- (empty file)
+++ Prophet/branches/dispatcher/doc/merging-and-conflicts	Tue Oct 21 11:50:28 2008
@@ -0,0 +1,112 @@
+<Sartak> Prophet has the concept of a database and a replica
+<Sartak> a database is the global state
+<Sartak> so jesse and I both have copies of the sd buglist, that's the same database
+<Sartak> you can pull to and from anyone with the same database uuid. you can pull from someone with a different database uuid if you say --force
+<Sartak> but that may get sketchy
+<Sartak> replicas are an individual instance of the database
+<Sartak> however, there can be multiple copies of the same replica
+<Sartak> I have on my laptop a replica of the sd buglist
+<Sartak> and on my webserver (sartak.org/misc/sd) I have the same replica
+<Sartak> it's the same instance, just different copies. you could have a copy on a thumbdrive or whatever
+<nothingmuch> *nod*
+<Sartak> it's a fatal error if you try to merge two replicas with the same replica uuid
+<Sartak> you can only copy the replica wholesale (we call it "export")
+<Sartak> export keeps the same replica uuid
+<Sartak> if you merge between a replica and the empty replica, that is how you create a replica with the same database uuid and different replica uuid
+<Sartak> so to get a new replica (say you want to start tracking sd's bugs) you must do a merge. "sd pull --from url" when you have an empty database will do exactly this.
+<nothingmuch> so in the abstract
+<nothingmuch> replica is a set of record UUIDs
+<nothingmuch> and record data
+<nothingmuch> and record history?
+<Sartak> I'd say more that a replica is an ordered collection of changesets
+<nothingmuch> or is it more like darcs (the set of changes)
+<Sartak> we store the current state of each record for efficiency :)
+<Sartak> but when we merge we don't look at that region of the replica at all
+<nothingmuch> the changesets are not mutable
+<nothingmuch> (i'm guessing ;-)
+<Sartak> correct
+<nothingmuch> one common technique is to cache the tip of a shadow paging view
+<nothingmuch> but if you completely zap the record set you can always reconstruct it
+<Sartak> right!
+<Sartak> okay, so we're definitely more about changesets than records
+<Sartak> onto conflicts
+<Sartak> there are like four possible conflicts
+<Sartak> two changesets that create the same record uuid (rare, I think this is only when we have that astronomically improbable uuid collision)
+<Sartak> a changeset that deletes a record we don't have
+<Sartak> a changeset that updates a record we don't have
+<Sartak> a changeset that updates a record, but the old value isn't our current value
+<nothingmuch> "value" being the whoe record?
+<nothingmuch> or a cell?
+<Sartak> a property
+<Sartak> a property is a hash key/value :)
+<nothingmuch> *nod* but if the key is different then it's more the "we don't have" case, no?
+<Sartak> "we have too much"
+<Sartak> you create a record, I pull it
+<Sartak> you set its name property to yuval
+<Sartak> I set its name property to shawn
+<Sartak> I pull from you
+<nothingmuch> oh
+<nothingmuch> record == one key value pair?
+<Sartak> a record is a hash
+<nothingmuch> i thought record == one set of key value pairs
+<Sartak> it's a set, right
+<Sartak> when I pull from you, I get a "change uuid BLAH's ircer property from undef to yuval"
+<Sartak> but that's a conflict because my BLAH's ircer is shawn
+<nothingmuch> *nod*
+<Sartak> it's a really simple system
+<nothingmuch> yeah
+<nothingmuch> so how does all the self healing mumbo jumbo work ;-)
+<Sartak> all I know about that is, when I pull from you
+<Sartak> before I pull any changesets
+<Sartak> I pull all of your resolutions
+<nothingmuch> resolution is a type of changeset?
+<Sartak> yes
+<Sartak> a special type of changeset
+<nothingmuch> *nod*
+<Sartak> (its is_resolution attribute is 1! :))
+<nothingmuch> are changesets dependent?
+<Sartak> nope
+<nothingmuch> not even theory of patches dependent?
+<Sartak> nope
+
+clarification: they *are* dependent in that when you pull changeset X from somebody, you will have changesets 1, 2, ..., X-1 already applied. but there are no explicit dependencies.
+
+<Sartak> they have a numeric id
+<nothingmuch> k
+<Sartak> resolutions are so weird that we have to keep a second replica inside your real replica just to keep track of everything
+<nothingmuch> aren't they just a CAS of conflicts -> changesets?
+<Sartak> theoretically? probably
+<Sartak> this is really shaky territory for me :)
+<nothingmuch> ok
+<Sartak> if you ask obra, ask him in email or irc so I can learn too :)
+<nothingmuch> so the self healing magic is that if you are going to have a conflict
+<nothingmuch> and the same identical conflict already has a resolution
+<nothingmuch> then you get the resolution too
+<nothingmuch> ?
+<Sartak> yes
+<Sartak> instead of one resolution
+<Sartak> there can actually be many different resolutions
+<Sartak> we choose whichever one occurred most
+<Sartak> okay
+<nothingmuch> how are conflicts compared for equality?
+<nothingmuch> just on data? or also on metadata?
+<Sartak> now I suddenly know a lot more about conflict resolution ;)
+<Sartak> looks like just data
+<Sartak> http://code.bestpractical.com/bps-public/Prophet/trunk/lib/Prophet/Resolver/FromResolutionDB.pm
+<Sartak> it's a page of code
+<Sartak> the conflict resolution engine is pluggable. when you use the command line, we prompt by default, though that can be changed
+<nothingmuch> so resolutions are retargetable to new data
+<nothingmuch> with the same type of conflict?
+<nothingmuch> e.g. if we have two human objects
+<Sartak> I hope not
+ * nothingmuch too ;-)
+<Sartak> I'm pretty sure the resolution knows which exactly changesets it's resolving
+<nothingmuch> ah, ok
+<nothingmuch> so the self healing buzz is mostly about which resolution to choose?
+<Sartak> yep
+<nothingmuch> k
+ * nothingmuch is much calmer now
+<nothingmuch> ;-)
+<Sartak> I'm also very happy it's not as complex as I feared
+<Sartak> this is all pretty sensible
+

Modified: Prophet/branches/dispatcher/lib/Prophet/App.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/App.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/App.pm	Tue Oct 21 11:50:28 2008
@@ -2,6 +2,7 @@
 use Moose;
 use Path::Class;
 use Prophet::Config;
+use Params::Validate qw/validate/;
 
 has handle => (
     is      => 'rw',
@@ -11,7 +12,7 @@
         my $self = shift;
         my $root = $ENV{'PROPHET_REPO'} || dir($ENV{'HOME'}, '.prophet');
         my $type = $self->default_replica_type;
-        return Prophet::Replica->new({ url => $type.':file://' . $root, app_handle => $self});
+        return Prophet::Replica->new({ url => $type.':file://' . $root, app_handle => $self, after_initialize => sub { $self->set_database_defaults} });
     },
 );
 
@@ -120,6 +121,41 @@
     return ( $INC{$path} ? 1 : 0);
 }
 
+
+sub set_database_defaults {
+    my $self = shift;
+    my $settings = $self->database_settings;
+    for my $name ( keys %$settings ) {
+        my @metadata = @{$settings->{$name}};
+        my $s = $self->setting(  label => $name, uuid => (shift @metadata), default => [@metadata]);
+        $s->initialize;
+    }
+}
+
+sub setting {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 0, default => 0, label => 0 } );
+    require Prophet::DatabaseSetting;
+
+    my  ($uuid, $default);
+
+    if ( $args{uuid} ) {
+        $uuid = $args{'uuid'};
+        $default = $args{'default'};
+    } elsif ( $args{'label'} ) {
+        ($uuid, $default) = @{ $self->database_settings->{ $args{'label'} }};
+    }
+    return Prophet::DatabaseSetting->new(
+        handle  => $self->handle,
+        uuid    => $uuid,
+        default => $default,
+        label   => $args{label}
+    );
+
+}
+
+sub database_settings {} # XXX wants a better name
+
 __PACKAGE__->meta->make_immutable;
 no Moose;
 

Added: Prophet/branches/dispatcher/lib/Prophet/CLI/TextEditorCommand.pm
==============================================================================
--- (empty file)
+++ Prophet/branches/dispatcher/lib/Prophet/CLI/TextEditorCommand.pm	Tue Oct 21 11:50:28 2008
@@ -0,0 +1,48 @@
+package Prophet::CLI::TextEditorCommand;
+use Moose::Role;
+use Params::Validate qw/validate/;
+
+sub try_to_edit {
+    my $self = shift;
+    my %args = validate( @_,
+        {   template => 1,
+            record   => 0,
+        });
+
+
+    my $template = ${ $args{template} };
+
+    # do the edit
+    my $updated = $self->edit_text($template);
+
+    die "Aborted.\n" if $updated eq $template;    # user didn't change anything
+
+    $self->process_template(
+        template => $args{template},
+        edited   => $updated,
+        record   => $args{record}
+    );
+}
+
+sub handle_template_errors {
+    my $self = shift;
+    my %args = validate( @_, { error => 1, template_ref => 1, bad_template => 1 } );
+
+    $self->prompt_Yn("Want to return back to editing?") || die "Aborted.\n";
+
+    ${ $args{'template_ref'} }
+        = "=== Your template contained errors ====\n\n"
+        . $args{error} . "\n\n"
+        . $args{bad_template};
+    return 0;
+}
+
+=head1 calling code must implement
+
+run
+process_template
+
+=cut
+
+no Moose::Role;
+1;

Modified: Prophet/branches/dispatcher/lib/Prophet/CLIContext.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/CLIContext.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/CLIContext.pm	Tue Oct 21 11:50:28 2008
@@ -102,7 +102,7 @@
     $self->clear_props();
 
     if ( my $cmd_args = $args{args} ) {
-        foreach my $arg ( keys %$cmd_args ) {
+        for my $arg ( keys %$cmd_args ) {
             if ( $arg eq 'uuid' ) {
                 $self->uuid( $cmd_args->{$arg} );
             }
@@ -110,7 +110,7 @@
         }
     }
     if ( my $props = $args{props} ) {
-        foreach my $prop (@$props) {
+        for my $prop (@$props) {
             my $key   = $prop->{prop};
             my $value = $prop->{value};
             $self->set_prop( $key => $value );

Modified: Prophet/branches/dispatcher/lib/Prophet/Change.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Change.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Change.pm	Tue Oct 21 11:50:28 2008
@@ -183,7 +183,7 @@
     my $hashref = shift;
     my $self    = $class->new(
         { record_type => $hashref->{'record_type'}, record_uuid => $uuid, change_type => $hashref->{'change_type'} } );
-    foreach my $prop ( keys %{ $hashref->{'prop_changes'} } ) {
+    for my $prop ( keys %{ $hashref->{'prop_changes'} } ) {
         $self->add_prop_change(
             name => $prop,
             old  => $hashref->{'prop_changes'}->{$prop}->{'old_value'},

Modified: Prophet/branches/dispatcher/lib/Prophet/ChangeSet.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/ChangeSet.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/ChangeSet.pm	Tue Oct 21 11:50:28 2008
@@ -178,7 +178,7 @@
     my $hashref = shift;
     my $self    = $class->new( { map { $_ => $hashref->{$_} } @SERIALIZE_PROPS } );
 
-    foreach my $change ( keys %{ $hashref->{changes} } ) {
+    for my $change ( keys %{ $hashref->{changes} } ) {
         $self->add_change( change => Prophet::Change->new_from_hashref( $change => $hashref->{changes}->{$change} ) );
     }
     return $self;

Modified: Prophet/branches/dispatcher/lib/Prophet/Collection.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Collection.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Collection.pm	Tue Oct 21 11:50:28 2008
@@ -80,7 +80,7 @@
 
     # run coderef against each item;
     # if it matches, add it to items
-    foreach my $key (@$records) {
+    for my $key (@$records) {
         my $record = $self->record_class->new( { app_handle => $self->app_handle,  handle => $self->handle, type => $self->type } );
         $record->load( uuid => $key );
         if ( $coderef->($record) ) {

Added: Prophet/branches/dispatcher/lib/Prophet/DatabaseSetting.pm
==============================================================================
--- (empty file)
+++ Prophet/branches/dispatcher/lib/Prophet/DatabaseSetting.pm	Tue Oct 21 11:50:28 2008
@@ -0,0 +1,69 @@
+package Prophet::DatabaseSetting;
+use Moose;
+extends 'Prophet::Record';
+use Params::Validate;
+use JSON;
+
+has default => (
+    is => 'ro'
+);
+
+has label => (
+    isa => 'Maybe[Str]',
+    is => 'rw' 
+);
+
+
+sub new { 
+        my $self = shift->SUPER::new( type => '__prophet_db_settings', @_);
+
+    $self->initialize unless ($self->handle->record_exists(uuid => $self->uuid, type => $self->type) );
+    return $self;
+    }
+
+
+sub initialize {
+    my $self = shift;
+    $self->set($self->default);
+}
+
+sub set {
+    my $self = shift;
+    my $entry;
+    if (exists $_[1]  || !ref($_[0]))  {
+        $entry = [@_];
+    } else { 
+        $entry = shift @_;
+    }
+       my  $content = to_json($entry, { canonical => 1, pretty=> 0, utf8=>1, allow_nonref => 0}  );
+    
+    
+    if ($self->handle->record_exists( uuid => $self->uuid, type => $self->type)) {
+        $self->set_props( props => { content => $content, label => $self->label});
+    } else {
+        $self->_create_record( props => { content => $content, label => $self->label }, uuid => $self->uuid );
+    }
+}
+
+
+
+sub get_raw {
+    my $self = shift;
+    my $content = $self->prop('content');
+    return $content;
+}
+
+sub get {
+    my $self = shift;
+
+    $self->initialize() unless $self->load(uuid => $self->uuid);
+    my $content = $self->get_raw;
+
+    my $entry = from_json($content , { utf8 => 1 });
+    return $entry;
+    # XXX TODO do we really want to just get the first one?
+
+}
+1;
+
+

Modified: Prophet/branches/dispatcher/lib/Prophet/Record.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Record.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Record.pm	Tue Oct 21 11:50:28 2008
@@ -218,8 +218,14 @@
     $self->default_props($args{'props'});
     $self->canonicalize_props( $args{'props'} );
     $self->validate_props( $args{'props'} ) or return undef;
+    $self->_create_record( props => $args{props}, uuid => $uuid);
+}
+
+sub _create_record {
+    my $self = shift;
+    my %args = validate( @_, { props => 1, uuid => 1 } );
 
-    $self->uuid($uuid);
+    $self->uuid($args{uuid});
 
     $self->handle->create_record(
         props => $args{'props'},
@@ -228,8 +234,10 @@
     );
 
     return $self->uuid;
+
 }
 
+
 =head2 load { uuid => $UUID } or { luid => $UUID }
 
 Loads a Prophet record off disk by its uuid or luid.
@@ -607,7 +615,7 @@
     my $props = $self->get_props;
 
     my @out;
-    foreach my $atom ($self->_atomize_summary_format) {
+    for my $atom ($self->_atomize_summary_format) {
         my %atom_data;
         my ($format, $prop, $value);
 

Modified: Prophet/branches/dispatcher/lib/Prophet/Replica.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Replica.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Replica.pm	Tue Oct 21 11:50:28 2008
@@ -58,6 +58,12 @@
     predicate => 'has_app_handle',
 );
 
+has after_initialize => ( 
+    is => 'ro',
+    isa => 'CodeRef',
+    default => sub { sub {1} } # default returns a coderef
+    );
+
 our $MERGETICKET_METATYPE = '_merge_tickets';
 
 =head1 NAME
@@ -418,7 +424,7 @@
     my ( $self, $changeset ) = @_;
 
     my @new_changes;
-    foreach my $change ($changeset->changes) {
+    for my $change ($changeset->changes) {
             # when would we run into resolution records in a nonresdb? XXX
             next if ($change->record_type eq '_prophet_resolution' && !$self->is_resdb);
 

Modified: Prophet/branches/dispatcher/lib/Prophet/Replica/prophet.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Replica/prophet.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Replica/prophet.pm	Tue Oct 21 11:50:28 2008
@@ -210,7 +210,7 @@
 
 =head2 BUILD
 
-Open a connection to the SVN source identified by C<$self->url>.
+Open a connection to the prophet replica source identified by C<$self->url>.
 
 =cut
 
@@ -278,7 +278,7 @@
         die "We can only create file: based prophet replicas. It looks like you're trying to create " . $self->url;
     } else {
         die "Prophet couldn't find a replica at \"".$self->url."\"\n\n".
-            "Please check the number and dial again.\n";
+            "Please check the URL and try again.\n";
         
     }
 
@@ -306,6 +306,7 @@
         path    => 'replica-version',
         content => '1'
     );
+    $self->after_initialize->($self);
 }
 
 sub latest_sequence_no {
@@ -529,7 +530,6 @@
 
     my ($seq,$key) = $self->_read_record_index_entry( type => $args{'type'}, uuid => $args{'uuid'});
 
-
     return undef unless ($key and ($key ne '0'x40));
     # XXX: deserialize the changeset content from the cas with $key
     my $casfile = file(
@@ -671,7 +671,7 @@
     my $changeset_index = $self->_read_changeset_index();
 
     my @changesets;
-    foreach my $item (@record_index) {
+    for my $item (@record_index) {
         my $sequence = $item->[0];
         push @changesets, $self->_get_changeset_index_entry( sequence_no => $sequence, index_file => $changeset_index);
     }
@@ -886,7 +886,7 @@
         }
     );
 
-    foreach my $name ( keys %{ $args{props} } ) {
+    for my $name ( keys %{ $args{props} } ) {
         $change->add_prop_change(
             name => $name,
             old  => undef,
@@ -933,7 +933,7 @@
         type => $args{'type'}
     );
     my %new_props = %$old_props;
-    foreach my $prop ( keys %{ $args{props} } ) {
+    for my $prop ( keys %{ $args{props} } ) {
         if ( !defined $args{props}->{$prop} ) {
             delete $new_props{$prop};
         } else {
@@ -953,7 +953,7 @@
         }
     );
 
-    foreach my $name ( keys %{ $args{props} } ) {
+    for my $name ( keys %{ $args{props} } ) {
         $change->add_prop_change(
             name => $name,
             old  => $old_props->{$name},

Modified: Prophet/branches/dispatcher/lib/Prophet/Replica/svn.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Replica/svn.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Replica/svn.pm	Tue Oct 21 11:50:28 2008
@@ -342,7 +342,7 @@
     my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );
 
     my $file = $self->_file_for( uuid => $args{uuid}, type => $args{type} );
-    foreach my $prop ( keys %{ $args{'props'} } ) {
+    for my $prop ( keys %{ $args{'props'} } ) {
         eval {
             local $SIG{__DIE__} = 'DEFAULT';
             $self->current_edit->root->change_node_prop( $file, $prop, $args{'props'}->{$prop}, undef )

Modified: Prophet/branches/dispatcher/lib/Prophet/ReplicaExporter.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/ReplicaExporter.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/ReplicaExporter.pm	Tue Oct 21 11:50:28 2008
@@ -99,7 +99,7 @@
     my $self = shift;
 
     my $cs_file = $self->target_replica->_get_changeset_index_handle();
-    foreach my $changeset (
+    for my $changeset (
         @{ $self->source_replica->fetch_changesets( after => 0 ) } )
     {
         $self->target_replica->_write_changeset(

Modified: Prophet/branches/dispatcher/lib/Prophet/Resolver/FromResolutionDB.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Resolver/FromResolutionDB.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Resolver/FromResolutionDB.pm	Tue Oct 21 11:50:28 2008
@@ -1,6 +1,7 @@
 package Prophet::Resolver::FromResolutionDB;
 use Moose;
 use Prophet::Change;
+use Prophet::Collection;
 use JSON;
 use Digest::SHA1 'sha1_hex';
 extends 'Prophet::Resolver';
@@ -11,6 +12,8 @@
     my $conflict           = shift;
     my $resdb              = shift;    # XXX: we want diffrent collection actually now
 
+    require Prophet::Collection;
+
     my $res = Prophet::Collection->new(
         handle => $resdb,
         # XXX TODO PULL THIS TYPE FROM A CONSTANT

Modified: Prophet/branches/dispatcher/lib/Prophet/Test.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Test.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Test.pm	Tue Oct 21 11:50:28 2008
@@ -113,7 +113,7 @@
 sub run_ok {
     my $script = shift;
     my $args   = shift if ( ref $_[0] eq 'ARRAY' );
-    my $msg    = shift if (@_);
+    my $msg    = (@_) ? shift : '';
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 

Modified: Prophet/branches/dispatcher/lib/Prophet/Test/Arena.pm
==============================================================================
--- Prophet/branches/dispatcher/lib/Prophet/Test/Arena.pm	(original)
+++ Prophet/branches/dispatcher/lib/Prophet/Test/Arena.pm	Tue Oct 21 11:50:28 2008
@@ -146,8 +146,8 @@
     my @chickens_a = shuffle $self->chickens;
     my @chickens_b = shuffle $self->chickens;
 
-    foreach my $a (@chickens_a) {
-        foreach my $b (@chickens_b) {
+    for my $a (@chickens_a) {
+        for my $b (@chickens_b) {
             next if $a->name eq $b->name;
             diag( $a->name, $b->name );
             as_user( $a->name, sub { $a->sync_from_peer( { from => $b->name } ) } );

Modified: Prophet/branches/dispatcher/t/01-dependencies.t
==============================================================================
--- Prophet/branches/dispatcher/t/01-dependencies.t	(original)
+++ Prophet/branches/dispatcher/t/01-dependencies.t	Tue Oct 21 11:50:28 2008
@@ -14,7 +14,7 @@
 use File::Find;
 eval 'use Module::CoreList';
 if ($@) { plan skip_all => 'Module::CoreList not installed' }
-if (! -d 'inc/.author') { plan skip_all => 'These tests only run for module auhtors'}
+if (! -d 'inc/.author') { plan skip_all => 'These tests only run for module authors'}
 
 plan 'no_plan';
 

Added: Prophet/branches/dispatcher/t/database-settings.t
==============================================================================
--- (empty file)
+++ Prophet/branches/dispatcher/t/database-settings.t	Tue Oct 21 11:50:28 2008
@@ -0,0 +1,165 @@
+package MyApp::Model::Task;
+use Moose;
+extends 'Prophet::Record';
+use Prophet::DatabaseSetting;
+
+
+sub new { 
+    shift->SUPER::new(type => 'task', @_);
+}
+use constant type => 'task';
+
+sub status_list {
+    my $self = shift;
+    return Prophet::DatabaseSetting->new( handle => $self->handle, uuid => '5F7F1F51-7CD5-4AF7-A347-1FEE15082A5D');
+}
+
+sub component_list {
+    my $self = shift;
+    return Prophet::DatabaseSetting->new(  handle => $self->handle, uuid => 'D4051774-6AEC-4976-A54E-F19C424879B2');
+}
+
+sub default_component {
+    my $self = shift;
+    return Prophet::DatabaseSetting->new( handle => $self->handle,  uuid => 'B379D747-CB1D-4F69-839B-8E93E0FA3DD4');
+}
+
+package main;
+use warnings;
+use strict;
+
+use Prophet::Test 'no_plan';
+
+my ( $alice_cli, $bob_cli );
+
+as_alice {
+
+    #create a repo
+    $alice_cli = Prophet::CLI->new();
+    my $cxn = $alice_cli->handle;
+    isa_ok( $cxn, 'Prophet::Replica', "Got the cxn " . $cxn->fs_root );
+
+    # set up an app model class, "ticket"
+    my $t = MyApp::Model::Task->new(handle => $alice_cli->app_handle->handle);
+    # set default values for status 
+    my $status_list = $t->status_list;
+
+    my $comp_list = $t->component_list;
+    my $default_comp = $t->default_component;
+
+    isa_ok($status_list, 'Prophet::DatabaseSetting');
+   
+    can_ok($status_list, 'set');
+    can_ok($status_list, 'get');
+
+    # set list of acceptable components
+    $comp_list->set([qw/core ui docs/]); 
+
+
+    # set default values for component
+    $default_comp->set('core'); 
+
+
+    # set list of acceptable statuses
+    $status_list->set('new','open','closed'); 
+
+    # enumerate statuses
+    is_deeply($status_list->get, [qw/new open closed/]);
+
+    $status_list->set('new', 'closed');
+
+    is_deeply($status_list->get, [qw/new closed/]);
+
+    # enumerate components
+    is_deeply($t->component_list->get, [qw/core ui docs/]);
+    
+    # enumerate default component
+    is_deeply($t->default_component->get, ['core'], "The thing we got was core");
+  
+   
+    # 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" );
+
+
+};
+
+as_bob {
+    $bob_cli = Prophet::CLI->new();
+    my $cxn = $bob_cli->handle;
+    isa_ok( $cxn, 'Prophet::Replica', "Got the cxn " . $cxn->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 .)], [qr/open/], " Found our record" );
+
+    # pull from alice
+    run_ok( 'prophet', ['pull', '--from', "file://".$alice_cli->app_handle->handle->fs_root, '--force'] );
+    
+
+    my $t = MyApp::Model::Task->new(handle => $bob_cli->app_handle->handle);
+    
+    # enumerate statuses
+    is_deeply($t->status_list->get, [qw/new closed/]);
+
+    # enumerate components
+    is_deeply($t->component_list->get, [qw/core ui docs/]);
+    
+    # enumerate default component
+    is_deeply($t->default_component->get, ['core'], "The thing we got was core");
+ 
+    $t->default_component->set('ui');
+
+    is_deeply($t->default_component->get, ['ui'], "The thing we got was core");
+};
+
+as_alice {
+    $alice_cli = Prophet::CLI->new();
+    my $cxn = $alice_cli->handle;
+    isa_ok( $cxn, 'Prophet::Replica', "Got the cxn " . $cxn->fs_root );
+    
+    my $t = MyApp::Model::Task->new(handle => $alice_cli->app_handle->handle);
+    is_deeply($t->default_component->get, ['core'], "The thing we got was core");
+    run_ok( 'prophet', ['pull', '--from', "file://".$bob_cli->app_handle->handle->fs_root, '--force'] );
+    is_deeply($t->default_component->get, ['ui'], "The thing we got was core");
+
+    #   add a status
+    $t->status_list->set(qw/new open stalled resolved/);
+    
+    
+    };
+
+as_bob {
+    my $t = MyApp::Model::Task->new(handle => $bob_cli->app_handle->handle);
+    $t->status_list->set(qw/new open resolved rejected/);
+
+};
+
+as_bob {
+
+    #   pull from alice
+    run_ok( 'prophet', ['pull', '--from', "file://".$alice_cli->app_handle->handle->fs_root, '--force', '--prefer', 'to'] );
+    # enumerate statuses
+    my $t = MyApp::Model::Task->new(handle => $bob_cli->app_handle->handle);
+    TODO: { 
+    local $TODO = "we don't resolve config conflicts yet";
+    is_deeply($t->status_list->get, [qw[new open stalled resolved rejected]]);
+};
+    # current behaviour
+    is_deeply($t->status_list->get, [qw[new open resolved rejected]]);
+};
+
+as_alice {
+
+    #    pull from bob
+    run_ok( 'prophet', ['pull', '--from', "file://".$bob_cli->app_handle->handle->fs_root, '--force'] );
+    # enumerate statuses
+    my $t = MyApp::Model::Task->new(handle => $bob_cli->app_handle->handle);
+    TODO: { 
+    local $TODO = "we don't resolve config conflicts yet";
+    is_deeply($t->status_list->get, [qw[new open stalled resolved rejected]]);
+};
+    # current behaviour
+    is_deeply($t->status_list->get, [qw[new open resolved rejected]]);
+};
+
+1;



More information about the Bps-public-commit mailing list