t/Gearman.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More tests => 55;
   6 use Data::Dump qw(dump);
   7
   8 use lib 'lib';
   9
  10 use_ok 'CloudStore::Gearman';
  11
  12 my $hostname = `hostname -s`;
  13 chomp $hostname;
  14
  15 sub gearman {
  16         my ( $function, $args ) = @_;
  17         ok( my $o = CloudStore::Gearman->gearman_do( @_ ), join(' ',@_) );
  18         diag "result = ",dump $o if $ENV{DEBUG};
  19         return $o;
  20 }
  21
  22 sub file_exists($) {
  23         my ( $file ) = @_;
  24         CloudStore::Gearman->gearman_do( file_size => $file );
  25 }
  26
  27 sub test_refresh_file_list {
  28         my ( $login ) = @_;
  29         ok ! file_exists( "~$login/.meta/files" ), "refresh_file_list removed .meta/files";
  30         gearman list_files => "~$login";
  31 }
  32
  33 my $quota = 5 * 1024 * 1024;
  34
  35 my $u1 = gearman 'create_user' => 'test@example.com secret ' . $quota;
  36 like $u1, qr/u\d+/, "login $u1";
  37 my $u2 = gearman 'create_user' => 'test2@example.com secret ' . ($quota + 1);
  38 like $u2, qr/u\d+/, "login $u2";
  39 my $u3 = gearman 'create_user' => 'slice2@example.com secret ' . ($quota + 2);
  40 like $u3, qr/u\d+/, "login $u2 (on other slice)";
  41
  42 foreach my $login ( $u1, $u2, $u3 ) {
  43         my $o = gearman $hostname . '_s1_quota_get' => $login;
  44         diag dump $o;
  45         cmp_ok $o, '=~', qr/^(\d+)\s+(\d+)$/, 'format: used quota';
  46 }
  47
  48 gearman( 'user_usage' => $u1 );
  49
  50 gearman( $hostname . '_s1_torrent_list' );
  51
  52 diag "create .meta/files if it doesn't exist";
  53 foreach my $login ( $u1, $u2 ) {
  54         gearman list_files => "~$login";
  55         ok file_exists "~$login/.meta/files", "file_exists ~$login/.meta/files";
  56 }
  57
  58 file_exists "~$u1/foo.txt" || BAIL_OUT("~$u1/foo.txt is required for rest of tests");
  59
  60 gearman send_file => "~$u1/foo.txt#~$u2/dir with space/file with space";
  61 test_refresh_file_list "$u2";
  62
  63 my $files = gearman list_files => "~$u2";
  64 like $files, qr|dir with space/file with space|, 'found sent file in list_files';
  65
  66 gearman send_file => "~$u2/dir with space/file with space#~$u3/another dir with spaces/and file with spaces";
  67 test_refresh_file_list "$u3";
  68
  69 gearman delete => "~$u2/dir with space/file with space";
  70 test_refresh_file_list "$u2";
  71
  72 gearman delete => "~$u3/another dir with spaces/and file with spaces";
  73 test_refresh_file_list "$u3";
  74
  75 gearman send_file => "~$u1/foo.txt#~$u2/foo.txt";
  76 test_refresh_file_list "$u2";
  77
  78 gearman rename_file => "~$u2/foo.txt#bar.txt";
  79 test_refresh_file_list "$u2";
  80 gearman rename_file => "~$u2/bar.txt#baz.txt";
  81 test_refresh_file_list "$u2";
  82
  83 cmp_ok
  84 gearman( file_size => "~$u1/foo.txt" ), '==',
  85 gearman( file_size => "~$u2/baz.txt" ), 'size_same';
  86
  87 diag "test symlink to other shard";
  88 gearman send_file => "~$u1/foo.txt#~$u3/foo.txt";
  89 cmp_ok
  90 gearman( file_size => "~$u1/foo.txt" ), '==',
  91 gearman( file_size => "~$u3/foo.txt" ), 'cross-slice symlink size same';
  92 test_refresh_file_list "$u3";
  93
  94 gearman delete => "~$u2/baz.txt";
  95 test_refresh_file_list "$u2";
  96
  97 ok ! file_exists "~$u2/baz.txt", 'deleted file size';
  98