1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
#!/usr/bin/env perl
use strict;
use warnings;
use experimental qw{ say postderef signatures state };
use List::Compare;
use JSON;
my $json = JSON->new->pretty;
my @examples = (
[
[ 'A', 'a1@a.com', 'a2@a.com' ],
[ 'B', 'b1@b.com' ],
[ 'A', 'a3@a.com', 'a1@a.com' ]
],
[
[ 'A', 'a1@a.com', 'a2@a.com' ],
[ 'B', 'b1@b.com' ],
[ 'A', 'a3@a.com' ],
[ 'B', 'b2@b.com', 'b1@b.com' ]
],
);
for my $e (@examples) {
my $i = format_mailbox( $e->@* );
my @o = merge_mailbox( $e->@* );
my $o = format_mailbox(@o);
say <<"END";
Input: \@accounts =
$i
Output:
$o
END
say '';
}
# yes, a more complex version of JSON->encode
sub format_mailbox (@accounts) {
@accounts = sort { $a->[0] cmp $b->[0] } @accounts;
my $output = join ",\n\t", map { qq{[$_]} }
map {
join ',',
map { qq{"$_"} }
$_->@*
} @accounts;
$output = join ' ', '[', $output, ']';
return $output;
}
sub merge_mailbox (@input) {
my @accounts = @input;
for my $i ( 0 .. -2 + scalar @accounts ) {
my $ai = $accounts[$i];
my @ii = $ai->@*;
shift @ii;
for my $j ( $i + 1 .. -1 + scalar @accounts ) {
my $aj = $accounts[$j];
next unless defined $aj;
my @jj = $aj->@*;
shift @jj;
my $lc = List::Compare->new( \@ii, \@jj );
my @inter = $lc->get_intersection;
if ( scalar @inter ) {
my @union = $lc->get_union;
my $ni = $ai->[0];
$ai->@* = ( $ni, @union );
$aj->@* = ();
}
}
}
@accounts = sort { $a->[0] cmp $b->[0] } grep { scalar $_->@* } @accounts;
return @accounts;
}
|