[Bps-public-commit] r17277 - in Prophet/trunk: . lib/Prophet/CLI lib/Prophet/Replica t

sunnavy at bestpractical.com sunnavy at bestpractical.com
Wed Dec 17 16:49:18 EST 2008


Author: sunnavy
Date: Wed Dec 17 16:49:18 2008
New Revision: 17277

Added:
   Prophet/trunk/lib/Prophet/Replica/sqlite.pm
Modified:
   Prophet/trunk/   (props changed)
   Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm
   Prophet/trunk/lib/Prophet/Replica.pm
   Prophet/trunk/lib/Prophet/Replica/prophet.pm
   Prophet/trunk/t/canonicalize.t
   Prophet/trunk/t/config.t
   Prophet/trunk/t/create.t
   Prophet/trunk/t/database-settings.t
   Prophet/trunk/t/default.t
   Prophet/trunk/t/edit.t
   Prophet/trunk/t/export.t
   Prophet/trunk/t/history.t
   Prophet/trunk/t/luid.t
   Prophet/trunk/t/publish-html.t
   Prophet/trunk/t/publish-pull.t
   Prophet/trunk/t/resty-server.t
   Prophet/trunk/t/validate.t

Log:
merge sqlite branch

Modified: Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm	(original)
+++ Prophet/trunk/lib/Prophet/CLI/PublishCommand.pm	Wed Dec 17 16:49:18 2008
@@ -3,7 +3,7 @@
 
 use File::Temp ();
 
-sub tempdir { my $dir = File::Temp::tempdir(CLEANUP => 0); warn $dir; return $dir; }
+sub tempdir { my $dir = File::Temp::tempdir(CLEANUP => ! $ENV{PROPHET_DEBUG} ); warn $dir; return $dir; }
 
 sub publish_dir {
     my $self = shift;

Modified: Prophet/trunk/lib/Prophet/Replica.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica.pm	(original)
+++ Prophet/trunk/lib/Prophet/Replica.pm	Wed Dec 17 16:49:18 2008
@@ -639,7 +639,7 @@
     my $self    = shift;
     my $path    = shift;
     my $default = shift;
-    my $json = $self->read_userdata_file( path => $path ) || $default;
+    my $json = $self->read_userdata( path => $path ) || $default;
     require JSON;
     return JSON::from_json($json, { utf8 => 1 });
 }
@@ -660,7 +660,7 @@
     require JSON;
     my $content = JSON::to_json($value, { canonical => 1, pretty => 0, utf8 => 1 });
 
