[Bps-public-commit] Prophet branch, master, updated. 0.743-18-g81254ff

Jesse Vincent jesse at bestpractical.com
Sun Sep 5 22:18:56 EDT 2010


The branch, master has been updated
       via  81254ff4cb325ba8798437ff9001c7c1d5fecca5 (commit)
      from  ec69592106a8ad49a1fd158d6fcc2234a0814cb6 (commit)

Summary of changes:
 lib/Prophet/App.pm                     |    3 +++
 lib/Prophet/Config.pm                  |    2 +-
 lib/Prophet/ContentAddressedStore.pm   |    2 +-
 lib/Prophet/FilesystemReplica.pm       |   12 ++++++------
 lib/Prophet/Replica/FS/Backend/File.pm |   10 +++++-----
 lib/Prophet/Replica/file.pm            |    2 +-
 lib/Prophet/Replica/prophet.pm         |    6 +++---
 lib/Prophet/Server.pm                  |    8 ++++----
 lib/Prophet/Test.pm                    |    2 +-
 lib/Prophet/Util.pm                    |   10 ++++++++++
 t/config.t                             |    8 ++++----
 t/export.t                             |    4 ++--
 t/publish-html.t                       |    4 ++--
 t/publish-pull.t                       |    4 ++--
 14 files changed, 45 insertions(+), 32 deletions(-)

- Log -----------------------------------------------------------------
commit 81254ff4cb325ba8798437ff9001c7c1d5fecca5
Author: Jesse Vincent <jesse at bestpractical.com>
Date:   Sun Sep 5 22:20:59 2010 -0400

    File::Spec->catfile turns out to be a huge performance hotspot and
    Prophet is never going to run on VMS (or when it does, we can just fix
    the single layer of indirection)

diff --git a/lib/Prophet/App.pm b/lib/Prophet/App.pm
index aca7025..01aa4fd 100644
--- a/lib/Prophet/App.pm
+++ b/lib/Prophet/App.pm
@@ -255,6 +255,9 @@ name is just the UUID.
 =cut
 
 # friendly names are replica subsections in the config file
