1 package CloudStore::Couchbase;
7 use File::Path qw(make_path);
10 use Digest::MD5 qw(md5_base64);
11 use Data::Dump qw(dump);
24 foreach my $bucket ( keys %$buckets ) {
25 my $port = $buckets->{$bucket};
26 my $server = new Cache::Memcached {
27 'servers' => [ "127.0.0.1:$port" ],
28 'debug' => $ENV{DEBUG},
29 # 'compress_threshold' => 10_000,
31 #$server->set_servers($array_ref);
32 #$server->set_compress_threshold(10_000);
33 $server->enable_compress(0);
34 $self->{$bucket} = $server;
38 warn "# new ",dump $self;
44 my ($self,$data) = @_;
45 $self->{usage}->decr( $data->{login} => $data->{size} );
49 my ($self,$data) = @_;
50 $self->{usage}->incr( $data->{login} => $data->{size} );
54 my ($self,$data) = @_;
55 $self->{usage}->get( $data->{login} );
59 my ($self,$data) = @_;
60 my $k = md5_base64( $data->{login} . '/' . $data->{file} );
61 my $json = encode_json $data;
62 $self->{files}->set( $k => $json );
67 my ($self,$data) = @_;
68 my $k = md5_base64( $data->{login} . '/' . $data->{file} );
69 if ( my $json = $self->{files}->get($k) ) {
70 return decode_json $json;
75 my ( $self,$data ) = @_;
77 if ( my $old = $self->file_get( $data ) ) {
78 $self->usage_decr( $data );
81 $self->new_file($data);
85 my ( $self,$data ) = @_;
86 $self->file_set($data);
87 $self->usage_incr($data);
91 my ( $self, $data ) = @_;
92 $self->usage_decr( $data );
93 my $k = md5_base64( $data->{login} . '/' . $data->{file} );
94 $self->{files}->delete( $k );
98 my ( $self, $data ) = @_;
103 my ( $self,$data ) = @_;
105 my $blob = "users/$data->{login}/blob";
106 my $path = "$blob/$data->{file}";
108 if ( $data->{itemize} =~ m/^[c>]([fd])/ ) { # received change/create
111 if ( $type eq 'f' ) {
112 $self->modify_file( $data );
113 $self->dedup( $data, $path );
114 } elsif ( $type eq 'd' ) {
115 $self->make_dir( $data );
117 die "unknown type $type ", dump $data;
119 } elsif ( $data->{itemize} =~ m/\*deleting/ ) {
120 $self->remove_file($data);
126 my ( $path, $md5 ) = @_;
128 my $pool = 'md5'; # FIXME sharding?
129 mkdir $pool unless -e $pool;
131 if ( -e "$pool/$md5" ) {
132 warn "dedup hit $md5 $path\n";
133 my $dedup = $path . '.dedup';
134 rename $path, $dedup;
135 link "$pool/$md5", $path;
138 link $path, "$pool/$md5";
142 my $empty_md5 = " " x 32;
145 my ( $self, $data, $path ) = @_;
147 if ( $data->{file} =~ /^(.+\/)?md5sum$/ ) {
150 warn "IMPORT ", $data->{file}, "\n";
151 open(my $md5sum, '<', $path);
154 my ( $md5, $file ) = split(/\s+/,$_,2);
155 if ( ! -e "md5/$md5" ) {
156 warn "MISSING $md5 $file\n";
159 my $new = "users/$data->{login}/blob/$dir$file";
161 # create path from md5sum file
162 my $only_dir = $1 if $new =~ m{^(.+)/[^/]+$};
163 make_path $only_dir unless -d $only_dir;
164 $imported += link "md5/$md5", $new;
166 login => $data->{login},
167 host => $data->{host},
168 file => $dir . $file,
172 $self->new_file($fake);
173 warn "fake ",dump($fake);
175 md5pool $new => $md5;
178 print "INFO imported $imported files from ",dump($data);
181 if ( $data->{md5} ne $empty_md5 ) {
182 md5pool $path => $data->{md5};