-    $self->write_userdata_file(
+    $self->write_userdata(
         path    => $path,
         content => $content,
     );

Modified: Prophet/trunk/lib/Prophet/Replica/prophet.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica/prophet.pm	(original)
+++ Prophet/trunk/lib/Prophet/Replica/prophet.pm	Wed Dec 17 16:49:18 2008
@@ -12,6 +12,8 @@
 use Prophet::Util;
 use JSON;
 use POSIX qw();
+use Memoize;
+
 
 has '+db_uuid' => (
     lazy    => 1,
@@ -448,9 +450,9 @@
     close $record_index;
 }
 
-sub _read_record_index_entry {
+sub _last_record_index_entry {
     my $self = shift;
-    my %args = validate( @_, { type => 1, uuid => 1 } );
+    my %args = ( type => undef, uuid => undef, @_);
 
     my $idx_filename = File::Spec->catfile(
         $self->fs_root => $self->_record_index_filename( uuid => $args{uuid}, type => $args{type})
@@ -465,10 +467,6 @@
 
 }
 
-
-
-
-
 sub _read_record_index {
     my $self = shift;
     my %args = validate( @_, { type => 1, uuid => 1 } );
@@ -517,13 +515,11 @@
     return from_json( $self->_read_file($casfile), { utf8 => 1 } );
 }
 
+memoize '_record_index_filename';
 sub _record_index_filename {
     my $self = shift;
     my %args = validate( @_, { uuid => 1, type => 1 } );
-    return File::Spec->catfile(
-        $self->_record_type_root( $args{'type'} ),
-        $self->_hashed_dir_name( $args{uuid} )
-    );
+    return File::Spec->catfile( $self->_record_type_dir( $args{'type'} ), $self->_hashed_dir_name( $args{uuid} ));
 }
 
 sub _hashed_dir_name {
@@ -535,23 +531,18 @@
 
 sub _record_cas_filename {
     my $self = shift;
-    my %args = validate( @_, { type => 1, uuid => 1 } );
+    my %args = ( type => undef, uuid => undef, @_) ;
 
-    my ( $seq, $key ) = $self->_read_record_index_entry(
+    my ( $seq, $key ) = $self->_last_record_index_entry(
         type => $args{'type'},
         uuid => $args{'uuid'}
     );
 
     return undef unless ( $key and ( $key ne '0' x 40 ) );
-
-    # XXX: deserialize the changeset content from the cas with $key
-    my $casfile = File::Spec->catfile( $self->record_cas_dir,
-        $self->_hashed_dir_name($key) );
-
-    return $casfile;
+    return File::Spec->catfile( $self->record_cas_dir, $self->_hashed_dir_name($key) );
 }
 
-sub _record_type_root {
+sub _record_type_dir {
     my $self = shift;
     my $type = shift;
     return File::Spec->catdir( $self->record_dir, $type );
@@ -1017,10 +1008,9 @@
         = map { my @path = split( qr'/', $_ ); pop @path }
         File::Find::Rule->file->maxdepth(3)->in(
         File::Spec->catdir(
-            $self->fs_root => $self->_record_type_root( $args{'type'} )
+            $self->fs_root => $self->_record_type_dir( $args{'type'} )
         )
         );
-
     return [
         grep {
             $self->_record_cas_filename( type => $args{'type'}, uuid => $_ )
@@ -1040,7 +1030,7 @@
 sub type_exists {
     my $self = shift;
     my %args = validate( @_, { type => 1 } );
-    return $self->_file_exists( $self->_record_type_root( $args{'type'} ) );
+    return $self->_file_exists( $self->_record_type_dir( $args{'type'} ) );
 }
 
 =head2 read_userdata_file
@@ -1050,7 +1040,7 @@
 
 =cut
 
-sub read_userdata_file {
+sub read_userdata {
     my $self = shift;
     my %args = validate( @_, { path => 1 } );
 
@@ -1058,13 +1048,13 @@
         File::Spec->catfile( $self->userdata_dir, $args{path} ) );
 }
 
-=head2 write_userdata_file
+=head2 write_userdata
 
 Writes the given string to the given file in this replica's userdata directory.
 
 =cut
 
-sub write_userdata_file {
+sub write_userdata {
     my $self = shift;
     my %args = validate( @_, { path => 1, content => 1 } );
 

Added: Prophet/trunk/lib/Prophet/Replica/sqlite.pm
==============================================================================
--- (empty file)
+++ Prophet/trunk/lib/Prophet/Replica/sqlite.pm	Wed Dec 17 16:49:18 2008
@@ -0,0 +1,695 @@
+package Prophet::Replica::sqlite;
+use Moose;
+extends 'Prophet::Replica';
+use Params::Validate qw(:all);
+use File::Spec  ();
+use Data::UUID;
+use File::Path;
+use Prophet::Util;
+use DBI;
+
+has dbh => (
+    is => 'rw',
+    isa     => 'DBI::db',
+    lazy => 1,
+    default => sub {
+        my $self = shift;
+        DBI->connect( "dbi:SQLite:" . $self->db_file , undef, undef, {RaiseError =>1, AutoCommit => 1 });
+     }
+    );
+
+sub db_file { shift->fs_root ."/db.sqlite"}
+
+has '+db_uuid' => (
+    lazy    => 1,
+    default => sub { shift->_fetch_metadata('database-uuid') },
+);
+
+has _uuid => ( is => 'rw', );
+
+has replica_version => (
+    is      => 'ro',
+    writer  => '_set_replica_version',
+    isa     => 'Int',
+    lazy    => 1,
+    default => sub { shift->_fetch_metadata('replica-version') || 0 }
+);
+
+has fs_root_parent => (
+    is      => 'rw',
+    lazy    => 1,
+    default => sub {
+        my $self = shift;
+        return $self->url =~ m{^sqlite:file://(.*)/.*?$} ? $1 : undef;
+    }
+);
+
+has fs_root => (
+    is      => 'rw',
+    lazy    => 1,
+    default => sub {
+        my $self = shift;
+        return $self->url =~ m{^sqlite:file://(.*)$} ? $1 : undef;
+    },
+);
+
+has current_edit => ( is => 'rw', );
+
+has current_edit_records => (
+    metaclass => 'Collection::Array',
+    is        => 'rw',
+    isa       => 'ArrayRef',
+    default   => sub { [] },
+);
+
+has '+resolution_db_handle' => (
+    isa     => 'Prophet::Replica | Undef',
+    lazy    => 1,
+    default => sub {
+        my $self = shift;
+        return if $self->is_resdb || $self->is_state_handle;
+        return Prophet::Replica->new(
+            {   url        => $self->url . '/resolutions',
+                app_handle => $self->app_handle,
+                is_resdb   => 1,
+            }
+        );
+    },
+);
+
+
+
+use constant scheme   => 'sqlite';
+use constant userdata_dir    => 'userdata';
+sub BUILD {
+    my $self = shift;
+    my $args = shift;
+    Carp::cluck() unless ( $args->{app_handle} );
+    for ( $self->{url} ) {
+        #s/^sqlite://;    # url-based constructor in ::replica should do better
+        s{/$}{};
+    }
+        
+    
+
+}
+
+sub state_handle { return shift; }
+
+sub __fetch_data {
+    my $self = shift;
+    my $table = shift;
+    my $key = shift;
+
+    my $sth = $self->dbh->prepare("SELECT value FROM $table WHERE key = ?");
+    $sth->execute($key);
+       
+    my $results = $sth->fetchrow_arrayref;
+    return $results?$results->[0] : undef;
+}
+
+sub __store_data {
+    my $self = shift;
+    my %args = ( key => undef, value => undef, table => undef, @_);
+    $self->dbh->do("DELETE FROM $args{table} WHERE key = ?", {},$args{key});
+    $self->dbh->do("INSERT INTO $args{table} (key,value) VALUES(?,?)", {}, $args{key}, $args{value});
+    
+}
+
+sub _fetch_metadata {
+    my $self = shift;
+    my $key = shift;
+    return $self->__fetch_data( 'local_metadata', $key );
+}
+
+sub _store_metadata {
+    my $self = shift;
+    $self->__store_data( table => 'local_metadata', @_ );
+}
+
+sub _fetch_userdata {
+    my $self = shift;
+    my $key = shift;
+    return $self->__fetch_data( 'userdata', $key );
+}
+
+sub _store_userdata {
+    my $self = shift;
+    $self->__store_data( table => 'userdata', @_ );
+}
+
+=head2 replica_exists
+
+Returns true if the replica already exists / has been initialized.
+Returns false otherwise.
+
+=cut
+
+sub replica_exists {
+    my $self = shift;
+    return -f $self->db_file ? 1 : 0;
+}
+
+=head2 set_replica_version
+
+Sets the replica's version to the given integer.
+
+=cut
+
+sub set_replica_version {
+    my $self    = shift;
+    my $version = shift;
+
+    $self->_set_replica_version($version);
+
+    $self->_store_metadata( key   => 'replica-version', value => $version,);
+
+    return $version;
+}
+
+sub can_initialize {
+    my $self = shift;
+    if ( $self->fs_root_parent && -w $self->fs_root_parent ) {
+        return 1;
+
+    }
+    return 0;
+}
+
+use constant can_read_records    => 1;
+use constant can_read_changesets => 1;
+sub can_write_changesets {1}
+sub can_write_records    {1}
+
+sub initialize {
+    my $self = shift;
+    my %args = validate(
+        @_,
+        {   db_uuid    => 0,
+            resdb_uuid => 0,
+        }
+    );
+
+
+    if ( !$self->fs_root_parent ) {
+
+        if ( $self->can_write_changesets ) {
+            die
+                "We can only create local 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 URL and try again.\n";
+
+        }
+    }
+
+    return if $self->replica_exists;
+    mkpath([$self->fs_root]);
+    #$self->dbh->begin_work;
+for (
+
+q{
+CREATE TABLE records (
+    uuid text,
+    type text
+)
+},
+q{
+CREATE TABLE record_props (
+    uuid text,
+    prop text,
+    value text 
+)
+
+}, q{
+CREATE TABLE changesets (
+    sequence_no INTEGER PRIMARY KEY AUTOINCREMENT,
+    creator text,
+    created text,
+    is_nullification boolean,
+    is_resolution boolean,
+
+    original_source_uuid text,
+    original_sequence_no INTEGER
+)
+}, q{
+CREATE TABLE changes (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    record text,
+    changeset integer, 
+    change_type text,
+    record_type text
+)
+}, q{
+CREATE TABLE prop_changes (
+    change integer,
+    name text,
+    old_value text,
+    new_value text
+)
+}, q{
+CREATE TABLE local_metadata (
+    key text,
+    value text
+
+)
+}, q{
+CREATE TABLE userdata (
+    key text,
+    value text
+)
+}) {
+        $self->dbh->do($_) || warn $self->dbh->errstr;
+    }
+
+    $self->set_db_uuid( $args{'db_uuid'} || Data::UUID->new->create_str );
+    $self->set_replica_uuid( Data::UUID->new->create_str );
+    $self->set_replica_version(1);
+    $self->resolution_db_handle->initialize( db_uuid => $args{resdb_uuid} ) if !$self->is_resdb;
+    $self->after_initialize->($self);
+}
+
+sub latest_sequence_no {
+    my $self = shift;
+
+    my $sth = $self->dbh->prepare("SELECT MAX(sequence_no) FROM changesets");
+    $sth->execute();
+    return $sth->fetchrow_array || 0;
+}
+
+=head2 uuid
+
+Return the replica  UUID
+
+=cut
+
+sub uuid {
+    my $self = shift;
+    $self->_uuid( $self->_fetch_metadata('replica-uuid') ) unless $self->_uuid;
+    return $self->_uuid;
+}
+
+sub set_replica_uuid {
+    my $self = shift;
+    my $uuid = shift;
+    $self->_store_metadata(
+        key    => 'replica-uuid',
+        value => $uuid
+    );
+
+}
+
+before set_db_uuid => sub {
+    my $self = shift;
+    my $uuid = shift;
+    $self->_store_metadata(
+        key    => 'database-uuid',
+        value => $uuid
+    );
+};
+
+=head1 Internals of record handling
+
+=cut
+
+sub _write_record {
+    my $self   = shift;
+    my %args   = validate( @_, { record => { isa => 'Prophet::Record' }, } );
+    my $record = $args{'record'};
+
+    $self->_write_record_to_db(
+        type  => $record->type,
+        uuid  => $record->uuid,
+        props => $record->get_props,
+    );
+}
+
+sub _write_record_to_db {
+    my $self = shift;
+    my %args = validate( @_, { type => 1, uuid => 1, props => 1 } );
+
+    for ( keys %{ $args{'props'} } ) {
+        delete $args{'props'}->{$_}
+            if ( !defined $args{'props'}->{$_} || $args{'props'}->{$_} eq '' );
+    }
+
+    # We're in a transaction here, right?
+    $self->_delete_record_from_db( uuid => $args{uuid} ) if
+        $self->record_exists( uuid => $args{uuid}, type => $args{type} );
+    $self->dbh->do( "INSERT INTO records (type, uuid) VALUES (?,?)", {},
+        $args{type}, $args{uuid} );
+    $self->dbh->do(
+        "INSERT INTO record_props (uuid, prop, value) VALUES (?,?,?)", {},
+        $args{uuid}, $_, $args{props}->{$_} )
+    for ( keys %{ $args{props} } );
+
+}
+
+sub _delete_record_from_db {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 1 } );
+
+    $self->dbh->do("DELETE FROM records where uuid = ?", {},$args{uuid});
+    $self->dbh->do("DELETE FROM record_props where uuid = ?", {}, $args{uuid});
+
+}
+
+=head2 traverse_changesets { after => SEQUENCE_NO, callback => sub { } } 
+
+Walks through all changesets after $after, calling $callback on each.
+
+
+=cut
+
+sub traverse_changesets {
+    my $self = shift;
+    my %args = validate(
+        @_,
+        {   after    => 1,
+            callback => 1,
+        }
+    );
+
+    my $first_rev = ( $args{'after'} + 1 ) || 1;
+    my $latest = $self->latest_sequence_no();
+
+    $self->log("Traversing changesets between $first_rev and $latest");
+    for my $rev ( $first_rev .. $latest ) {
+        $self->log("Fetching changeset $rev");
+        my $changeset = $self->_load_changeset_from_db( sequence_no => $rev,);
+        $args{callback}->($changeset);
+    }
+}
+
+=head2 changesets_for_record { uuid => $uuid, type => $type }
+
+Returns an ordered set of changeset objects for all changesets containing
+changes to this object. 
+
+Note that changesets may include changes to other records
+
+=cut
+
+sub changesets_for_record {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 1, type => 1 } );
+
+    my $sth = $self->dbh->prepare( "SELECT DISTINCT changesets.* "
+            . "FROM changes, changesets "
+            . "WHERE  changesets.sequence_no = changes.changeset "
+            . "AND changes.record = ?"
+        );
+
+    require Prophet::ChangeSet;
+    $sth->execute( $args{uuid} );
+
+    my @changesets;
+
+    while ( my $cs = $sth->fetchrow_hashref() ) {
+        push @changesets, $self->_instantiate_changeset_from_db($cs);
+
+    }
+    return @changesets;
+}
+
+sub _load_changeset_from_db {
+    my $self = shift;
+    my %args = validate( @_, {   sequence_no          => 1 });
+
+
+    my $sth = $self->dbh->prepare("SELECT creator, created, sequence_no, ".
+                                  "original_source_uuid, original_sequence_no, ".
+                                  "is_nullification, is_resolution from changesets ".
+                                  "WHERE sequence_no = ?");
+            $sth->execute($args{sequence_no});
+
+
+    my $data = $sth->fetchrow_hashref;
+    return $self->_instantiate_changeset_from_db($data);
+}
+
+sub _instantiate_changeset_from_db {
+    my $self = shift;
+    my $data = shift;
+    require Prophet::ChangeSet;
+    my $changeset = Prophet::ChangeSet->new(%$data, source_uuid => $self->uuid );
+
+    
+    my $sth = $self->dbh->prepare("SELECT id, record, change_type, record_type from changes WHERE changeset = ?");
+    $sth->execute($changeset->sequence_no);
+    while (my $row = $sth->fetchrow_hashref) {
+        my $change_id = delete $row->{id};
+        my $record_type = delete $row->{record_type};
+
+        my $change = Prophet::Change->new( record_uuid => $row->{record},
+                change_type => $row->{change_type}, record_type => $record_type );
+        my $propchange_sth = $self->dbh->prepare("SELECT name, old_value, new_value FROM prop_changes WHERE change = ?");
+        $propchange_sth->execute($change_id);
+        while (my $pc = $propchange_sth->fetchrow_hashref) {
+            $change->add_prop_change( name => $pc->{name}, old => $pc->{old_value}, new => $pc->{new_value});
+        }
+        push @{$changeset->changes}, $change;
+    }
+
+    return $changeset;
+}
+
+sub begin_edit {
+    my $self = shift;
+    my %args = validate( @_, {   source => 0,    # the changeset that we're replaying, if applicable
+        });
+
+    my $source = $args{source};
+
+    my $creator = $source ? $source->creator : $self->changeset_creator;
+    my $created = $source && $source->created;
+
+    require Prophet::ChangeSet;
+    my $changeset = Prophet::ChangeSet->new( {   source_uuid => $self->uuid, creator     => $creator, $created ? ( created => $created ) : (), });
+    
+    $self->current_edit($changeset);
+    $self->current_edit_records( [] );
+    $self->dbh->begin_work;
+
+}
+
+sub _set_original_source_metadata_for_current_edit {
+    my $self = shift;
+    my ($changeset) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );
+
+    $self->current_edit->original_source_uuid( $changeset->original_source_uuid );
+    $self->current_edit->original_sequence_no( $changeset->original_sequence_no );
+}
+
+sub commit_edit {
+    my $self     = shift;
+    $self->current_edit->original_source_uuid( $self->uuid ) unless ( $self->current_edit->original_source_uuid );
+
+
+    my $local_id = $self->_write_changeset_to_db($self->current_edit);
+    # XXX TODO SET original_sequence_no
+    $self->dbh->commit;
+    $self->current_edit(undef);
+}
+
+sub _write_changeset_to_db {
+    my $self = shift;
+    my $changeset = shift;
+
+    $self->dbh->do(
+        "INSERT INTO changesets "
+            . "(creator, created,"
+            . "original_source_uuid, original_sequence_no, "
+            . "is_nullification, is_resolution) "
+            . "VALUES(?,?,?,?,?,?)", {},
+        $changeset->creator, $changeset->created,
+
+        $changeset->original_source_uuid,
+        $changeset->original_sequence_no, $changeset->is_nullification,
+        $changeset->is_resolution
+
+    );
+
+    my $local_id = $self->dbh->last_insert_id(undef, undef, 'changesets', 'sequence_no');
+
+    $self->dbh->do("UPDATE changesets set original_sequence_no = sequence_no WHERE sequence_no = ?", {}, $local_id) unless ($changeset->original_sequence_no);
+
+    for my $change (@{$changeset->changes}) {
+        $self->_write_change_to_db($change, $local_id);
+    }
+
+    return $local_id;
+}
+
+sub _write_change_to_db {
+    my $self = shift;
+    my $change = shift;
+    my $changeset_id = shift;
+
+    $self->dbh->do(
+        "INSERT INTO changes (record, changeset, change_type,
+        record_type) VALUES (?,?,?,?)", {}, $change->record_uuid, $changeset_id,
+        $change->change_type, $change->record_type
+    );
+    my $change_id = $self->dbh->last_insert_id(undef, undef, 'changes', 'id');
+    for my $pc (@{$change->prop_changes}) {
+        $self->_write_prop_change_to_db($change_id, $pc);
+    }
+
+}
+
+sub _write_prop_change_to_db {
+    my $self = shift;
+    my $change = shift;
+    my $pc = shift;
+
+    $self->dbh->do("INSERT INTO prop_changes (change, name, old_value, new_value) VALUES (?,?,?,?)", {}, $change, $pc->name, $pc->old_value, $pc->new_value);
+
+}
+
+sub _after_record_changes {
+    my $self = shift;
+    my ($changeset) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );
+    $self->current_edit->is_nullification( $changeset->is_nullification );
+    $self->current_edit->is_resolution( $changeset->is_resolution );
+}
+
+sub create_record {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );
+
+    my $inside_edit = $self->current_edit ? 1 : 0;
+    $self->begin_edit() unless ($inside_edit);
+    $self->_write_record_to_db( type  => $args{'type'}, uuid  => $args{'uuid'}, props => $args{'props'});
+    my $change = Prophet::Change->new( {   record_type => $args{'type'}, record_uuid => $args{'uuid'}, change_type => 'add_file' });
+    $change->add_prop_change( name => $_, old  => undef, new  => $args{props}->{$_}) for (keys %{$args{props}});
+    $self->current_edit->add_change( change => $change );
+    $self->commit_edit unless ($inside_edit);
+}
+
+sub delete_record {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 1, type => 1 } );
+
+    my $inside_edit = $self->current_edit ? 1 : 0;
+    $self->begin_edit() unless ($inside_edit);
+    $self->_delete_record_from_db(uuid => $args{uuid});
+
+    my $change = Prophet::Change->new( {   record_type => $args{'type'}, record_uuid => $args{'uuid'}, change_type => 'delete' });
+    $self->current_edit->add_change( change => $change );
+
+    $self->commit_edit() unless ($inside_edit);
+    return 1;
+}
+
+sub set_record_props {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );
+
+    my $inside_edit = $self->current_edit ? 1 : 0;
+    $self->begin_edit() unless ($inside_edit);
+
+    my $old_props = $self->get_record_props( uuid => $args{'uuid'}, type => $args{'type'});
+    my %new_props = %$old_props;
+
+    for my $prop ( keys %{ $args{props} } ) {
+        if ( !defined $args{props}->{$prop} ) {
+            delete $new_props{$prop};
+        } else {
+            $new_props{$prop} = $args{props}->{$prop};
+        }
+    }
+
+    $self->_write_record_to_db( type  => $args{'type'}, uuid  => $args{'uuid'}, props => \%new_props);
+
+    my $change = Prophet::Change->new( {   record_type => $args{'type'}, record_uuid => $args{'uuid'}, change_type => 'update_file' });
+    $change->add_prop_change( name => $_, old  => $old_props->{$_}, new  => $args{props}->{$_}) for (keys %{$args{props}});
+    $self->current_edit->add_change( change => $change );
+    $self->commit_edit() unless ($inside_edit);
+
+    return 1;
+}
+
+sub get_record_props {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 1, type => 1 } );
+    my $sth = $self->dbh->prepare( "SELECT prop, value from record_props WHERE uuid = ?");
+    $sth->execute($args{uuid});
+    my $items = $sth->fetchall_arrayref;
+    return {map {  @$_ } @$items}; 
+}
+
+sub record_exists {
+    my $self = shift;
+    my %args = validate( @_, { uuid => 1, type => 1 } );
+    return undef unless $args{'uuid'};
+
+    my $sth = $self->dbh->prepare("SELECT COUNT(uuid) from records WHERE type = ? AND uuid = ?");
+    $sth->execute($args{type}, $args{uuid});
+    return $sth->fetchrow_array;
+
+}
+
+sub list_records {
+    my $self = shift;
+    my %args = validate( @_ => { type => 1 } );
+
+    my $sth = $self->dbh->prepare("SELECT uuid from records WHERE type = ?");
+    $sth->execute($args{type});
+    my @data = map { $_->[0]} @{ $sth->fetchall_arrayref};
+    return \@data;
+}
+
+sub list_types {
+    my $self = shift;
+
+    my $sth = $self->dbh->prepare("SELECT DISTINCT type from records");
+    $sth->execute();
+    return [ map { $_->[0]} @{$sth->fetchall_arrayref}];
+}
+
+sub type_exists {
+    my $self = shift;
+    my %args = (type =>undef, @_);
+    my $sth = $self->dbh->prepare("SELECT type from records WHERE type = ? LIMIT 1");
+    $sth->execute($args{type});
+    return $sth->fetchrow_array;
+
+}
+
+=head2 read_userdata_file
+
+Returns the contents of the given file in this replica's userdata directory.
+Returns C<undef> if the file does not exist.
+
+=cut
+
+sub read_userdata {
+    my $self = shift;
+    my %args = validate( @_, { path => 1 } );
+    return $self->_fetch_userdata( $args{path} );
+}
+
+=head2 write_userdata_file
+
+Writes the given string to the given file in this replica's userdata directory.
+
+=cut
+
+sub write_userdata {
+    my $self = shift;
+    my %args = validate( @_, { path => 1, content => 1 } );
+    $self->_store_userdata(
+        key   => $args{path},
+        value => $args{content},
+    );
+}
+
+sub DEMOLISH { shift->dbh->disconnect }
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;