+
+use Memoize;
+memoize('display_name_for_replica');
 sub display_name_for_replica {
     my $self = shift;
     my $uuid = shift;
diff --git a/lib/Prophet/Config.pm b/lib/Prophet/Config.pm
index d59e93e..7a90e6b 100644
--- a/lib/Prophet/Config.pm
+++ b/lib/Prophet/Config.pm
@@ -130,7 +130,7 @@ sub replica_config_file {
     my $self = shift;
 
     return exists $ENV{PROPHET_APP_CONFIG} ? $ENV{PROPHET_APP_CONFIG}
-                : File::Spec->catfile(
+                : Prophet::Util->catfile(
                     $self->app_handle->handle->fs_root, $self->dir_file
     );
 }
diff --git a/lib/Prophet/ContentAddressedStore.pm b/lib/Prophet/ContentAddressedStore.pm
index 83c5916..d7c0116 100644
--- a/lib/Prophet/ContentAddressedStore.pm
+++ b/lib/Prophet/ContentAddressedStore.pm
@@ -31,7 +31,7 @@ sub write {
 
 sub filename {
     my ($self, $key, $full) = @_;
-    File::Spec->catfile( $full ? $self->fs_root : (),
+    Prophet::Util->catfile( $full ? $self->fs_root : (),
                          $self->root =>
                          Prophet::Util::hashed_dir_name($key) );
 }
diff --git a/lib/Prophet/FilesystemReplica.pm b/lib/Prophet/FilesystemReplica.pm
index 24ee458..f1452a7 100644
--- a/lib/Prophet/FilesystemReplica.pm
+++ b/lib/Prophet/FilesystemReplica.pm
@@ -47,7 +47,7 @@ sub read_file {
 
         # make sure we don't try to read files outside the replica
         my $qualified_file = Cwd::fast_abs_path(
-            File::Spec->catfile( $self->fs_root => $file ) );
+            Prophet::Util->catfile( $self->fs_root => $file ) );
         return undef
             if substr( $qualified_file, 0, length( $self->fs_root ) ) ne
                 $self->fs_root;
@@ -267,7 +267,7 @@ sub read_userdata {
     my $self = shift;
     my %args = validate( @_, { path => 1 } );
 
-    $self->_read_file( File::Spec->catfile( $self->userdata_dir, $args{path} ) );
+    $self->_read_file( Prophet::Util->catfile( $self->userdata_dir, $args{path} ) );
 }
 
 =head2 write_userdata
@@ -281,7 +281,7 @@ sub write_userdata {
     my %args = validate( @_, { path => 1, content => 1 } );
 
     $self->_write_file(
-        path    => File::Spec->catfile( $self->userdata_dir, $args{path} ),
+        path    => Prophet::Util->catfile( $self->userdata_dir, $args{path} ),
         content => $args{content},
     );
 }
@@ -292,7 +292,7 @@ sub store_local_metadata {
     my $key = shift;
     my $value = shift;
     $self->_write_file(
-        path    =>File::Spec->catfile( $self->local_metadata_dir,  lc($key)),
+        path    =>Prophet::Util->catfile( $self->local_metadata_dir,  lc($key)),
         content => $value,
     );
 
@@ -307,8 +307,8 @@ sub fetch_local_metadata {
 	# If there's a new-style all-lowercase file,  read that first. If there isn't,
 	# try to read an old-style sensitive file
 
-	my $insensitive_file = File::Spec->catfile($self->local_metadata_dir, lc($key));
-	my $sensitive_file = File::Spec->catfile($self->local_metadata_dir, $key);
+	my $insensitive_file = Prophet::Util->catfile($self->local_metadata_dir, lc($key));
+	my $sensitive_file = Prophet::Util->catfile($self->local_metadata_dir, $key);
 
 	return	$self->_read_file($insensitive_file) || $self->_read_file($sensitive_file);
 
diff --git a/lib/Prophet/Replica/FS/Backend/File.pm b/lib/Prophet/Replica/FS/Backend/File.pm
index afd34ea..31b8a39 100644
--- a/lib/Prophet/Replica/FS/Backend/File.pm
+++ b/lib/Prophet/Replica/FS/Backend/File.pm
@@ -14,7 +14,7 @@ sub read_file {
         return eval {
             local $SIG{__DIE__} = 'DEFAULT';
             Prophet::Util->slurp(
-                File::Spec->catfile( $self->fs_root => $file ) );
+                Prophet::Util->catfile( $self->fs_root => $file ) );
         };
 }
 
@@ -23,7 +23,7 @@ sub read_file_range {
     my %args = validate( @_, { path => 1, position => 1, length => 1 } );
 
     if ($self->fs_root) {
-        my $f = File::Spec->catfile( $self->fs_root => $args{path} );
+        my $f = Prophet::Util->catfile( $self->fs_root => $args{path} );
         return unless -e $f;
         if ( $^O =~ /MSWin/ ) {
             # XXX by sunnavy
@@ -64,7 +64,7 @@ sub write_file {
     my %args = (@_); # validation is too heavy to call here
     #my %args = validate( @_, { path => 1, content => 1 } );
 
-    my $file = File::Spec->catfile( $self->fs_root => $args{'path'} );
+    my $file = Prophet::Util->catfile( $self->fs_root => $args{'path'} );
     Prophet::Util->write_file( file => $file, content => $args{content});
 
 }
@@ -73,7 +73,7 @@ sub append_to_file {
 	my $self = shift;
 	my ($filename, $content) = validate_pos(@_, 1,1 );
     open( my $file,
-        ">>" . File::Spec->catfile( $self->fs_root => $filename)
+        ">>" . Prophet::Util->catfile( $self->fs_root => $filename)
     ) || die $!;
     print $file $content || die $!;
 	close $file;
@@ -84,7 +84,7 @@ sub file_exists {
     my ($file) = validate_pos( @_, 1 );
 
 
-    my $path = File::Spec->catfile( $self->fs_root, $file );
+    my $path = Prophet::Util->catfile( $self->fs_root, $file );
     if    ( -f $path ) { return 1 }
     elsif ( -d $path ) { return 2 }
     else               { return 0 }
diff --git a/lib/Prophet/Replica/file.pm b/lib/Prophet/Replica/file.pm
index 0883dd5..e38abc0 100644
--- a/lib/Prophet/Replica/file.pm
+++ b/lib/Prophet/Replica/file.pm
@@ -6,7 +6,7 @@ sub scheme { 'file' }
 sub replica_exists {
     my $self = shift;
     return 0 unless defined $self->fs_root && -d $self->fs_root;
-    return 0 unless -e File::Spec->catfile( $self->fs_root => 'database-uuid' );
+    return 0 unless -e Prophet::Util->catfile( $self->fs_root => 'database-uuid' );
     return 1;
 }
 
diff --git a/lib/Prophet/Replica/prophet.pm b/lib/Prophet/Replica/prophet.pm
index fa92260..e28b7c3 100755
--- a/lib/Prophet/Replica/prophet.pm
+++ b/lib/Prophet/Replica/prophet.pm
@@ -457,7 +457,7 @@ sub _write_record_index_entry {
         type => $args{type}
     );
 
-    my $index_path = File::Spec->catfile( $self->fs_root, $idx_filename );
+    my $index_path = Prophet::Util->catfile( $self->fs_root, $idx_filename );
     my ( undef, $parent, $filename ) = File::Spec->splitpath($index_path);
     mkpath( [$parent] );
 
@@ -524,7 +524,7 @@ sub _delete_record_index {
         uuid => $args{uuid},
         type => $args{type}
     );
-    unlink File::Spec->catfile( $self->fs_root => $idx_filename )
+    unlink Prophet::Util->catfile( $self->fs_root => $idx_filename )
         || die "Could not delete record $idx_filename: " . $!;
 }
 
@@ -550,7 +550,7 @@ memoize '_record_index_filename' unless $^O =~ /MSWin/;
 sub _record_index_filename {
     my $self = shift;
     my %args = validate( @_, { uuid => 1, type => 1 } );
-    return File::Spec->catfile( $self->_record_type_dir( $args{'type'} ), Prophet::Util::hashed_dir_name( $args{uuid} ));
+    return Prophet::Util->catfile( $self->_record_type_dir( $args{'type'} ), Prophet::Util::hashed_dir_name( $args{uuid} ));
 }
 
 sub _record_cas_filename {
diff --git a/lib/Prophet/Server.pm b/lib/Prophet/Server.pm
index 55b289b..d0bc43a 100644
--- a/lib/Prophet/Server.pm
+++ b/lib/Prophet/Server.pm
@@ -101,7 +101,7 @@ sub prophet_static_root {
             or die "requires File::ShareDir to determine default static root";
 
         $PROPHET_STATIC_ROOT
-            = File::Spec->catfile( File::ShareDir::dist_dir('Prophet'), 'web/static' )
+            = Prophet::Util->catfile( File::ShareDir::dist_dir('Prophet'), 'web/static' )
             if ( !-d $PROPHET_STATIC_ROOT );
 
         $PROPHET_STATIC_ROOT = Cwd::abs_path($PROPHET_STATIC_ROOT);
@@ -134,7 +134,7 @@ sub app_static_root {
             or die "requires File::ShareDir to determine default static root";
 
         $APP_STATIC_ROOT
-            = File::Spec->catfile( File::ShareDir::dist_dir($dist), 'web', 'static' )
+            = Prophet::Util->catfile( File::ShareDir::dist_dir($dist), 'web', 'static' )
             if ( !-d $APP_STATIC_ROOT );
 
         $APP_STATIC_ROOT = Cwd::abs_path($APP_STATIC_ROOT);
@@ -376,8 +376,8 @@ sub send_static_file {
         $type = 'image/png';
     }
     for my $root ( $self->app_static_root, $self->prophet_static_root) {
-        next unless -f File::Spec->catfile( $root => $filename );
-        my $qualified_file = Cwd::fast_abs_path( File::Spec->catfile( $root => $filename ) );
+        next unless -f Prophet::Util->catfile( $root => $filename );
+        my $qualified_file = Cwd::fast_abs_path( Prophet::Util->catfile( $root => $filename ) );
         next if substr( $qualified_file, 0, length($root) ) ne $root;
         my $content = Prophet::Util->slurp($qualified_file);
         return $self->send_content( static => 1, content => $content, content_type => $type );
diff --git a/lib/Prophet/Test.pm b/lib/Prophet/Test.pm
index 59380f4..b4223a8 100644
--- a/lib/Prophet/Test.pm
+++ b/lib/Prophet/Test.pm
@@ -67,7 +67,7 @@ sub set_editor_script {
     my ($self, $script) = @_;
 
     delete $ENV{'VISUAL'};       # Proc::InvokeEditor checks this first
-    $ENV{'EDITOR'} = "$^X " . File::Spec->catfile(getcwd(), 't', 'scripts', $script);
+    $ENV{'EDITOR'} = "$^X " . Prophet::Util->catfile(getcwd(), 't', 'scripts', $script);
     Test::More::diag "export EDITOR=" . $ENV{'EDITOR'} . "\n";
 }
 
diff --git a/lib/Prophet/Util.pm b/lib/Prophet/Util.pm
index 19dd58b..370e98c 100644
--- a/lib/Prophet/Util.pm
+++ b/lib/Prophet/Util.pm
@@ -120,4 +120,14 @@ sub hashed_dir_name {
     return ( substr( $hash, 0, 1 ), substr( $hash, 1, 1 ), $hash );
 }
 
+sub catfile {
+    my $self = shift;
+   
+    # File::Spec::catfile is more correct, but
+    # eats over 10% of prophet app runtime, 
+    # which isn't acceptable. 
+    return join('/', at _);
+
+}
+
 1;
diff --git a/t/config.t b/t/config.t
index b01cf1a..1a11626 100644
--- a/t/config.t
+++ b/t/config.t
@@ -34,7 +34,7 @@ is( scalar @keys, 0, 'no config options are set' );
 {
     copy 't/test_app.conf', $repo;
     local $ENV{'PROPHET_APP_CONFIG'}
-        = File::Spec->catfile($repo,'test_app.conf');
+        = Prophet::Util->catfile($repo,'test_app.conf');
 
     my $app_handle = Prophet::CLI->new->app_handle;
     my $conf = Prophet::Config->new(
@@ -55,7 +55,7 @@ is( scalar @keys, 0, 'no config options are set' );
     $conf->set(
         key => 'replica.sd.url',
         value => 'http://fsck.com/sd/',
-        filename => File::Spec->catfile($repo, 'test_app.conf'),
+        filename => Prophet::Util->catfile($repo, 'test_app.conf'),
     );
     is( $conf->get( key => 'replica.sd.url' ), 'http://fsck.com/sd/',
         'automatic reload after set' );
@@ -69,7 +69,7 @@ is( scalar @keys, 0, 'no config options are set' );
     $conf->set(
         key => 'replica.sd.uuid',
         value => '32b13934-910a-4792-b5ed-c9977b212245',
-        filename => File::Spec->catfile($repo, 'test_app.conf'),
+        filename => Prophet::Util->catfile($repo, 'test_app.conf'),
     );
     is( $app_handle->display_name_for_replica('32b13934-910a-4792-b5ed-c9977b212245'),
         'sd',
@@ -85,7 +85,7 @@ Configuration:
 Config files:
 
 EOF
-    $expect .= File::Spec->catfile( $repo, 'test_app.conf' ) . "\n";
+    $expect .= Prophet::Util->catfile( $repo, 'test_app.conf' ) . "\n";
     $expect .= <<EOF;
 
 Your configuration:
diff --git a/t/export.t b/t/export.t
index de81a3f9..9e0f026 100644
--- a/t/export.t
+++ b/t/export.t
@@ -65,8 +65,8 @@ status: stalled
         is( Prophet::Util->slurp(File::Spec->catdir($path => 'replica-uuid')), replica_uuid() );
     };
 
-    ok( -e File::Spec->catfile($path => 'changesets.idx'), 'found changesets index' );
-    my $latest = Prophet::Util->slurp(File::Spec->catfile($path => 'latest-sequence-no'));
+    ok( -e Prophet::Util->catfile($path => 'changesets.idx'), 'found changesets index' );
+    my $latest = Prophet::Util->slurp(Prophet::Util->catfile($path => 'latest-sequence-no'));
     is( $latest, $cli->handle->latest_sequence_no );
     use_ok('Prophet::Replica::prophet');
     diag("Checking changesets in $path");
diff --git a/t/publish-html.t b/t/publish-html.t
index 2d40a03..1c8fe61 100644
--- a/t/publish-html.t
+++ b/t/publish-html.t
@@ -39,10 +39,10 @@ ok(!-e $merge_tickets, "_merge_tickets template directory absent");
 my $bug = File::Spec->catdir($dir => 'Bug');
 ok(-e $bug, "Bug template directory exists");
 
-my $index = File::Spec->catfile($bug =>'index.html');
+my $index = Prophet::Util->catfile($bug =>'index.html');
 ok(-e $index, "Bug/index.html exists");
 
-my $bug_template = File::Spec->catfile($bug => "$bug_uuid.html");
+my $bug_template = Prophet::Util->catfile($bug => "$bug_uuid.html");
 ok(-e $bug_template, "Bug/$bug_uuid.html exists");
 
 my $index_contents = Prophet::Util->slurp($index);
diff --git a/t/publish-pull.t b/t/publish-pull.t
index c519c4a..5fe6be8 100644
--- a/t/publish-pull.t
+++ b/t/publish-pull.t
@@ -92,8 +92,8 @@ EOF
     ok( run_command( qw(publish --to), $bogus_name ),
         'publish to bogus name',
     );
-    ok( ! -f File::Spec->catfile( $new_published, 'config' )
-        && -f File::Spec->catfile( $bogus_name, 'replica-uuid' ),
+    ok( ! -f Prophet::Util->catfile( $new_published, 'config' )
+        && -f Prophet::Util->catfile( $bogus_name, 'replica-uuid' ),
         'did not fall back to url variable' );
 };
 

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list