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 {
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;
}
}
sub md5pool {
- my ( $path, $md5 ) = @_;
+ my ( $self, $path, $md5 ) = @_;
my $pool = 'md5'; # FIXME sharding?
mkdir $pool unless -e $pool;
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;
$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;
}
}
projects / cloudstore.git / blobdiff