Modified: Prophet/trunk/t/canonicalize.t
==============================================================================
--- Prophet/trunk/t/canonicalize.t	(original)
+++ Prophet/trunk/t/canonicalize.t	Wed Dec 17 16:49:18 2008
@@ -7,7 +7,7 @@
 
 
 use_ok('Prophet::CLI');
-$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 my $cli = Prophet::CLI->new();
 my $cxn = $cli->handle;
 isa_ok($cxn, 'Prophet::Replica');

Modified: Prophet/trunk/t/config.t
==============================================================================
--- Prophet/trunk/t/config.t	(original)
+++ Prophet/trunk/t/config.t	Wed Dec 17 16:49:18 2008
@@ -4,7 +4,7 @@
 use strict;
 use Prophet::Test 'no_plan';
 use File::Temp qw'tempdir';
-    $ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+    $ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 delete $ENV{'PROPHET_APP_CONFIG'};
 
 use_ok('Prophet::CLI');

Modified: Prophet/trunk/t/create.t
==============================================================================
--- Prophet/trunk/t/create.t	(original)
+++ Prophet/trunk/t/create.t	Wed Dec 17 16:49:18 2008
@@ -5,7 +5,7 @@
 use File::Temp qw'tempdir';
 
 use_ok('Prophet::CLI');
