lib/CloudStore/Couchbase.pm

   1 package CloudStore::Couchbase;
   2 use warnings;
   3 use strict;
   4
   5 use autodie;
   6 use JSON::XS;
   7 use File::Path qw(make_path);
   8 use File::Slurp qw();
   9 use Cache::Memcached;
  10 use Digest::MD5 qw(md5_base64);
  11 use Data::Dump qw(dump);
  12
  13 my $buckets = {
  14         files => 5800,
  15         session => 5801,
  16 };
  17
  18 sub new {
  19         my ($class) = @_;
  20
  21         my $self = {};
  22         bless $self, $class;
  23
  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,
  30                 };
  31                 #$server->set_servers($array_ref);
  32                 #$server->set_compress_threshold(10_000);
  33                 $server->enable_compress(0);
  34                 $self->{$bucket} = $server;
  35
  36         }
  37
  38         warn "# new ",dump $self;
  39
  40         return $self;
  41 }
  42
  43 sub usage_decr {
  44         my ($self,$data) = @_;
  45         $self->{session}->decr( $data->{login} . ':usage' => $data->{size} );
  46 }
  47
  48 sub usage_incr {
  49         my ($self,$data) = @_;
  50         $self->{session}->incr( $data->{login} . ':usage' => $data->{size} );
  51 }
  52
  53 sub usage {
  54         my ($self,$data) = @_;
  55         $self->{session}->get( $data->{login} . ':usage' );
  56 }
  57
  58 sub _key {
  59         my $data = shift;
  60         #md5_base64( $data->{login} . '/' . $data->{file} );
  61         $data->{login} . ':' . $data->{file};
  62 }
  63
  64 sub file_set {
  65         my ($self,$data) = @_;
  66         my $k = _key $data;
  67         my $json = encode_json $data;
  68         $self->{files}->set( $k => $json );
  69         return $json;
  70 }
  71
  72 sub file_get {
  73         my ($self,$data) = @_;
  74         my $k = _key $data;
  75         if ( my $json = $self->{files}->get($k) ) {
  76                 return decode_json $json;
  77         }
  78 }
  79
  80 sub modify_file {
  81         my ( $self,$data ) = @_;
  82
  83         if ( my $old = $self->file_get( $data ) ) {
  84                 $self->usage_decr( $data );
  85         }
  86
  87         $self->new_file($data);
  88 }
  89
  90 sub new_file {
  91         my ( $self,$data ) = @_;
  92         $self->file_set($data);
  93         $self->usage_incr($data);
  94 }
  95
  96 sub remove_file {
  97         my ( $self, $data ) = @_;
  98         $self->usage_decr( $data );
  99         my $k = _key $data;
 100         $self->{files}->delete( $k );
 101 }
 102
 103 sub make_dir {
 104         my ( $self, $data ) = @_;
 105
 106 }
 107
 108 sub transfer {
 109         my ( $self,$data ) = @_;
 110
 111         my $blob = "users/$data->{login}/blob";
 112         my $path = "$blob/$data->{file}";
 113
 114         if ( $data->{itemize} =~ m/^[c>]([fd])/ ) { # received change/create
 115                 my $type = $1;
 116
 117                 if ( $type eq 'f' ) {
 118                         $self->modify_file( $data );
 119                         $self->dedup( $data, $path );
 120                 } elsif ( $type eq 'd' ) {
 121                         $self->make_dir( $data );
 122                 } else {
 123                         die "unknown type $type ", dump $data;
 124                 }
 125         } elsif ( $data->{itemize} =~ m/\*deleting/ ) {
 126                 $self->remove_file($data);
 127         }
 128         return $data;
 129 }
 130
 131 sub md5pool {
 132         my ( $path, $md5 ) = @_;
 133
 134         my $pool = 'md5'; # FIXME sharding?
 135         mkdir $pool unless -e $pool;
 136
 137         if ( -e "$pool/$md5" ) {
 138                 warn "dedup hit $md5 $path\n";
 139                 my $dedup = $path . '.dedup';
 140                 rename $path, $dedup;
 141                 link "$pool/$md5", $path;
 142                 unlink $dedup;
 143         } else {
 144                 link $path, "$pool/$md5";
 145         }
 146 }
 147
 148 my $empty_md5 = " " x 32;
 149
 150 sub dedup {
 151         my ( $self, $data, $path ) = @_;
 152
 153         if ( $data->{file} =~ /^(.+\/)?md5sum$/ ) {
 154                 my $dir = $1;
 155                 my $imported = 0;
 156                 warn "IMPORT ", $data->{file}, "\n";
 157                 open(my $md5sum, '<', $path);
 158                 while(<$md5sum>) {
 159                         chomp;
 160                         my ( $md5, $file ) = split(/\s+/,$_,2);
 161                         if ( ! -e "md5/$md5" ) {
 162                                 warn "MISSING $md5 $file\n";
 163                                 next;
 164                         }
 165                         my $new = "users/$data->{login}/blob/$dir$file";
 166                         if ( ! -e $new ) {
 167                                 # create path from md5sum file
 168                                 my $only_dir = $1 if $new =~ m{^(.+)/[^/]+$};
 169                                 make_path $only_dir unless -d $only_dir;
 170                                 $imported += link "md5/$md5", $new;
 171                                 my $fake = {
 172                                         login => $data->{login},
 173                                         host => $data->{host},
 174                                         file => $dir . $file,
 175                                         md5 => $md5,
 176                                         size => -s $new,
 177                                 };
 178                                 $self->new_file($fake);
 179                                 warn "fake ",dump($fake);
 180                         } else {
 181                                 md5pool $new => $md5;
 182                         }
 183                 }
 184                 print "INFO imported $imported files from ",dump($data);
 185         }
 186
 187         if ( $data->{md5} ne $empty_md5 ) {
 188                 md5pool $path => $data->{md5};
 189         } else {
 190
 191         }
 192 }
 193
 194 1;