Changeset 16565

Timestamp:

Feb 21, 2008, 1:20:39 PM (18 years ago)

Author:

jhoblitt

Message:

add support for storing instances in multi-tier 'hashed' directories

Location:

trunk

Files:

• Nebulous-Server/Build.PL (modified) (1 diff)
• Nebulous-Server/Changes (modified) (1 diff)
• Nebulous-Server/lib/Nebulous/Server.pm (modified) (5 diffs)
• Nebulous/Build.PL (modified) (1 diff)
• Nebulous/Changes (modified) (1 diff)
• Nebulous/lib/Nebulous/Server.pm (modified) (5 diffs)

trunk/Nebulous-Server/Build.PL

@@ -84 +84 @@
         'DBD::mysql'            => '3.0007',
         'DBI'                   => '1.53',
+        'Digest::SHA1'          => 0,
         'File::ExtAttr'         => '1.03',
+        'File::Path'            => '1.08',
+        'File::Spec'            => 0,
         'File::Spec::Functions' => 0,
         'Log::Log4perl'         => '0.48',

trunk/Nebulous-Server/Changes

@@ -2 +2 @@
 
 0.07
+    - add support for storing instances in multi-tier 'hashed' directories 
     - pickup test DB settings from the env.
     - add neb-ls -l|-1 option

trunk/Nebulous-Server/lib/Nebulous/Server.pm

@@ -1 +1 @@
 # Copyright (c) 2004  Joshua Hoblitt
 #
-# $Id: Server.pm,v 1.52 2008-02-07 22:18:51 jhoblitt Exp $
+# $Id: Server.pm,v 1.53 2008-02-21 23:20:39 jhoblitt Exp $
 
 package Nebulous::Server;
@@ -13 +13 @@
 
 use DBI;
+use Digest::SHA1 qw( sha1_hex );
 use File::ExtAttr qw( setfattr );
+use File::Path;
+use File::Spec;
 use Log::Log4perl;
 use Nebulous::Server::Config;
@@ -23 +26 @@
 
 __PACKAGE__->mk_accessors(qw( log sql config ));
+
+use constant SUBPATH_DEPTH => 3;
 
 sub new {
@@ -1229 +1234 @@
     my $log = $self->log;
     my $sql = $self->sql;
-    my $db  =$self->db;
-
-    my ($storage_filename);
-    my ($uri);
-    eval {
-        $storage_filename = $self->_generate_storage_filename($key, $ins_id);
-        # XXX put a hook for directory hashing here
-        $uri = URI::file->new("$vol_path/$storage_filename");
+    my $db  = $self->db;
+
+    my $uri;
+    eval {
+        my $storage_path = $self->_generate_storage_path($key, $vol_path);
+        my $storage_filename = $self->_generate_storage_filename($key, $ins_id);
+        unless (-d $storage_path) {
+            mkpath($storage_path)
+                or die "can't create storage path: $storage_path";
+        }
+        my $fqpn = File::Spec->catfile($storage_path, $storage_filename);
+        $uri = URI::file->new($fqpn);
         $log->debug("generated uri $uri");
         $self->_create_empty_file($uri->file);
@@ -1291 +1300 @@
 
 
+sub _generate_storage_path
+{
+    my $self = shift;
+
+    my ($key, $vol_path) = @_;
+
+    # taken and modified from Cache::File::cache_file_path()
+    # Copyright (C) 2003-2006 Chris Leishman.  All Rights Reserved.
+    my $shakey = sha1_hex($key);
+    my (@path) = unpack('A2' x SUBPATH_DEPTH, $shakey);
+
+    return File::Spec->catdir($vol_path, @path);
+}
+
+
 sub DESTROY
 {

trunk/Nebulous/Build.PL

@@ -84 +84 @@
         'DBD::mysql'            => '3.0007',
         'DBI'                   => '1.53',
+        'Digest::SHA1'          => 0,
         'File::ExtAttr'         => '1.03',
+        'File::Path'            => '1.08',
+        'File::Spec'            => 0,
         'File::Spec::Functions' => 0,
         'Log::Log4perl'         => '0.48',

trunk/Nebulous/Changes

@@ -2 +2 @@
 
 0.07
+    - add support for storing instances in multi-tier 'hashed' directories 
     - pickup test DB settings from the env.
     - add neb-ls -l|-1 option

trunk/Nebulous/lib/Nebulous/Server.pm

@@ -1 +1 @@
 # Copyright (c) 2004  Joshua Hoblitt
 #
-# $Id: Server.pm,v 1.52 2008-02-07 22:18:51 jhoblitt Exp $
+# $Id: Server.pm,v 1.53 2008-02-21 23:20:39 jhoblitt Exp $
 
 package Nebulous::Server;
@@ -13 +13 @@
 
 use DBI;
+use Digest::SHA1 qw( sha1_hex );
 use File::ExtAttr qw( setfattr );
+use File::Path;
+use File::Spec;
 use Log::Log4perl;
 use Nebulous::Server::Config;
@@ -23 +26 @@
 
 __PACKAGE__->mk_accessors(qw( log sql config ));
+
+use constant SUBPATH_DEPTH => 3;
 
 sub new {
@@ -1229 +1234 @@
     my $log = $self->log;
     my $sql = $self->sql;
-    my $db  =$self->db;
-
-    my ($storage_filename);
-    my ($uri);
-    eval {
-        $storage_filename = $self->_generate_storage_filename($key, $ins_id);
-        # XXX put a hook for directory hashing here
-        $uri = URI::file->new("$vol_path/$storage_filename");
+    my $db  = $self->db;
+
+    my $uri;
+    eval {
+        my $storage_path = $self->_generate_storage_path($key, $vol_path);
+        my $storage_filename = $self->_generate_storage_filename($key, $ins_id);
+        unless (-d $storage_path) {
+            mkpath($storage_path)
+                or die "can't create storage path: $storage_path";
+        }
+        my $fqpn = File::Spec->catfile($storage_path, $storage_filename);
+        $uri = URI::file->new($fqpn);
         $log->debug("generated uri $uri");
         $self->_create_empty_file($uri->file);
@@ -1291 +1300 @@
 
 
+sub _generate_storage_path
+{
+    my $self = shift;
+
+    my ($key, $vol_path) = @_;
+
+    # taken and modified from Cache::File::cache_file_path()
+    # Copyright (C) 2003-2006 Chris Leishman.  All Rights Reserved.
+    my $shakey = sha1_hex($key);
+    my (@path) = unpack('A2' x SUBPATH_DEPTH, $shakey);
+
+    return File::Spec->catdir($vol_path, @path);
+}
+
+
 sub DESTROY
 {