-$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 my $cli = Prophet::CLI->new();
 my $cxn = $cli->handle;
 

Modified: Prophet/trunk/t/database-settings.t
==============================================================================
--- Prophet/trunk/t/database-settings.t	(original)
+++ Prophet/trunk/t/database-settings.t	Wed Dec 17 16:49:18 2008
@@ -39,7 +39,6 @@
     my $cxn = $alice_cli->handle;
     isa_ok( $cxn, 'Prophet::Replica', "Got the cxn " . $cxn->fs_root );
     $cxn->initialize();
-
     # set up an app model class, "ticket"
     my $t = MyApp::Model::Task->new(handle => $alice_cli->app_handle->handle);
     # set default values for status 
@@ -63,9 +62,9 @@
 
     # set list of acceptable statuses
     $status_list->set('new','open','closed'); 
-
     # enumerate statuses
     is_deeply($status_list->get, [qw/new open closed/]);
+exit;
 
     $status_list->set('new', 'closed');
 

Modified: Prophet/trunk/t/default.t
==============================================================================
--- Prophet/trunk/t/default.t	(original)
+++ Prophet/trunk/t/default.t	Wed Dec 17 16:49:18 2008
@@ -5,7 +5,7 @@
 use lib 't/lib';
 
 use_ok('Prophet::CLI');
