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 use LWP::Simple;
  13 use Carp qw(confess);
  14
  15 my $buckets = {
  16         users => 5800,
  17         files => 5801,
  18         session => 5802,
  19 };
  20
  21 sub new {
  22         my ($class) = @_;
  23
  24         my $self = {};
  25         bless $self, $class;
  26
  27         foreach my $bucket ( keys %$buckets ) {
  28                 my $port = $buckets->{$bucket};
  29                 my $server = new Cache::Memcached {
  30                         'servers' => [ "127.0.0.1:$port" ],
  31                         'debug' => $ENV{DEBUG},
  32                 #       'compress_threshold' => 10_000,
  33                 };
  34                 #$server->set_servers($array_ref);
  35                 #$server->set_compress_threshold(10_000);
  36                 $server->enable_compress(0);
  37                 $self->{$bucket} = $server;
  38
  39         }
  40
  41         warn "# new ",dump $self if $ENV{DEBUG};
  42
  43         return $self;
  44 }
  45
  46 sub json_set {
  47         my ($self,$bucket,$key,$data) = @_;
  48         confess "data not ref ",dump($data) unless ref $data;
  49         my $json = encode_json $data;
  50         $self->{$bucket}->set( $key => $json );
  51         warn "## $bucket set $key $json\n";
  52         return $json;
  53 }
  54
  55 sub json_get {
  56         my ($self,$bucket,$key,$data) = @_;
  57         if ( my $json = $self->{$bucket}->get($key) ) {
  58                 warn "## $bucket get $key $json\n";
  59                 return decode_json $json;
  60         }
  61 }
  62
  63 sub user_set {
  64         my ($self,$data) = @_;
  65         $self->json_set( 'users', $data->{login}, $data );
  66 }
  67
  68 sub user_get {
  69         my ($self,$login) = @_;
  70         $self->json_get( 'users', $login );
  71 }
  72
  73 sub usage_decr {
  74         my ($self,$data) = @_;
  75         $self->{session}->decr( $data->{login} . ':usage' => $data->{size} );
  76 }
  77
  78 sub usage_incr {
  79         my ($self,$data) = @_;
  80         $self->{session}->incr( $data->{login} . ':usage' => $data->{size} );
  81 }
  82
  83 sub usage {
  84         my ($self,$data) = @_;
  85         $self->{session}->get( $data->{login} . ':usage' );
  86 }
  87
  88 sub usage_init {
  89         my ($self,$data) = @_;
  90
  91         my $usage = 0;
  92
  93         my $url = sprintf
  94                 'http://localhost:5984/files/_design/files/_view/login_usage?group=true&connection_timeout=60000&limit=1&skip=0&start_key="%s"&end_key="%s"'
  95                 , $data->{login}
  96                 , $data->{login}
  97         ;
  98
  99         warn "usage from $url";
 100         if ( my $json = get $url ) {
 101                 warn "# JSON = $json\n";
 102                 my $r = decode_json $json;
 103                 warn dump $r;
 104                 $usage = $r->{rows}->[0]->{value};
 105                 $usage = 0 unless defined $usage;
 106         }
 107
 108         $self->{session}->set( $data->{login} . ':usage' => $usage );
 109 }
 110
 111 sub _file_key {
 112         my $data = shift;
 113         #md5_base64( $data->{login} . '/' . $data->{file} );
 114         $data->{login} . ':' . $data->{file};
 115 }
 116
 117 sub file_set {
 118         my ($self,$data) = @_;
 119         $self->json_set( 'files', _file_key($data), $data );
 120 }
 121
 122 sub file_get {
 123         my ($self,$data) = @_;
 124         $self->json_get( 'files', _file_key($data) );
 125 }
 126
 127 sub modify_file {
 128         my ( $self,$data ) = @_;
 129
 130         if ( my $old = $self->file_get( $data ) ) {
 131                 $self->usage_decr( $data );
 132         }
 133
 134         $self->new_file($data);
 135 }
 136
 137 sub new_file {
 138         my ( $self,$data ) = @_;
 139         $self->file_set($data);
 140         $self->usage_incr($data);
 141 }
 142
 143 sub remove_file {
 144         my ( $self, $data ) = @_;
 145         $self->usage_decr( $data );
 146         my $k = _file_key $data;
 147         $self->{files}->delete( $k );
 148 }
 149
 150 sub make_dir {
 151         my ( $self, $data ) = @_;
 152
 153 }
 154
 155 sub transfer {
 156         my ( $self,$data ) = @_;
 157
 158         my $blob = "users/$data->{login}/blob";
 159         my $path = "$blob/$data->{file}";
 160
 161         if ( $data->{itemize} =~ m/^[c>]([fd])/ ) { # received change/create
 162                 my $type = $1;
 163
 164                 if ( $type eq 'f' ) {
 165                         $self->modify_file( $data );
 166                         $self->dedup( $data, $path );
 167                 } elsif ( $type eq 'd' ) {
 168                         $self->make_dir( $data );
 169                 } else {
 170                         die "unknown type $type ", dump $data;
 171                 }
 172         } elsif ( $data->{itemize} =~ m/\*deleting/ ) {
 173                 $self->remove_file($data);
 174         }
 175         return $data;
 176 }
 177
 178 sub md5pool {
 179         my ( $path, $md5 ) = @_;
 180
 181         my $pool = 'md5'; # FIXME sharding?
 182         mkdir $pool unless -e $pool;
 183
 184         if ( -e "$pool/$md5" ) {
 185                 warn "dedup hit $md5 $path\n";
 186                 my $dedup = $path . '.dedup';
 187                 rename $path, $dedup;
 188                 link "$pool/$md5", $path;
 189                 unlink $dedup;
 190         } else {
 191                 link $path, "$pool/$md5";
 192         }
 193 }
 194
 195 my $empty_md5 = " " x 32;
 196
 197 sub dedup {
 198         my ( $self, $data, $path ) = @_;
 199
 200         if ( $data->{file} =~ /^(.+\/)?md5sum$/ ) {
 201                 my $dir = $1;
 202                 my $imported = 0;
 203                 warn "IMPORT ", $data->{file}, "\n";
 204                 open(my $md5sum, '<', $path);
 205                 while(<$md5sum>) {
 206                         chomp;
 207                         my ( $md5, $file ) = split(/\s+/,$_,2);
 208                         if ( ! -e "md5/$md5" ) {
 209                                 warn "MISSING $md5 $file\n";
 210                                 next;
 211                         }
 212                         my $new = "users/$data->{login}/blob/$dir$file";
 213                         if ( ! -e $new ) {
 214                                 # create path from md5sum file
 215                                 my $only_dir = $1 if $new =~ m{^(.+)/[^/]+$};
 216                                 make_path $only_dir unless -d $only_dir;
 217                                 $imported += link "md5/$md5", $new;
 218                                 my $fake = {
 219                                         login => $data->{login},
 220                                         host => $data->{host},
 221                                         file => $dir . $file,
 222                                         md5 => $md5,
 223                                         size => -s $new,
 224                                 };
 225                                 $self->new_file($fake);
 226                                 warn "fake ",dump($fake);
 227                         } else {
 228                                 md5pool $new => $md5;
 229                         }
 230                 }
 231                 print "INFO imported $imported files from ",dump($data);
 232         }
 233
 234         if ( $data->{md5} ne $empty_md5 ) {
 235                 md5pool $path => $data->{md5};
 236         } else {
 237
 238         }
 239 }
 240
 241 1;