line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
=head1 NAME |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
App::Basis::ConvertText2::Plugin::Venn |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 SYNOPSIS |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
my $content = "abel edward momo albert jack julien chris |
9
|
|
|
|
|
|
|
edward isabel antonio delta albert kevin jake |
10
|
|
|
|
|
|
|
gerald jake kevin lucia john edward" ; |
11
|
|
|
|
|
|
|
my $params = { |
12
|
|
|
|
|
|
|
title => "sample venn diagram", |
13
|
|
|
|
|
|
|
legends => "team1 team2 team3", |
14
|
|
|
|
|
|
|
scheme => "rgb", |
15
|
|
|
|
|
|
|
explain => '1' |
16
|
|
|
|
|
|
|
} ; |
17
|
|
|
|
|
|
|
my $obj = App::Basis::ConvertText2::Plugin::Venn->new() ; |
18
|
|
|
|
|
|
|
my $out = $obj->process( 'venn', $content, $params) ; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 DESCRIPTION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Convert a text string of comma separated numbers into a Venn diagran image PNG |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=cut |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
package App::Basis::ConvertText2::Plugin::Venn; |
29
|
|
|
|
|
|
|
$App::Basis::ConvertText2::Plugin::Venn::VERSION = '0.4'; |
30
|
1
|
|
|
1
|
|
1773
|
use 5.10.0; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
40
|
|
31
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
28
|
|
32
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
33
|
1
|
|
|
1
|
|
397
|
use GD; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# we need to do this to ensure that venn::chart uses the right level of color |
36
|
|
|
|
|
|
|
GD::Image->trueColor(0); |
37
|
|
|
|
|
|
|
use Venn::Chart; |
38
|
|
|
|
|
|
|
use Path::Tiny; |
39
|
|
|
|
|
|
|
use Moo; |
40
|
|
|
|
|
|
|
use App::Basis; |
41
|
|
|
|
|
|
|
use App::Basis::ConvertText2::Support; |
42
|
|
|
|
|
|
|
use namespace::autoclean; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
has handles => ( |
45
|
|
|
|
|
|
|
is => 'ro', |
46
|
|
|
|
|
|
|
init_arg => undef, |
47
|
|
|
|
|
|
|
default => sub {[qw{venn}]} |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# ----------------------------------------------------------------------------- |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
my %_colour_schemes = ( |
53
|
|
|
|
|
|
|
default => [ [ 189, 66, 238, 0 ], [ 255, 133, 0, 0 ], [ 0, 107, 44, 0 ] ], |
54
|
|
|
|
|
|
|
rgb => [ [ 0x99, 00, 00, 40 ], [ 0x33, 0x99, 0xcc, 40 ], [ 0, 0x66, 0, 40 ] ], |
55
|
|
|
|
|
|
|
rgb1 => [ [ 0x99, 00, 00, 240 ], [ 0x33, 0x99, 0xcc, 240 ], [ 0, 0x66, 0, 240 ] ], |
56
|
|
|
|
|
|
|
rgb2 => [ [ 0x99, 00, 00, 0 ], [ 0x33, 0x99, 0xcc, 0 ], [ 0, 0x66, 0, 0 ] ], |
57
|
|
|
|
|
|
|
blue => [ [ 98, 66, 238, 0 ], [ 98, 211, 124, 0 ], [ 110, 205, 225, 0 ] ], |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# ----------------------------------------------------------------------------- |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=item venn |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
create a simple venn diagram image, with some nice defaults, returns some |
65
|
|
|
|
|
|
|
markdown explaining the diagram, undex/empty if errors |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
parameters |
68
|
|
|
|
|
|
|
text - 2 or 3 space separated lines of items for the venn |
69
|
|
|
|
|
|
|
filename - filename to save the created image as |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
hashref params of |
72
|
|
|
|
|
|
|
title - title for the image |
73
|
|
|
|
|
|
|
legends - legends to match the lines |
74
|
|
|
|
|
|
|
size - size of image, default 400x400, widthxheight - optional |
75
|
|
|
|
|
|
|
scheme - color scheme |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=cut |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub process { |
80
|
|
|
|
|
|
|
my $self = shift; |
81
|
|
|
|
|
|
|
my ( $tag, $content, $params, $cachedir ) = @_; |
82
|
|
|
|
|
|
|
$params->{size} ||= ""; |
83
|
|
|
|
|
|
|
$params->{title} ||= ""; |
84
|
|
|
|
|
|
|
$params->{legends} ||= ""; |
85
|
|
|
|
|
|
|
$params->{size} ||= "400x400"; |
86
|
|
|
|
|
|
|
$params->{scheme} ||= 'default'; |
87
|
|
|
|
|
|
|
$params->{scheme} = lc( $params->{scheme} ); |
88
|
|
|
|
|
|
|
my ( $w, $h ) = ( $params->{size} =~ /^\s*(\d+)\s*x\s*(\d+)\s*$/ ); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
if ( !$h ) { |
91
|
|
|
|
|
|
|
$w = 400; |
92
|
|
|
|
|
|
|
$h = 400; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
return "" if ( !$content ); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# we can use the cache or process everything ourselves |
97
|
|
|
|
|
|
|
my $sig = create_sig( $content, $params ); |
98
|
|
|
|
|
|
|
my $filename = cachefile( $cachedir, "$sig.png" ); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# we will not check for the cachefile as we need to create the venn object |
101
|
|
|
|
|
|
|
# each time to get the explaination text, besides not many people will |
102
|
|
|
|
|
|
|
# use this plugin, so lets not go to the extra effort |
103
|
|
|
|
|
|
|
my $venn_chart = Venn::Chart->new( $w, $h ) or die("error : $!"); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# lose any leading spaces |
106
|
|
|
|
|
|
|
$content =~ s/^\s+//s; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Set a title, colors and a legend for our chart |
109
|
|
|
|
|
|
|
my $colors = $_colour_schemes{ $params->{scheme} } ? $_colour_schemes{ $params->{scheme} } : $_colour_schemes{default}; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$venn_chart->set_options( -title => $params->{title}, -colors => $colors ); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
my @legends; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# decide how to split the legends |
116
|
|
|
|
|
|
|
if ( $params->{legends} =~ /,/ ) { |
117
|
|
|
|
|
|
|
@legends = map { my $n = $_; $n =~ s/^\s+//; $n } split( /,/, $params->{legends} ); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
else { |
120
|
|
|
|
|
|
|
@legends = split( /\s/, $params->{legends} ); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# get the venn data, max 3 lines of it |
124
|
|
|
|
|
|
|
my $lines = 0; |
125
|
|
|
|
|
|
|
my @data; |
126
|
|
|
|
|
|
|
my @newlegends; |
127
|
|
|
|
|
|
|
foreach my $line ( split( /\n/, $content ) ) { |
128
|
|
|
|
|
|
|
$line =~ s/^s+//; # remove leading spaces |
129
|
|
|
|
|
|
|
next if ( !$line ); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# update legends with members |
132
|
|
|
|
|
|
|
my $l = $legends[$lines]; |
133
|
|
|
|
|
|
|
if ( !$l ) { |
134
|
|
|
|
|
|
|
$l = 'missing'; |
135
|
|
|
|
|
|
|
push @legends, $l; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
push @newlegends, "$l : $line"; |
138
|
|
|
|
|
|
|
last if ( ++$lines > 3 ); |
139
|
|
|
|
|
|
|
my @a = split( /[,\s+]/, $line ); |
140
|
|
|
|
|
|
|
push @data, \@a; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
$venn_chart->set_legends(@newlegends); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Create a diagram with gd object |
145
|
|
|
|
|
|
|
my $gd_venn = $venn_chart->plot(@data); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# Create a Venn diagram image in png format |
148
|
|
|
|
|
|
|
path($filename)->spew_raw( $gd_venn->png() ); |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
my $out; |
151
|
|
|
|
|
|
|
if ( -f $filename ) { |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# now explain what is in each region |
154
|
|
|
|
|
|
|
my @ref_lists = $venn_chart->get_list_regions(); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# create something suitable for the HTML |
157
|
|
|
|
|
|
|
$out = create_img_src( $filename, $params->{title} ); |
158
|
|
|
|
|
|
|
$out .= "\n\n" . "* only in $legends[0] : " . join( ' ', @{ $ref_lists[0] } ) . " |
159
|
|
|
|
|
|
|
* only in $legends[1] : " . join( ' ', @{ $ref_lists[1] } ) . " |
160
|
|
|
|
|
|
|
* $legends[0] and $legends[1] share : " . join( ' ', @{ $ref_lists[2] } ) . "\n"; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
if ( scalar(@newlegends) > 2 ) { |
163
|
|
|
|
|
|
|
$out .= "* only in $legends[2] : " . join( ' ', @{ $ref_lists[3] } ) . " |
164
|
|
|
|
|
|
|
* $legends[0] and $legends[2] share : " . join( ' ', @{ $ref_lists[4] } ) . " |
165
|
|
|
|
|
|
|
* $legends[1] and $legends[2] share : " . join( ' ', @{ $ref_lists[5] } ) . " |
166
|
|
|
|
|
|
|
* $legends[0], $legends[1] and $legends[2] share : " . join( ' ', @{ $ref_lists[6] } ) . "\n"; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
$out .= "\n"; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
return $out; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
1; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
__END__ |