[Bps-public-commit] r11615 - in SVN-PropDB: .
jesse at bestpractical.com
jesse at bestpractical.com
Mon Apr 7 09:15:04 EDT 2008
Author: jesse
Date: Mon Apr 7 09:15:04 2008
New Revision: 11615
Modified:
SVN-PropDB/ (props changed)
SVN-PropDB/lib/Prophet/Replica.pm
SVN-PropDB/lib/Prophet/Test.pm
Log:
r29429 at 68-247-45-239: jesse | 2008-04-07 02:58:18 -0500
* replica export cleanup
Modified: SVN-PropDB/lib/Prophet/Replica.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Replica.pm (original)
+++ SVN-PropDB/lib/Prophet/Replica.pm Mon Apr 7 09:15:04 2008
@@ -496,6 +496,7 @@
my $replica_root = dir( $path, $self->db_uuid );
my $cas_dir = dir($replica_root => 'cas');
my $record_dir = dir($replica_root => 'records');
+
_mkdir($path);
_mkdir($replica_root);
_mkdir( $record_dir);
@@ -504,7 +505,11 @@
$self->init_export(root => $replica_root);
foreach my $type ( @{ $self->prophet_handle->enumerate_types } ) {
- $self->export_records(type => $type, root => $replica_root, cas_dir => $cas_dir);
+ $self->export_records(
+ type => $type,
+ root => $replica_root,
+ cas_dir => $cas_dir
+ );
}
$self->export_changesets( root => $replica_root, cas_dir => $cas_dir);
@@ -525,48 +530,63 @@
}
-sub export_records{
+sub export_records {
my $self = shift;
- my %args = validate(@_, { root => 1, type => 1, cas_dir => 1});
- my $type = $args{'type'};
+ my %args = validate( @_, { root => 1, type => 1, cas_dir => 1 } );
+
+ make_tiered_dirs( dir( $args{'root'} => 'records' => $args{'type'} ) );
- make_tiered_dirs( dir( $args{'root'} => 'records' => $type ) );
+ my $collection = Prophet::Collection->new(
+ handle => $self->prophet_handle,
+ type => $args{type} );
+ $collection->matching( sub {1} );
+ $self->export_record(
+ record_dir => dir($args{'root'}, 'records', $_->type),
+ cas_dir => $args{'cas_dir'},
+ record => $_
+ ) for @$collection;
- my $collection = Prophet::Collection->new( handle => $self->prophet_handle, type => $type );
- $collection->matching( sub {1} );
- foreach my $record (@$collection) {
- my $record_as_hash = $record->get_props;
- my $content = YAML::Syck::Dump( $record_as_hash);
- my $fingerprint = sha1_hex($content);
- my $content_filename
- = file( $args{'cas_dir'}, substr( $fingerprint, 0, 1 ), substr( $fingerprint, 1, 1 ),
- $fingerprint );
- open( my $output, ">", $content_filename ) || die "Could not open $content_filename";
- print $output $content || die $!;
- close $output;
-
- my $idx_filename = file(
- $args{'root'}, 'records',$type,
- substr( $record->uuid, 0, 1 ),
- substr( $record->uuid, 1, 1 ),
- $record->uuid
- );
-
- open(my $record_index, ">>", $idx_filename ) || die $!;
-
- # XXX TODO: skip if the index already has this version of the record;
- my $record_last_changed_changeset = 1;
-
- # XXX TODO FETCH THAT
- print $record_index pack( 'Na16H40', $record_last_changed_changeset, $record->uuid, sha1_hex($content) )
- || die $!;
- close $record_index;
+}
+sub export_record {
+ my $self = shift;
+ my %args = validate(
+ @_,
+ { record => { isa => 'Prophet::Record' },
+ record_dir => 1,
+ cas_dir => 1,
}
+ );
+
+
+ my $record_as_hash = $args{record}->get_props;
+ my $content = YAML::Syck::Dump($record_as_hash);
+ my ($cas_key) = $self->_write_to_cas(content_ref => \$content,
+ cas_dir => $args{'cas_dir'});
+
+
+
+
+ my $idx_filename = file(
+ $args{'record_dir'},
+ substr( $args{record}->uuid, 0, 1 ),
+ substr( $args{record}->uuid, 1, 1 ),
+ $args{record}->uuid
+ );
- }
+ warn $idx_filename;
+ open( my $record_index, ">>", $idx_filename ) || die $!;
+
+ # XXX TODO: skip if the index already has this version of the record;
+ my $record_last_changed_changeset = 1;
+
+ # XXX TODO FETCH THAT
+ print $record_index pack( 'Na16H40', $record_last_changed_changeset, $args{record}->uuid, $cas_key) || die $!;
+ close $record_index;
+}
+
sub export_changesets {
my $self = shift;
my %args = validate(@_,{ root => 1, cas_dir => 1});
@@ -579,20 +599,19 @@
delete $hash_changeset->{'source_uuid'};
my $content = YAML::Syck::Dump( $hash_changeset);
- my $fingerprint = sha1_hex($content);
- my $content_filename
- = file( $args{'cas_dir'}, substr( $fingerprint, 0, 1 ), substr( $fingerprint, 1, 1 ), $fingerprint );
- open( my $output, ">", $content_filename ) || die "Could not open $content_filename";
- print $output $content || die $!;
- close $output;
+ my $cas_key = $self->_write_to_cas( content_ref => \$content, cas_dir => $args{'cas_dir'});
+
# XXX TODO we should only actually be encoding the sha1 of content once
# and then converting. this is wasteful
+
+ my $packed_cas_key=sha1($content);
+
print $cs_file pack( 'Na16Na20',
$changeset->sequence_no,
Data::UUID->new->from_string( $changeset->original_source_uuid ),
$changeset->original_sequence_no,
- sha1($content) )
+ $packed_cas_key)
|| die $!;
}
@@ -614,29 +633,30 @@
}
sub make_tiered_dirs {
- my $base = shift;
- _mkdir(dir($base));
- for my $a (0..9, 'a'..'f') {
- _mkdir(dir($base => $a));
- for my $b (0..9, 'a'..'f') {
- _mkdir(dir($base => $a => $b));
+ my $base = shift;
+ _mkdir( dir($base) );
+ for my $a ( 0 .. 9, 'a' .. 'f' ) {
+ _mkdir( dir( $base => $a ) );
+ for my $b ( 0 .. 9, 'a' .. 'f' ) {
+ _mkdir( dir( $base => $a => $b ) );
}
}
-
}
-
-sub serialize_changeset {
- my $self = shift;
- my $changeset_id = shift;
- $self->fetch_changeset($changeset_id);
-
-}
+sub _write_to_cas {
+ my $self = shift;
+ my %args = validate(@_, { content_ref => 1, cas_dir => 1 });
-sub serialize_node {
-
+ my $content = ${$args{'content_ref'}};
+ my $fingerprint = sha1_hex($content);
+ my $content_filename
+ = file( $args{'cas_dir'}, substr( $fingerprint, 0, 1 ), substr( $fingerprint, 1, 1 ), $fingerprint );
+ open( my $output, ">", $content_filename ) || die "Could not open $content_filename";
+ print $output $content || die $!;
+ close $output;
+ return $fingerprint;
}
Modified: SVN-PropDB/lib/Prophet/Test.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Test.pm (original)
+++ SVN-PropDB/lib/Prophet/Test.pm Mon Apr 7 09:15:04 2008
@@ -77,6 +77,8 @@
# diag(join(' ', @cmd, @$args));
my $ret = run3 [ @cmd, @$args ], undef, \$stdout, \$stderr;
Carp::croak $stderr if $?;
+ diag("STDOUT: " . $stdout) if ($stdout);
+ diag("STDERR: " . $stderr) if ($stderr);
#Test::More::diag $stderr;
return ( $ret, $stdout, $stderr );
@@ -96,8 +98,8 @@
@_ = sub {
my ( $ret, $stdout, $stderr ) = ( run_script( $script, $args ), $msg );
@_ = ( $ret, $msg );
- diag("STDOUT: " . $stdout) if ($stdout);
- diag("STDERR: " . $stderr) if ($stderr);
+ #diag("STDOUT: " . $stdout) if ($stdout);
+ #diag("STDERR: " . $stderr) if ($stderr);
goto &Test::More::ok;
};
goto \&lives_and;
More information about the Bps-public-commit
mailing list