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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
package SmilesScripts::DiffMessage;
use strict;
use warnings;
use Exporter qw( import );
our @EXPORT_OK = qw( aggregate_messages message message_isomorphism );
use List::Util qw( uniq );
sub new
{
my ( $class, $args ) = @_;
my $self = { text => undef, type => undef };
for my $key ( keys %{ $args } ) {
if( exists $args->{$key} ) {
$self->{$key} = $args->{$key}
} else {
die "unknown key '$key' for CODCHEM::DiffMessage\n";
}
}
return bless $self, $class;
}
sub text
{
my ( $self, $args ) = @_;
if( scalar @_ == 2 ) {
$self->{'text'} = $args;
} else {
return ref $self->{'text'} ? @{$self->{'text'}} : $self->{'text'};
}
}
sub type
{
my ( $self, $args ) = @_;
if( scalar @_ == 2 ) {
$self->{'type'} = $args;
} else {
return $self->{'type'};
}
}
sub message
{
return CODCHEM::DiffMessage->new( @_ );
}
sub message_isomorphism
{
return CODCHEM::DiffMessage->new( { type => 'isomorphism',
text => (@_ == 1 ? $_[0] : [@_]) } );
}
sub aggregate_messages
{
my ( $messages ) = @_;
my @isomorphism = ();
my @modulo = ();
my @other = ();
my @errors = ();
my $aggregated_message = '';
for my $message ( @{ $messages } ) {
if( defined $message->type && $message->type &&
$message->type eq 'isomorphism' ) {
push @isomorphism, $message;
} elsif( defined $message->type && $message->type &&
$message->type eq 'modulo' ) {
push @modulo, $message;
} elsif( defined $message->type && $message->type &&
$message->type eq 'error' ) {
push @errors, $message;
} else {
push @other, $message;
}
}
@isomorphism = sort { $a cmp $b } uniq map { $_->text } @isomorphism;
@modulo = sort { $a cmp $b } uniq map { $_->text } @modulo;
@other = sort { $a cmp $b } uniq map { $_->text } @other;
@errors = sort { $a cmp $b } uniq map { $_->text } @errors;
# Printing out the messages.
if( @isomorphism ) {
if( grep { $_ eq 'isomorphic' } @isomorphism ) {
$aggregated_message .= "$_\t" . join( ',', @isomorphism ) . "\n";
} elsif( @modulo ) {
$aggregated_message .= "$_\t" . 'isomorphic modulo ' .
join( ', ', sort { $a cmp $b } ( @modulo, @isomorphism ) ) .
"\n";
} else {
$aggregated_message .= "$_\t" . 'isomorphic modulo ' .
join( ', ', sort @isomorphism ) . "\n";
}
} else {
$aggregated_message .= "$_\t" . join( ',', @other ) . "\n";
}
return $aggregated_message;
}
1;
|
