t/remover.t

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
   3 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   4 use strict;
   5 use warnings;
   6 use Test::More;
   7 use Ssoma::MDA;
   8 use Ssoma::Git;
   9 use Ssoma::Remover;
  10 use Email::Simple;
  11 use Digest::SHA qw/sha1_hex/;
  12 use File::Temp qw/tempdir/;
  13
  14 my $tmpdir = tempdir(CLEANUP => 1);
  15 my $git_dir = "$tmpdir/gittest";
  16 my $git = Ssoma::Git->new($git_dir);
  17 $git->init_db;
  18 my $mda = Ssoma::MDA->new($git);
  19 my $rm = Ssoma::Remover->new($git);
  20 my @tree;
  21
  22 {
  23         my $email = Email::Simple->new(<<'EOF');
  24 From: me@example.com
  25 To: u@example.com
  26 Message-ID: <666@example.com>
  27 Subject: zzz
  28
  29 OMFG
  30 EOF
  31
  32         $mda->deliver($email);
  33         @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
  34         is($?, 0, "no error from git ls-tree");
  35         is(scalar @tree, 1, "message delivered");
  36
  37         # simple removal
  38         $rm->remove_simple($email);
  39         @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
  40         is($?, 0, "no error from git ls-tree");
  41         is(scalar @tree, 0, "tree is now empty after removal");
  42
  43         $mda->deliver($email);
  44         $email->body_set("conflict");
  45         $mda->deliver($email);
  46
  47         @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
  48         is($?, 0, "no error from git ls-tree");
  49         is(scalar @tree, 2, "both messages stored");
  50
  51         # remove only one (the concflicting one)
  52         $rm->remove_simple($email);
  53         @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
  54         is($?, 0, "no error from git ls-tree");
  55         is(scalar @tree, 1, "one removed, one exists");
  56
  57         my @line = split(/\s+/, $tree[0]);
  58         is($line[1], "blob", "back to one blob");
  59         my $cur = `GIT_DIR=$git_dir git cat-file blob $line[2]`;
  60         like($cur, qr/OMFG/, "kept original");
  61         $email->body_set("OMFG\n");
  62         $rm->remove_simple($email);
  63         @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
  64         is($?, 0, "no error from git ls-tree");
  65         is(scalar @tree, 0, "last removed");
  66
  67         my @seq = qw(1 2 3);
  68         foreach my $i (@seq) {
  69                 $email->body_set("$i\n");
  70                 $mda->deliver($email);
  71         }
  72         @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
  73         is($?, 0, "no error from git ls-tree");
  74         is(scalar @tree, scalar @seq, "several messages exist");
  75
  76         my $expect = 3;
  77         foreach my $i (@seq) {
  78                 $email->body_set("$i\n");
  79                 $rm->remove_simple($email);
  80                 @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
  81                 is($?, 0, "no error from git ls-tree");
  82                 $expect--;
  83                 is(scalar @tree, $expect, "$expect messages left");
  84         }
  85 }
  86
  87 done_testing();