-$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 my $cli = Prophet::CLI->new();
 my $cxn = $cli->handle;
 $cxn->initialize;

Modified: Prophet/trunk/t/edit.t
==============================================================================
--- Prophet/trunk/t/edit.t	(original)
+++ Prophet/trunk/t/edit.t	Wed Dec 17 16:49:18 2008
@@ -3,7 +3,7 @@
 use Prophet::Test tests => 34;
 use File::Temp qw'tempdir';
 
-$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 my $prophet = Prophet::CLI->new;
 $prophet->handle->initialize;
 

Modified: Prophet/trunk/t/export.t
==============================================================================
--- Prophet/trunk/t/export.t	(original)
+++ Prophet/trunk/t/export.t	Wed Dec 17 16:49:18 2008
@@ -49,7 +49,7 @@
         'content is correct'
     );
 
-    my $path = tempdir( CLEANUP => !  $ENV{TEST_VERBOSE} ) ;
+    my $path = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG} ) ;
 
     run_ok( 'prophet', [ 'export', '--path', $path ] );
     my $cli = Prophet::CLI->new;

Modified: Prophet/trunk/t/history.t
==============================================================================
--- Prophet/trunk/t/history.t	(original)
+++ Prophet/trunk/t/history.t	Wed Dec 17 16:49:18 2008
@@ -13,7 +13,7 @@
 use warnings;
 use strict;
 use File::Temp qw/tempdir/;
