[Bps-public-commit] r14323 - in Prophet/branches/history: . lib/Prophet t
jesse at bestpractical.com
jesse at bestpractical.com
Sun Jul 20 18:54:13 EDT 2008
Author: jesse
Date: Sun Jul 20 18:54:11 2008
New Revision: 14323
Added:
Prophet/branches/history/t/history.t
Modified:
Prophet/branches/history/ (props changed)
Prophet/branches/history/lib/Prophet/Record.pm
Prophet/branches/history/lib/Prophet/Replica/Native.pm
Log:
r40252 at 68-246-244-17: jesse | 2008-07-20 13:05:42 -0700
* We can now reasonably efficiently pull out changesets which describe record history
Modified: Prophet/branches/history/lib/Prophet/Record.pm
==============================================================================
--- Prophet/branches/history/lib/Prophet/Record.pm (original)
+++ Prophet/branches/history/lib/Prophet/Record.pm Sun Jul 20 18:54:11 2008
@@ -301,8 +301,8 @@
sub changesets {
my $self = shift;
- my @changeset_ids = $self->handle->list_record_changesets(record_uuid =>
- $self->uuid
+ my @changesets = $self->handle->changesets_for_record(uuid =>
+ $self->uuid, type => $self->type
);
}
Modified: Prophet/branches/history/lib/Prophet/Replica/Native.pm
==============================================================================
--- Prophet/branches/history/lib/Prophet/Replica/Native.pm (original)
+++ Prophet/branches/history/lib/Prophet/Replica/Native.pm Sun Jul 20 18:54:11 2008
@@ -245,19 +245,19 @@
}
-sub _prepare_record_index_update {
- my $self = shift;
- my %record = (@_);
+sub _prepare_record_index_update {
+ my $self = shift;
+ my %record = (@_);
# If we're inside an edit, we can record the changeset info into the index
- if ( $self->current_edit) {
- push @{$self->current_edit_records}, \%record;
+ if ( $self->current_edit ) {
+ push @{ $self->current_edit_records }, \%record;
- } else {
+ } else {
# If we're not inside an edit, we're likely exporting the replica
# TODO: the replica exporter code should probably be retooled
- $self->_write_record_index_entry(%record);
- }
+ $self->_write_record_index_entry(%record);
+ }
}
@@ -265,7 +265,7 @@
sub _write_record_index_entry {
my $self = shift;
- my %args = validate( @_, { type => 1, uuid => 1, cas_key => 1 } );
+ my %args = validate( @_, { type => 1, uuid => 1, cas_key => 1, changeset_id => 0 } );
my $idx_filename = $self->_record_index_filename(
uuid => $args{uuid},
type => $args{type}
@@ -274,11 +274,11 @@
my $index_path = file( $self->fs_root, $idx_filename );
$index_path->parent->mkpath;
- my $record_index = $index_path->openw;
+ open( my $record_index, ">>" . $index_path);
# XXX TODO: skip if the index already has this version of the record;
# XXX TODO FETCH THAT
- my $record_last_changed_changeset = 1;
+ my $record_last_changed_changeset = $args{'changeset_id'} || 0;
my $index_row
= pack( 'NH40', $record_last_changed_changeset, $args{cas_key} );
print $record_index $index_row || die $!;
@@ -287,26 +287,44 @@
sub _read_record_index_entry {
my $self = shift;
- my %args = validate( @_, { type => 1, uuid => 1 } );
+ my %args = validate( @_, { type => 1, uuid => 1 } );
+
+ # XXX TODO - we shouldn't compute all entries just to get the last
+ my @entries = $self->_read_record_index(
+ type => $args{type},
+ uuid => $args{uuid}
+ );
+ return @{$entries[-1] || []};
+
+}
+
+
+sub _read_record_index {
+ my $self = shift;
+ my %args = validate( @_, { type => 1, uuid => 1 } );
my $idx_filename = $self->_record_index_filename(
uuid => $args{uuid},
type => $args{type}
);
-
-
my $index = $self->_read_file($idx_filename);
return undef unless $index;
# XXX TODO THIS CODE IS HACKY AND SHOULD BE SHOT;
my $count = length($index) / RECORD_INDEX_SIZE;
-
- my ( $seq, $key ) = unpack( 'NH40',
- substr( $index, ( $count - 1 ) * RECORD_INDEX_SIZE, RECORD_INDEX_SIZE )
- );
-
- return ($seq,$key);
+ my @entries;
+ for my $offset ( 0 .. ( $count - 1 ) ) {
+ my ( $seq, $key ) = unpack(
+ 'NH40',
+ substr(
+ $index, ( $offset ) * RECORD_INDEX_SIZE,
+ RECORD_INDEX_SIZE
+ )
+ );
+ push @entries, [ $seq => $key ];
+ }
+ return @entries;
}
sub _delete_record_index {
@@ -321,13 +339,16 @@
}
sub _read_serialized_record {
- my $self = shift;
- my %args = validate( @_, { type => 1, uuid => 1 } );
+ my $self = shift;
+ my %args = validate( @_, { type => 1, uuid => 1 } );
- my $casfile = $self->_record_cas_filename(type => $args{'type'}, uuid => $args{'uuid'});
+ my $casfile = $self->_record_cas_filename(
+ type => $args{'type'},
+ uuid => $args{'uuid'}
+ );
return undef unless $casfile;
- return from_json( $self->_read_file($casfile), { utf8 => 1} );
+ return from_json( $self->_read_file($casfile), { utf8 => 1 } );
}
sub _record_index_filename {
@@ -335,12 +356,19 @@
my %args = validate( @_, { uuid => 1, type => 1 } );
return file(
$self->_record_type_root( $args{'type'} ),
- substr( $args{uuid}, 0, 1 ),
- substr( $args{uuid}, 1, 1 ),
- $args{uuid}
+ $self->_hashed_dir_name($args{uuid})
);
}
+
+sub _hashed_dir_name {
+ my $self = shift;
+ my $hash = shift;
+
+ return (substr( $hash, 0, 1 ), substr( $hash, 1, 1 ), $hash);
+}
+
+
sub _record_cas_filename {
my $self = shift;
my %args = validate( @_, { type => 1, uuid => 1 } );
@@ -352,8 +380,7 @@
# XXX: deserialize the changeset content from the cas with $key
my $casfile = file(
$self->record_cas_dir,
- substr( $key, 0, 1 ),
- substr( $key, 1, 1 ), $key
+ $self->_hashed_dir_name($key)
);
return $casfile;
@@ -409,21 +436,14 @@
use constant CHG_RECORD_SIZE => ( 4 + 16 + 4 + 20 );
-sub traverse_changesets {
+
+sub _get_changeset_index_entry {
my $self = shift;
- my %args = validate(
- @_,
- { after => 1,
- callback => 1,
- }
- );
- my $first_rev = ( $args{'after'} + 1 ) || 1;
- my $latest = $self->latest_sequence_no();
- my $chgidx = $self->_read_file( $self->changeset_index );
+ my %args = validate(@_, { sequence_no => 1, index_file => 1});
- $self->log("Traversing changesets between $first_rev and $latest");
- for my $rev ( $first_rev .. $latest ) {
- my $index_record = substr( $chgidx, ( $rev - 1 ) * CHG_RECORD_SIZE,
+ my $chgidx = $args{index_file};
+ my $rev = $args{'sequence_no'};
+ my $index_record = substr( $$chgidx, ( $rev - 1 ) * CHG_RECORD_SIZE,
CHG_RECORD_SIZE );
my ( $seq, $orig_uuid, $orig_seq, $key )
= unpack( 'Na16NH40', $index_record );
@@ -434,10 +454,8 @@
. " data key $key" );
# XXX: deserialize the changeset content from the cas with $key
- my $casfile = file(
- $self->changeset_cas_dir,
- substr( $key, 0, 1 ),
- substr( $key, 1, 1 ), $key
+ my $casfile = file( $self->changeset_cas_dir,
+ $self->_hashed_dir_name($key)
);
my $changeset = $self->_deserialize_changeset(
@@ -446,10 +464,69 @@
original_sequence_no => $orig_seq,
sequence_no => $seq
);
+
+ return $changeset;
+}
+
+
+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();
+
+ my $chgidx = $self->_read_changeset_index;
+ $self->log("Traversing changesets between $first_rev and $latest");
+ for my $rev ( $first_rev .. $latest ) {
+ my $changeset = $self->_get_changeset_index_entry(
+ sequence_no => $rev,
+ index_file => $chgidx
+ );
+
$args{callback}->($changeset);
}
}
+sub _read_changeset_index {
+ my $self =shift;
+ my $chgidx = $self->_read_file( $self->changeset_index );
+ return \$chgidx;
+}
+
+=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 @record_index = $self->_read_record_index( type => $args{'type'}, uuid => $args{'uuid'});
+
+ my $changeset_index = $self->_read_changeset_index();
+
+ my @changesets;
+ foreach my $item (@record_index) {
+ my $sequence = $item->[0];
+ push @changesets, $self->_get_changeset_index_entry( sequence_no => $sequence, index_file => $changeset_index);
+ }
+
+ return @changesets;
+
+}
+
+
sub _deserialize_changeset {
my $self = shift;
my %args = validate(
@@ -491,8 +568,7 @@
my $fingerprint = sha1_hex($content);
my $content_filename = file(
$args{'cas_dir'},
- substr( $fingerprint, 0, 1 ),
- substr( $fingerprint, 1, 1 ), $fingerprint
+ $self->_hashed_dir_name($fingerprint)
);
$self->_write_file( path => $content_filename, content => $content );
@@ -553,6 +629,8 @@
my $self = shift;
$self->current_edit(
Prophet::ChangeSet->new( { source_uuid => $self->uuid } ) );
+ $self->current_edit_records([]);
+
}
sub _set_original_source_metadata_for_current_edit {
@@ -574,7 +652,7 @@
unless ( $self->current_edit->original_source_uuid );
$self->current_edit->sequence_no($sequence);
for my $record (@{$self->current_edit_records}) {
- $self->_write_record_index_entry(%$record);
+ $self->_write_record_index_entry(changeset_id => $sequence, %$record);
}
$self->_write_changeset_to_index( $self->current_edit );
}
Added: Prophet/branches/history/t/history.t
==============================================================================
--- (empty file)
+++ Prophet/branches/history/t/history.t Sun Jul 20 18:54:11 2008
@@ -0,0 +1,31 @@
+package App::Record;
+use Moose;
+extends 'Prophet::Record';
+
+
+package App::Record::Thingy;
+use Moose;
+extends 'App::Record';
+
+sub type {'foo'}
+
+package main;
+use warnings;
+use strict;
+$ENV{'PROPHET_REPO'} = tempdir( CLEANUP => 0 ) . '/repo-' . $$;
+
+use Prophet::Test tests => 10;
+use Test::Exception;
+
+ my $cli = Prophet::CLI->new();
+ my $rec = App::Record::Thingy->new( handle => $cli->app_handle->handle, type => 'foo' );
+
+ ok( $rec->create( props => { foo => 'bar', point => '123' } ) );
+is($rec->prop('foo'), 'bar');
+is($rec->prop('point'), '123');
+ok($rec->set_props(props => { foo => 'abc'}));
+is($rec->prop('foo'), 'abc');
+ok($rec->set_props(props => { foo => 'def'}));
+is($rec->prop('foo'), 'def');
+my @history = $rec->changesets();
+is(scalar @history, 3);
More information about the Bps-public-commit
mailing list