[Bps-public-commit] r14983 - Prophet/trunk/lib/Prophet/Replica

jesse at bestpractical.com jesse at bestpractical.com
Sun Aug 10 20:07:02 EDT 2008


Author: jesse
Date: Sun Aug 10 20:07:01 2008
New Revision: 14983

Modified:
   Prophet/trunk/lib/Prophet/Replica/Native.pm

Log:
* reapplied the slurp patch, since it turns out to not have been the bug

Modified: Prophet/trunk/lib/Prophet/Replica/Native.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica/Native.pm	(original)
+++ Prophet/trunk/lib/Prophet/Replica/Native.pm	Sun Aug 10 20:07:01 2008
@@ -13,7 +13,7 @@
 
 has '+db_uuid' => (
     lazy    => 1,
-    default => sub { shift->read_file('database-uuid') },
+    default => sub { shift->_read_file('database-uuid') },
 );
 
 has _uuid => (
@@ -24,7 +24,7 @@
 has replica_version => (
     is      => 'ro',
     lazy    => 1,
-    default => sub { shift->read_file('replica-version') }
+    default => sub { shift->_read_file('replica-version') }
 );
 
 has fs_root_parent => (
@@ -32,7 +32,7 @@
     lazy    => 1,
     default => sub {
         my $self = shift;
-        return $self->url =~ m{^file://(.*)/.*?$} ? $1 : undef;
+        return $self->url =~ m{^file://(.*)/.*?$} ? dir($1) : undef;
     },
 );
 
@@ -41,7 +41,7 @@
     lazy    => 1,
     default => sub {
         my $self = shift;
-        return $self->url =~ m{^file://(.*)$} ? $1 : undef;
+        return $self->url =~ m{^file://(.*)$} ? dir($1) : undef;
     },
 );
 
@@ -191,7 +191,7 @@
 
 sub latest_sequence_no {
     my $self = shift;
-    $self->read_file('latest-sequence-no');
+    $self->_read_file('latest-sequence-no');
 }
 
 sub set_latest_sequence_no {
@@ -218,7 +218,7 @@
 
 sub uuid {
     my $self = shift;
-    $self->_uuid( $self->read_file('replica-uuid') ) unless $self->_uuid;
+    $self->_uuid( $self->_read_file('replica-uuid') ) unless $self->_uuid;
     return $self->_uuid;
 }
 
@@ -342,7 +342,7 @@
         type => $args{type}
     );
 
-    my $index = $self->read_file($idx_filename);
+    my $index = $self->_read_file($idx_filename);
     return undef unless $index;
 
     # XXX TODO THIS CODE IS HACKY AND SHOULD BE SHOT;
@@ -382,7 +382,7 @@
     );
 
     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 {
@@ -493,7 +493,7 @@
         );
 
         my $changeset = $self->_deserialize_changeset(
-            content              => $self->read_file($casfile),
+            content              => $self->_read_file($casfile),
             original_source_uuid => $orig_uuid,
             original_sequence_no => $orig_seq,
             sequence_no          => $seq
@@ -529,7 +529,7 @@
 
 sub _read_changeset_index {
     my $self =shift;
-    my $chgidx    = $self->read_file( $self->changeset_index );
+    my $chgidx    = $self->_read_file( $self->changeset_index );
     return \$chgidx;
 }
 
@@ -637,7 +637,7 @@
 
     if (! $self->fs_root ) {
         # HTTP Replica
-        return $self->read_file($file) ? 1 : 0;
+        return $self->_read_file($file) ? 1 : 0;
     }
 
     my $path = file( $self->fs_root, $file );
@@ -649,14 +649,33 @@
 sub read_file {
     my $self = shift;
     my ($file) = validate_pos( @_, 1 );
-    if ( $self->fs_root ) {
+    if ($self->fs_root) {
         my $qualified_file = file( $self->fs_root => $file );
-        return undef unless dir($self->fs_root)->subsumes($qualified_file);
-        return scalar $qualified_file->slurp if  $self->_file_exists($file);
-        return undef;
+        return undef if ( not dir($self->fs_root)->subsumes($qualified_file));
+    }
+    return $self->_read_file($file);
+}
+
+sub _read_file {
+    my $self = shift;
+    my ($file) = validate_pos( @_, 1 );
+    if ( $self->fs_root ) {
+        return eval { $self->_slurp (file( $self->fs_root => $file )) };
     } else {    # http replica
         return LWP::Simple::get( $self->url . "/" . $file );
     }
+
+
+}
+
+sub _slurp {
+    my $self = shift;
+    my $abspath = shift;
+    open (my $fh, "<", "$abspath") || die $!;
+    my @lines = <$fh>;
+    close $fh;
+    return join('', at lines);
+
 }
 
 sub begin_edit {
@@ -883,7 +902,7 @@
     my $self = shift;
     my %args = validate( @_, { path => 1 } );
 
-    $self->read_file(file($self->userdata_dir, $args{path}));
+    $self->_read_file(file($self->userdata_dir, $args{path}));
 }
 
 =head2 write_userdata_file



More information about the Bps-public-commit mailing list