-$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 
 use Prophet::Test tests => 8;
 use Test::Exception;

Modified: Prophet/trunk/t/luid.t
==============================================================================
--- Prophet/trunk/t/luid.t	(original)
+++ Prophet/trunk/t/luid.t	Wed Dec 17 16:49:18 2008
@@ -6,8 +6,8 @@
 
 use_ok('Prophet::CLI');
 use_ok('Prophet::Record');
-$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
-$ENV{'PROPHET_METADATA_DIRECTORY'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
+$ENV{'PROPHET_METADATA_DIRECTORY'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 
 my $cli = Prophet::CLI->new();
 my $cxn = $cli->handle;

Modified: Prophet/trunk/t/publish-html.t
==============================================================================
--- Prophet/trunk/t/publish-html.t	(original)
+++ Prophet/trunk/t/publish-html.t	Wed Dec 17 16:49:18 2008
@@ -9,7 +9,7 @@
 
 my ($bug_uuid, $pullall_uuid);
 
-my $alice_published = tempdir(CLEANUP => 1);
+my $alice_published = tempdir(CLEANUP => ! $ENV{PROPHET_DEBUG});
 
 as_alice {
     run_ok('prophet', [qw(init)]);

Modified: Prophet/trunk/t/publish-pull.t
==============================================================================
--- Prophet/trunk/t/publish-pull.t	(original)
+++ Prophet/trunk/t/publish-pull.t	Wed Dec 17 16:49:18 2008
@@ -8,7 +8,7 @@
 
 my ($bug_uuid, $pullall_uuid);
 
-my $alice_published = tempdir(CLEANUP => 1);
+my $alice_published = tempdir(CLEANUP => ! $ENV{PROPHET_DEBUG});
 
 as_alice {
     run_ok('prophet', [qw(init)]);

Modified: Prophet/trunk/t/resty-server.t
==============================================================================
--- Prophet/trunk/t/resty-server.t	(original)
+++ Prophet/trunk/t/resty-server.t	Wed Dec 17 16:49:18 2008
@@ -4,7 +4,7 @@
 
 BEGIN {
     use File::Temp qw(tempdir);
-    $ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+    $ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 
 }
 
@@ -39,7 +39,16 @@
 is( $ua->content, '["Cars"]' );
 
 $ua->get_ok( url( 'records', 'Cars', $uuid . ".json" ) );
-is( $ua->content, '{"original_replica":"'.$car->handle->uuid.'","creator":"'.$car->default_prop_creator.'","wheels":"4","windshields":"1"}' );
+is_deeply(
+    from_json( $ua->content ),
+    from_json(
+            '{"original_replica":"'
+          . $car->handle->uuid
+          . '","creator":"'
+          . $car->default_prop_creator
+          . '","wheels":"4","windshields":"1"}'
+    )
+);
 
 $ua->get( url( 'records', 'Cars', "1234.json" ) );
 is( $ua->status, '404' );
@@ -47,7 +56,17 @@
 $ua->post_ok( url( 'records', 'Cars', $uuid . ".json" ), { wheels => 6 } );
 
 $ua->get_ok( url( 'records', 'Cars', $uuid . ".json" ) );
-is( $ua->content, '{"original_replica":"'.$car->handle->uuid.'","creator":"'.$car->default_prop_creator.'","wheels":"6","windshields":"1"}' );
+
+is_deeply(
+    from_json( $ua->content ),
+    from_json(
+            '{"original_replica":"'
+          . $car->handle->uuid
+          . '","creator":"'
+          . $car->default_prop_creator
+          . '","wheels":"6","windshields":"1"}'
+    )
+);
 
 $ua->post( url( 'records', 'Cars', "doesnotexist.json" ), { wheels => 6 } );
 is( $ua->status, '404', "Can't update a nonexistant car" );

Modified: Prophet/trunk/t/validate.t
==============================================================================
--- Prophet/trunk/t/validate.t	(original)
+++ Prophet/trunk/t/validate.t	Wed Dec 17 16:49:18 2008
@@ -8,7 +8,7 @@
 
 
 use_ok('Prophet::CLI');
-$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => ! $ENV{PROPHET_DEBUG}  ) . '/repo-' . $$;
 my $cli = Prophet::CLI->new();
 my $cxn = $cli->handle;
 isa_ok( $cxn, 'Prophet::Replica', "Got the cxn" );



More information about the Bps-public-commit mailing list