File Coverage

blib/lib/App/Basis/ConvertText2/Plugin/Venn.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


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__