X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=lib%2FCloudStore%2FStore.pm;h=c879681f4f027a6bb7b2412d04177fef5063f173;hb=02112a9b62477f7aea961ac66b1276655fc9c2c5;hp=401c95ec28775ef651279c5c907b2c887c2e2bfd;hpb=d69f227a59924c4f9f4334c5f697a33f49b99181;p=cloudstore.git

diff --git a/lib/CloudStore/Store.pm b/lib/CloudStore/Store.pm
index 401c95e..c879681 100644
--- a/lib/CloudStore/Store.pm
+++ b/lib/CloudStore/Store.pm
@@ -6,173 +6,55 @@ use autodie;
 use JSON::XS;
 use File::Path qw(make_path);
 use File::Slurp qw();
-use Cache::Memcached;
 use Digest::MD5 qw(md5_base64);
 use Data::Dump qw(dump);
-use LWP::Simple;
 use Carp qw(confess);
+use BerkeleyDB;
 
 use WarnColor;
 
-my $buckets = {
-	users => 5800,
-	files => 5801,
-	session => 5802,
-};
-
 sub new {
 	my ($class) = @_;
 
 	my $self = {};
 	bless $self, $class;
 
-	foreach my $bucket ( keys %$buckets ) {
-		my $port = $buckets->{$bucket};
-		my $server = new Cache::Memcached {
-			'servers' => [ "127.0.0.1:$port" ],
-			'debug' => defined $ENV{DEBUG} && $ENV{DEBUG} > 3,
-		#	'compress_threshold' => 10_000,
-		};
-		#$server->set_servers($array_ref);
-		#$server->set_compress_threshold(10_000);
-		$server->enable_compress(0);
-		$self->{$bucket} = $server;
-
-	}
+	my %md5;
+	$self->{db} = tie %md5, 'BerkeleyDB::Hash', -Filename => '/tmp/md5.db', -Flags => DB_CREATE;
+	$self->{md5} = \%md5;
 
 	warn "# new ",dump $self if $ENV{DEBUG};
 
 	return $self;
 }
 
-sub json_set {
-	my ($self,$bucket,$key,$data) = @_;
-	confess "data not ref ",dump($data) unless ref $data;
-	my $json = encode_json $data;
-	$self->{$bucket}->set( $key => $json );
-	warn "## json_set $bucket $key $json\n";
-	return $json;
-}
-
-sub json_get {
-	my ($self,$bucket,$key,$data) = @_;
-	if ( my $json = $self->{$bucket}->get($key) ) {
-		warn "## json_get $bucket $key $json\n";
-		return decode_json $json;
-	}
-}
-
 sub user_set {
-	my ($self,$data) = @_;
-	$self->json_set( 'users', $data->{login}, $data );
+	my ( $self,$data ) = @_;
 }
 
 sub user_get {
-	my ($self,$login) = @_;
-	$login = $login->{login} if ref $login;
-	my $user = $self->json_get( 'users', $login );
-	$user->{usage} = $self->usage( $login );
-	$user->{status} = $self->status( $login );
-	warn "## user ",dump($user) if $ENV{DEBUG};
-	return $user;
-}
-
-sub status {
-	my ($self,$login,$message) = @_;
-	$login = $login->{login} if ref $login;
-	if ( $message ) {
-		$self->{session}->set( "$login:status" => $message );
-		return $message;
-	} else {
-		$self->{session}->get( "$login:status" );
-	}
-}
-
-sub usage_decr {
-	my ($self,$data) = @_;
-	$self->{session}->decr( $data->{login} . ':usage' => $data->{size} );
-}
-
-sub usage_incr {
-	my ($self,$data) = @_;
-	$self->{session}->incr( $data->{login} . ':usage' => $data->{size} );
-}
-
-sub usage {
-	my ($self,$login) = @_;
-	$login = $login->{login} if ref $login;
-	$self->{session}->get( $login . ':usage' );
-}
-
-sub couchdb {
-	my $self = shift @_;
-	my $fmt  = shift @_;
-	my $url = sprintf $fmt, @_;
-
-	warn "# couchdb $url\n";
-	if ( my $json = get $url ) {
-		warn "## $url $json\n";
-		my $r = decode_json $json;
-		return $r;
-	}
-}
-
-sub usage_init {
-	my ($self,$login) = @_;
-	$login = $login->{login} if ref $login;
-
-	my $usage = 0;
-
-	if ( my $r = $self->couchdb(
-		'http://localhost:5984/files/_design/files/_view/login_usage?group=true&connection_timeout=60000&limit=1&skip=0&start_key="%s"&end_key="%s"&stale=update_after'
-		, $login
-		, $login
-	)) {
-
-		$usage = $r->{rows}->[0]->{value};
-		$usage = 0 unless defined $usage;
-	}
-
-	$self->{session}->set( $login . ':usage' => $usage );
-}
-
-sub _file_key {
-	my $data = shift;
-	#md5_base64( $data->{login} . '/' . $data->{file} );
-	$data->{login} . ':' . $data->{file};
-}
-
-sub file_set {
-	my ($self,$data) = @_;
-	$self->json_set( 'files', _file_key($data), $data );
-}
-
-sub file_get {
-	my ($self,$data) = @_;
-	$self->json_get( 'files', _file_key($data) );
+	my ( $self,$data ) = @_;
 }
 
 sub modify_file {
 	my ( $self,$data ) = @_;
 
-	if ( my $old = $self->file_get( $data ) ) {
-		$self->usage_decr( $data );
-	}
+#	if ( my $old = $self->file_get( $data ) ) {
+#		$self->usage_decr( $data );
+#	}
 
 	$self->new_file($data);
 }
 
 sub new_file {
 	my ( $self,$data ) = @_;
-	$self->file_set($data);
-	$self->usage_incr($data);
+#	$self->file_set($data);
+#	$self->usage_incr($data);
 }
 
 sub remove_file {
 	my ( $self, $data ) = @_;
-	$self->usage_decr( $data );
-	my $k = _file_key $data;
-	$self->{files}->delete( $k );
+#	$self->usage_decr( $data );
 }
 
 sub make_dir {
@@ -221,12 +103,14 @@ sub new_link {
 
 				my ($l,$f) = ($1,$2) if $s =~ m{users/([^/]+)/blob/(.+)};
 
-				my $origin = $self->file_get({
-					login => $l,
-					file  => $f,
-				});
-				$self->new_file($origin);
-				warn "INFO: sent file ",dump($origin);
+#				my $origin = $self->file_get({
+#					login => $l,
+#					file  => $f,
+#				});
+#				$self->new_file($origin);
+				warn "INFO: sent file ",dump($l,$f);
+				my $md5 = $self->{md5}->{$s} || die "no md5 for $s";
+				$self->{md5}->{$d} = $md5;
 			}
 
 
@@ -262,7 +146,7 @@ sub transfer {
 }
 
 sub md5pool {
-	my ( $path, $md5 ) = @_;
+	my ( $self, $path, $md5 ) = @_;
 
 	my $pool = 'md5'; # FIXME sharding?
 	mkdir $pool unless -e $pool;
@@ -273,9 +157,13 @@ sub md5pool {
 		rename $path, $dedup;
 		link "$pool/$md5", $path;
 		unlink $dedup;
+		# FIXME fix perms?
 	} else {
 		link $path, "$pool/$md5";
 	}
+
+	$self->{md5}->{$path} = $md5;
+	warn "++ $md5 $path\n";
 }
 
 my $empty_md5 = " " x 32;
@@ -311,16 +199,16 @@ sub dedup {
 				$self->new_file($fake);
 				warn "import from $path ",dump($fake);
 			} else {
-				md5pool $new => $md5;
+				$self->md5pool( $new => $md5 );
 			}
 		}
 		print "INFO imported $imported files from ",dump($data);
 	}
 
 	if ( $data->{md5} ne $empty_md5 ) {
-		md5pool $path => $data->{md5};
+		$self->md5pool( $path => $data->{md5} );
 	} else {
-		
+		warn "empty md5", dump $data;
 	}
 }