File Coverage

blib/lib/AlignDB/ToXLSX.pm
Criterion Covered Total %
statement 449 516 87.0
branch 60 124 48.3
condition 30 80 37.5
subroutine 31 34 91.1
pod 0 21 0.0
total 570 775 73.5


line stmt bran cond sub pod time code
1             package AlignDB::ToXLSX;
2 6     6   883537 use Moose;
  6         1698996  
  6         27  
3 6     6   26126 use Carp;
  6         11  
  6         323  
4 6     6   2960 use YAML::Syck;
  6         8273  
  6         289  
5              
6 6     6   7229 use Excel::Writer::XLSX;
  6         571154  
  6         245  
7 6     6   3019 use Statistics::Descriptive;
  6         73447  
  6         143  
8 6     6   2463 use Chart::Math::Axis;
  6         196205  
  6         187  
9 6     6   37 use List::Util qw();
  6         10  
  6         80  
10 6     6   23 use List::MoreUtils qw();
  6         7  
  6         20859  
11              
12             our $VERSION = '1.2.1';
13              
14             # Mysql dbh
15             has dbh => ( is => 'ro', isa => 'Object' );
16              
17             # outfiles
18             has outfile => ( is => 'ro', isa => 'Str' ); # output file, autogenerable
19             has workbook => ( is => 'ro', isa => 'Object' ); # excel workbook object
20             has format => ( is => 'ro', isa => 'HashRef' ); # excel formats
21              
22             # worksheet cursor
23             has row => ( is => 'rw', isa => 'Num', default => sub {0}, );
24             has column => ( is => 'rw', isa => 'Num', default => sub {0}, );
25              
26             # charts
27             has font_name => ( is => 'rw', isa => 'Str', default => sub {'Arial'}, );
28             has font_size => ( is => 'rw', isa => 'Num', default => sub {10}, );
29             has width => ( is => 'rw', isa => 'Num', default => sub {320}, );
30             has height => ( is => 'rw', isa => 'Num', default => sub {320}, );
31             has max_ticks => ( is => 'rw', isa => 'Int', default => sub {6} );
32              
33             # Replace texts in titles
34             has replace => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
35              
36             sub BUILD {
37 5     5 0 5492 my $self = shift;
38              
39             # set outfile
40 5 50       26 unless ( $self->{outfile} ) {
41 0         0 $self->{outfile} = "auto.xlsx";
42             }
43              
44             # Create $workbook object
45 5         6 my $workbook;
46 5 50       66 unless ( $workbook = Excel::Writer::XLSX->new( $self->{outfile} ) ) {
47 0         0 confess "Cannot create Excel file.\n";
48 0         0 return;
49             }
50 5         1981 $self->{workbook} = $workbook;
51              
52             # set $workbook format
53             my %font = (
54             font => $self->{font_name},
55             size => $self->{font_size},
56 5         21 );
57 5         23 my %header = (
58             align => 'center',
59             bg_color => 42,
60             bold => 1,
61             bottom => 2,
62             );
63 5         52 my $format = {
64             HEADER => $workbook->add_format( %header, %font, ),
65             HIGHLIGHT => $workbook->add_format( color => 'blue', %font, ),
66             NORMAL => $workbook->add_format( color => 'black', %font, ),
67             NAME => $workbook->add_format( bold => 1, color => 57, %font, ),
68             TOTAL => $workbook->add_format( bold => 1, top => 2, %font, ),
69             DATE => $workbook->add_format(
70             align => 'left',
71             bg_color => 42,
72             bold => 1,
73             num_format => 'yyyy-mm-dd hh:mm',
74             %font,
75             ),
76             URL => $workbook->add_format( color => 'blue', underline => 1, %font, ),
77             URLHEADER => $workbook->add_format( color => 'blue', underline => 1, %header, %font, ),
78             };
79 5         3726 $self->{format} = $format;
80              
81 5         18 return;
82             }
83              
84             sub increase_row {
85 39     39 0 205 my $self = shift;
86 39   50     115 my $step = shift || 1;
87              
88 39         165 $self->{row} += $step;
89             }
90              
91             sub increase_column {
92 9     9 0 9 my $self = shift;
93 9   50     28 my $step = shift || 1;
94              
95 9         10 $self->{column} += $step;
96             }
97              
98             #@returns Excel::Writer::XLSX::Worksheet
99             sub write_header {
100 4     4 0 171 my $self = shift;
101 4         10 my $sheet_name = shift;
102 4         5 my $opt = shift;
103              
104             # init
105             #@type Excel::Writer::XLSX::Workbook
106 4         9 my $workbook = $self->{workbook};
107              
108             #@type Excel::Writer::XLSX::Worksheet
109 4         34 my $sheet = $workbook->add_worksheet($sheet_name);
110 4         766 my $format = $self->{format};
111              
112 4         8 my $header = $opt->{header};
113 4         7 my $query_name = $opt->{query_name};
114              
115             # create table header
116 4         21 for ( my $i = 0; $i < $self->{column}; $i++ ) {
117 2         11 $sheet->write( $self->{row}, $i, $query_name, $format->{HEADER} );
118             }
119 4         155 for ( my $i = 0; $i < scalar @{$header}; $i++ ) {
  21         751  
120 17         48 $sheet->write( $self->{row}, $i + $self->{column}, $header->[$i], $format->{HEADER} );
121             }
122 4         19 $sheet->freeze_panes( 1, 0 ); # freeze table
123              
124 4         70 $self->increase_row;
125 4         11 return $sheet;
126             }
127              
128             sub sql2names {
129 1     1 0 11 my $self = shift;
130 1         2 my $sql = shift;
131 1         1 my $opt = shift;
132              
133             # bind value
134 1         2 my $bind_value = $opt->{bind_value};
135 1 50       5 if ( !defined $bind_value ) {
136 1         1 $bind_value = [];
137             }
138              
139             #@type DBI
140 1         2 my $dbh = $self->{dbh};
141              
142             #@type DBI
143 1         19 my $sth = $dbh->prepare($sql);
144 1         5886 $sth->execute( @{$bind_value} );
  1         8  
145 1         104559 my @names = @{ $sth->{'NAME'} };
  1         20  
146              
147 1         55 return @names;
148             }
149              
150             sub write_row {
151 1     1 0 6 my $self = shift;
152              
153             #@type Excel::Writer::XLSX::Worksheet
154 1         1 my $sheet = shift;
155 1         2 my $opt = shift;
156              
157             # init
158 1         2 my $format = $self->{format};
159              
160             # query name
161 1         1 my $query_name = $opt->{query_name};
162 1 50       3 if ( defined $query_name ) {
163 1         9 $sheet->write( $self->{row}, $self->{column} - 1, $query_name, $format->{NAME} );
164             }
165              
166             # array_ref
167 1         41 my $row = $opt->{row};
168              
169             # insert table
170 1         4 for ( my $i = 0; $i < scalar @$row; $i++ ) {
171 5         120 $sheet->write( $self->{row}, $i + $self->{column}, $row->[$i], $format->{NORMAL} );
172             }
173              
174 1         26 $self->increase_row;
175 1         5 return;
176             }
177              
178             sub write_column {
179 9     9 0 59 my $self = shift;
180              
181             #@type Excel::Writer::XLSX::Worksheet
182 9         8 my $sheet = shift;
183 9         6 my $opt = shift;
184              
185             # init
186 9         10 my $format = $self->{format};
187              
188             # query name
189 9         7 my $query_name = $opt->{query_name};
190 9 100       15 if ( defined $query_name ) {
191 2         7 $sheet->write( $self->{row} - 1, $self->{column}, $query_name, $format->{NAME} );
192             }
193              
194             # array_ref
195 9         83 my $column = $opt->{column};
196              
197             # insert table
198 9         20 $sheet->write( $self->{row}, $self->{column}, [$column], $format->{NORMAL} );
199              
200 9         1157 $self->increase_column;
201 9         18 return;
202             }
203              
204             sub write_sql {
205 3     3 0 23 my $self = shift;
206              
207             #@type Excel::Writer::XLSX::Worksheet
208 3         3 my $sheet = shift;
209 3         5 my $opt = shift;
210              
211             # init
212 3         4 my $format = $self->{format};
213              
214             # query name
215 3         5 my $query_name = $opt->{query_name};
216 3 100       9 if ( defined $query_name ) {
217 2         9 $sheet->write( $self->{row}, $self->{column} - 1, $query_name, $format->{NAME} );
218             }
219              
220             # bind value
221 3         100 my $bind_value = $opt->{bind_value};
222 3 50       7 if ( !defined $bind_value ) {
223 3         6 $bind_value = [];
224             }
225              
226             # init DBI query
227 3         4 my $sql_query = $opt->{sql_query};
228              
229             #@type DBI
230 3         5 my $dbh = $self->{dbh};
231              
232             #@type DBI
233 3         26 my $sth = $dbh->prepare($sql_query);
234 3         9729 $sth->execute( @{$bind_value} );
  3         17  
235              
236             # init $data
237 3         288859 my $data;
238 3 50       13 if ( exists $opt->{data} ) {
239 3 50 33     29 if ( defined $opt->{data} and ref( $opt->{data} ) eq 'ARRAY' ) {
240 0         0 $data = $opt->{data};
241             }
242             else {
243 3         5 $data = [];
244 3         5 push @{$data}, [] for @{ $sth->{'NAME'} };
  3         28  
  9         104  
245             }
246             }
247              
248             # insert table rows
249 3         75 while ( my @row = $sth->fetchrow_array ) {
250 32         654 for ( my $i = 0; $i < scalar @row; $i++ ) {
251 96 50       2298 if ( exists $opt->{data} ) {
252 96         67 push @{ $data->[$i] }, $row[$i];
  96         138  
253             }
254 96         220 $sheet->write( $self->{row}, $i + $self->{column}, $row[$i], $format->{NORMAL} );
255             }
256 32         1215 $self->increase_row;
257             }
258              
259 3         69 return $data;
260             }
261              
262             sub make_combine {
263 1     1 0 16 my $self = shift;
264 1         1 my $opt = shift;
265              
266             # init parameters
267 1         2 my $sql_query = $opt->{sql_query};
268 1         1 my $threshold = $opt->{threshold};
269 1         3 my $standalone = $opt->{standalone};
270              
271             # bind value
272 1         1 my $bind_value = $opt->{bind_value};
273 1 50       6 unless ( defined $bind_value ) {
274 1         1 $bind_value = [];
275             }
276              
277             # merge_last
278 1         1 my $merge_last = $opt->{merge_last};
279 1 50       3 unless ( defined $merge_last ) {
280 0         0 $merge_last = 0;
281             }
282              
283             # init DBI query
284             #@type DBI
285 1         2 my $dbh = $self->{dbh};
286              
287             #@type DBI
288 1         12 my $sth = $dbh->prepare($sql_query);
289 1         5311 $sth->execute(@$bind_value);
290              
291 1         117163 my @row_count = ();
292 1         39 while ( my @row = $sth->fetchrow_array ) {
293 58         932 push @row_count, \@row;
294             }
295              
296 1         13 my @combined; # return these
297 1         2 my @temp_combined = ();
298 1         3 my $temp_count = 0;
299 1         3 foreach my $row_ref (@row_count) {
300 58 100   115   71 if ( List::MoreUtils::PP::any { $_ eq $row_ref->[0] } @{$standalone} ) {
  115 50       295  
  58         83  
301 2         11 push @combined, [ $row_ref->[0] ];
302             }
303             elsif ( $temp_count < $threshold ) {
304 56         158 push @temp_combined, $row_ref->[0];
305 56         38 $temp_count += $row_ref->[1];
306              
307 56 100       51 if ( $temp_count < $threshold ) {
308 48         55 next;
309             }
310             else {
311 8         14 push @combined, [@temp_combined];
312 8         9 @temp_combined = ();
313 8         13 $temp_count = 0;
314             }
315             }
316             else {
317 0         0 warn "Errors occured in calculating combined distance.\n";
318             }
319             }
320              
321             # Write the last weighted row which COUNT might
322             # be smaller than $threshold
323 1 50       4 if ( $temp_count > 0 ) {
324 1 50       3 if ($merge_last) {
325 1 50       3 if ( @combined == 0 ) {
326 0         0 @combined = ( [] );
327             }
328 1         2 push @{ $combined[-1] }, @temp_combined;
  1         3  
329             }
330             else {
331 0         0 push @combined, [@temp_combined];
332             }
333             }
334              
335 1         19 return \@combined;
336             }
337              
338             sub make_combine_piece {
339 1     1 0 1411 my ( $self, $opt ) = @_;
340              
341             #@type DBI
342 1         3 my $dbh = $self->{dbh};
343              
344             # init parameters
345 1         2 my $sql_query = $opt->{sql_query};
346 1         2 my $piece = $opt->{piece};
347              
348             # bind value
349 1         2 my $bind_value = $opt->{bind_value};
350 1 50       4 unless ( defined $bind_value ) {
351 1         2 $bind_value = [];
352             }
353              
354             # init DBI query
355             #@type DBI
356 1         9 my $sth = $dbh->prepare($sql_query);
357 1         1585 $sth->execute(@$bind_value);
358              
359 1         83074 my @row_count = ();
360 1         9 while ( my @row = $sth->fetchrow_array ) {
361 1000         15263 push @row_count, \@row;
362             }
363              
364 1         14 my $sum;
365 1         209 $sum += $_->[1] for @row_count;
366 1         4 my $small_chunk = $sum / $piece;
367              
368 1         1 my @combined; # return these
369 1         3 my @temp_combined = ();
370 1         1 my $temp_count = 0;
371 1         3 for my $row_ref (@row_count) {
372 1000 50       789 if ( $temp_count < $small_chunk ) {
373 1000         700 push @temp_combined, $row_ref->[0];
374 1000         593 $temp_count += $row_ref->[1];
375              
376 1000 100       1138 if ( $temp_count >= $small_chunk ) {
377 19         104 push @combined, [@temp_combined];
378 19         46 @temp_combined = ();
379 19         17 $temp_count = 0;
380             }
381             }
382             else {
383 0         0 warn "Errors occured in calculating combined distance.\n";
384             }
385             }
386              
387             # Write the last weighted row which COUNT might
388             # be smaller than $threshold
389 1 50       4 if ( $temp_count > 0 ) {
390 1         6 push @combined, [@temp_combined];
391             }
392              
393 1         115 return \@combined;
394             }
395              
396             sub make_last_portion {
397 1     1 0 1125 my ( $self, $opt ) = @_;
398              
399             #@type DBI
400 1         4 my $dbh = $self->{dbh};
401              
402             # init parameters
403 1         2 my $sql_query = $opt->{sql_query};
404 1         1 my $portion = $opt->{portion};
405              
406             # init DBI query
407             #@type DBI
408 1         10 my $sth = $dbh->prepare($sql_query);
409 1         1792 $sth->execute;
410              
411 1         117928 my @row_count = ();
412 1         10 while ( my @row = $sth->fetchrow_array ) {
413 58         980 push @row_count, \@row;
414             }
415              
416 1         14 my @last_portion; # return @last_portion
417 1         2 my $all_length = 0; # return $all_length
418 1         2 foreach (@row_count) {
419 58         37 $all_length += $_->[2];
420             }
421 1         5 my @rev_row_count = reverse @row_count;
422 1         2 my $temp_length = 0;
423 1         2 foreach (@rev_row_count) {
424 13         14 push @last_portion, $_->[0];
425 13         22 $temp_length += $_->[2];
426 13 100       21 if ( $temp_length >= $all_length * $portion ) {
427 1         4 last;
428             }
429             }
430              
431 1         16 return ( $all_length, \@last_portion );
432             }
433              
434             sub excute_sql {
435 1     1 0 1293 my ( $self, $opt ) = @_;
436              
437             # bind value
438 1         3 my $bind_value = $opt->{bind_value};
439 1 50       4 unless ( defined $bind_value ) {
440 1         3 $bind_value = [];
441             }
442              
443             # init DBI query
444 1         2 my $sql_query = $opt->{sql_query};
445              
446             #@type DBI
447 1         2 my $dbh = $self->{dbh};
448              
449             #@type DBI
450 1         9 my $sth = $dbh->prepare($sql_query);
451 1         555 $sth->execute( @{$bind_value} );
  1         6  
452             }
453              
454             sub check_column {
455 0     0 0 0 my ( $self, $table, $column ) = @_;
456              
457             # init
458             #@type DBI
459 0         0 my $dbh = $self->{dbh};
460              
461             { # check table existing
462 0         0 my @table_names = $dbh->tables( '', '', '' );
463              
464             # table names are quoted by ` (back-quotes) which is the
465             # quote_identifier
466 0         0 my $table_name = "`$table`";
467 0 0   0   0 unless ( List::MoreUtils::PP::any { $_ =~ /$table_name/i } @table_names ) {
  0         0  
468 0         0 print " " x 4, "Table $table does not exist\n";
469 0         0 return 0;
470             }
471             }
472              
473             { # check column existing
474 0         0 my $sql_query = qq{
  0         0  
475             SHOW FIELDS
476             FROM $table
477             LIKE "$column"
478             };
479              
480             #@type DBI
481 0         0 my $sth = $dbh->prepare($sql_query);
482 0         0 $sth->execute();
483 0         0 my ($field) = $sth->fetchrow_array;
484              
485 0 0       0 if ( not $field ) {
486 0         0 print " " x 4, "Column $column does not exist\n";
487 0         0 return 0;
488             }
489             }
490              
491             { # check values in column
492 0         0 my $sql_query = qq{
  0         0  
  0         0  
493             SELECT COUNT($column)
494             FROM $table
495             };
496              
497             #@type DBI
498 0         0 my $sth = $dbh->prepare($sql_query);
499 0         0 $sth->execute;
500 0         0 my ($count) = $sth->fetchrow_array;
501              
502 0 0       0 if ( not $count ) {
503 0         0 print " " x 4, "Column $column has no records\n";
504             }
505              
506 0         0 return $count;
507             }
508             }
509              
510             sub quantile {
511 1     1 0 3 my ( $self, $data, $part_number ) = @_;
512              
513 1         14 my $stat = Statistics::Descriptive::Full->new();
514              
515 1         91 $stat->add_data(@$data);
516              
517 1         794 my $min = $stat->min;
518 1         5 my @quantiles;
519 1         2 my $base = 100 / $part_number;
520 1         4 for ( 1 .. $part_number - 1 ) {
521 3         9 my $percentile = $stat->percentile( $_ * $base );
522 3         1476 push @quantiles, $percentile;
523             }
524 1         3 my $max = $stat->max;
525              
526 1         51 return [ $min, @quantiles, $max, ];
527             }
528              
529             sub quantile_sql {
530 1     1 0 583 my ( $self, $opt, $part_number ) = @_;
531              
532             #@type DBI
533 1         2 my $dbh = $self->{dbh};
534              
535             # bind value
536 1         2 my $bind_value = $opt->{bind_value};
537 1 50       3 unless ( defined $bind_value ) {
538 1         2 $bind_value = [];
539             }
540              
541             # init DBI query
542 1         2 my $sql_query = $opt->{sql_query};
543              
544             #@type DBI
545 1         5 my $sth = $dbh->prepare($sql_query);
546 1         1012 $sth->execute(@$bind_value);
547              
548 1         71561 my @data;
549              
550 1         9 while ( my @row = $sth->fetchrow_array ) {
551 1000         15219 push @data, $row[0];
552             }
553              
554 1         18 return $self->quantile( \@data, $part_number );
555             }
556              
557             sub calc_threshold {
558 0     0 0 0 my $self = shift;
559              
560 0         0 my ( $combine, $piece );
561              
562             #@type DBI
563 0         0 my $dbh = $self->{dbh};
564              
565             #@type DBI
566 0         0 my $sth = $dbh->prepare(
567             q{
568             SELECT SUM(FLOOR(align_comparables / 500) * 500)
569             FROM align
570             }
571             );
572 0         0 $sth->execute;
573 0         0 my ($total_length) = $sth->fetchrow_array;
574              
575 0 0       0 if ( $total_length <= 5_000_000 ) {
    0          
    0          
    0          
576 0         0 $piece = 10;
577             }
578             elsif ( $total_length <= 10_000_000 ) {
579 0         0 $piece = 10;
580             }
581             elsif ( $total_length <= 100_000_000 ) {
582 0         0 $piece = 20;
583             }
584             elsif ( $total_length <= 1_000_000_000 ) {
585 0         0 $piece = 50;
586             }
587             else {
588 0         0 $piece = 100;
589             }
590              
591 0 0       0 if ( $total_length <= 1_000_000 ) {
    0          
592 0         0 $combine = 100;
593             }
594             elsif ( $total_length <= 5_000_000 ) {
595 0         0 $combine = 500;
596             }
597             else {
598 0         0 $combine = 1000;
599             }
600              
601 0         0 return ( $combine, $piece );
602             }
603              
604             # See HACK #7 in OReilly.Excel.Hacks.2nd.Edition.
605             sub add_index_sheet {
606 1     1 0 7 my $self = shift;
607              
608             #@type Excel::Writer::XLSX::Workbook
609 1         2 my $workbook = $self->{workbook};
610 1         2 my $format = $self->{format};
611              
612             # existing sheets
613 1         16 my @sheets = $workbook->sheets();
614              
615             # create a new worksheet named "INDEX"
616 1         7 my $sheet_name = "INDEX";
617              
618             #@type Excel::Writer::XLSX::Worksheet
619 1         3 my $index_sheet = $workbook->add_worksheet($sheet_name);
620              
621             # set hyperlink column with large width
622 1         176 $index_sheet->set_column( 'A:A', 20 );
623              
624             # 0 1 2 3 4 5 6 7 8
625             #($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
626             # localtime(time);
627 1         176 my $date = sprintf "%4d-%02d-%02dT%02d:%02d", (localtime)[5] + 1900, (localtime)[4] + 1,
628             (localtime)[ 3, 2, 1 ];
629 1         6 $index_sheet->write_date_time( 'A1', $date, $format->{DATE} );
630              
631 1         122 for my $i ( 0 .. $#sheets ) {
632              
633             #@type Excel::Writer::XLSX::Worksheet
634 1         2 my $cur_sheet = $sheets[$i];
635 1         5 my $cur_name = $cur_sheet->get_name;
636              
637             # $worksheet->write_url( $row, $col, $url, $format, $label )
638 1         9 $index_sheet->write_url( $i + 1, 0, "internal:$cur_name!A1", $format->{URL}, $cur_name );
639              
640             $cur_sheet->write_url( "A1", "internal:INDEX!A" . ( $i + 2 ),
641 1         96 $format->{URLHEADER}, "INDEX" );
642             }
643              
644 1         98 return;
645             }
646              
647             sub draw_y {
648 1     1 0 137 my $self = shift;
649              
650             #@type Excel::Writer::XLSX::Worksheet
651 1         1 my $sheet = shift;
652 1         2 my $opt = shift;
653              
654             #@type Excel::Writer::XLSX::Workbook
655 1         3 my $workbook = $self->{workbook};
656 1         6 my $sheet_name = $sheet->get_name;
657              
658 1   33     9 my $font_name = $opt->{font_name} || $self->{font_name};
659 1   33     4 my $font_size = $opt->{font_size} || $self->{font_size};
660 1   33     4 my $height = $opt->{height} || $self->{height};
661 1   33     4 my $width = $opt->{width} || $self->{width};
662              
663             # E2
664 1   50     4 my $top = $opt->{top} || 1;
665 1   50     6 my $left = $opt->{left} || 4;
666              
667             # 0 based
668 1         1 my $first_row = $opt->{first_row};
669 1         1 my $last_row = $opt->{last_row};
670 1         2 my $x_column = $opt->{x_column};
671 1         2 my $y_column = $opt->{y_column};
672 1         1 my $y_last_column = $opt->{y_last_column};
673 1 50       4 unless ( defined $y_last_column ) {
674 1         1 $y_last_column = $y_column;
675             }
676              
677             # Set axes' scale
678 1         2 my $x_max_scale = $opt->{x_max_scale};
679 1         1 my $x_min_scale = $opt->{x_min_scale};
680 1 50       2 if ( !defined $x_min_scale ) {
681 1         1 $x_min_scale = 0;
682             }
683 1 50 33     5 if ( !defined $x_max_scale and exists $opt->{x_scale_unit} ) {
684 1         2 my $x_scale_unit = $opt->{x_scale_unit};
685 1         2 my $x_min_value = List::Util::min( @{ $opt->{x_data} } );
  1         16  
686 1         2 my $x_max_value = List::Util::max( @{ $opt->{x_data} } );
  1         2  
687 1         65 $x_min_scale = int( $x_min_value / $x_scale_unit ) * $x_scale_unit;
688 1         11 $x_max_scale = ( int( $x_max_value / $x_scale_unit ) + 1 ) * $x_scale_unit;
689             }
690              
691 1         2 my $y_scale;
692 1 50       4 if ( exists $opt->{y_data} ) {
693 1         5 $y_scale = $self->_find_scale( $opt->{y_data}, $first_row, $last_row );
694             }
695              
696             #@type Excel::Writer::XLSX::Chart
697 1         43 my $chart = $workbook->add_chart(
698             type => 'scatter',
699             subtype => 'straight_with_markers',
700             embedded => 1
701             );
702              
703             # [ $sheetname, $row_start, $row_end, $col_start, $col_end ]
704             # #"=$sheetname" . '!$A$2:$A$7',
705 1         2544 for my $y_col ( $y_column .. $y_last_column ) {
706 1         7 $chart->add_series(
707             categories => [ $sheet_name, $first_row, $last_row, $x_column, $x_column ],
708             values => [ $sheet_name, $first_row, $last_row, $y_col, $y_col ],
709             );
710             }
711 1         240 $chart->set_size( width => $width, height => $height );
712              
713             # Remove title and legend
714 1         16 $chart->set_title( none => 1 );
715 1         35 $chart->set_legend( none => 1 );
716              
717             # Blank data is shown as a gap
718 1         20 $chart->show_blanks_as('gap');
719              
720             # set axis
721             $chart->set_x_axis(
722             name => $self->_replace_text( $opt->{x_title} ),
723             name_font => { name => $font_name, size => $font_size, },
724             num_font => { name => $font_name, size => $font_size, },
725             line => { color => 'black', },
726             major_gridlines => { visible => 0, },
727             minor_gridlines => { visible => 0, },
728             major_tick_mark => 'inside',
729             min => $x_min_scale,
730             max => $x_max_scale,
731 1 50       15 exists $opt->{cross} ? ( crossing => $opt->{cross}, ) : (),
732             );
733             $chart->set_y_axis(
734             name => $self->_replace_text( $opt->{y_title} ),
735             name_font => { name => $font_name, size => $font_size, },
736             num_font => { name => $font_name, size => $font_size, },
737             line => { color => 'black', },
738             major_gridlines => { visible => 0, },
739             minor_gridlines => { visible => 0, },
740             major_tick_mark => 'inside',
741             defined $y_scale
742             ? ( min => $y_scale->{min}, max => $y_scale->{max}, major_unit => $y_scale->{unit}, )
743 1 50       103 : (),
744             );
745              
746             # plorarea
747 1         85 $chart->set_plotarea( border => { color => 'black', }, );
748              
749 1         56 $sheet->insert_chart( $top, $left, $chart );
750              
751 1         34 return;
752             }
753              
754             sub draw_2y {
755 1     1 0 19 my $self = shift;
756              
757             #@type Excel::Writer::XLSX::Worksheet
758 1         1 my $sheet = shift;
759 1         2 my $opt = shift;
760              
761             #@type Excel::Writer::XLSX::Workbook
762 1         2 my $workbook = $self->{workbook};
763 1         6 my $sheet_name = $sheet->get_name;
764              
765 1   33     8 my $font_name = $opt->{font_name} || $self->{font_name};
766 1   33     4 my $font_size = $opt->{font_size} || $self->{font_size};
767 1   33     4 my $height = $opt->{height} || $self->{height};
768 1   33     3 my $width = $opt->{width} || $self->{width};
769              
770             # E2
771 1   50     3 my $top = $opt->{top} || 1;
772 1   50     2 my $left = $opt->{left} || 4;
773              
774             # 0 based
775 1         1 my $first_row = $opt->{first_row};
776 1         2 my $last_row = $opt->{last_row};
777 1         1 my $x_column = $opt->{x_column};
778 1         1 my $y_column = $opt->{y_column};
779 1         2 my $y2_column = $opt->{y2_column};
780              
781             # Set axes' scale
782 1         1 my $x_max_scale = $opt->{x_max_scale};
783 1         2 my $x_min_scale = $opt->{x_min_scale};
784 1 50       8 if ( !defined $x_min_scale ) {
785 1         1 $x_min_scale = 0;
786             }
787 1 50 33     5 if ( !defined $x_max_scale and exists $opt->{x_scale_unit} ) {
788 1         1 my $x_scale_unit = $opt->{x_scale_unit};
789 1         2 my $x_min_value = List::Util::min( @{ $opt->{x_data} } );
  1         4  
790 1         1 my $x_max_value = List::Util::max( @{ $opt->{x_data} } );
  1         4  
791 1         87 $x_min_scale = int( $x_min_value / $x_scale_unit ) * $x_scale_unit;
792 1         56 $x_max_scale = ( int( $x_max_value / $x_scale_unit ) + 1 ) * $x_scale_unit;
793             }
794              
795 1         2 my $y_scale;
796 1 50       4 if ( exists $opt->{y_data} ) {
797 1         4 $y_scale = $self->_find_scale( $opt->{y_data}, $first_row, $last_row );
798             }
799              
800 1         16 my $y2_scale;
801 1 50       6 if ( exists $opt->{y2_data} ) {
802 1         5 $y2_scale = $self->_find_scale( $opt->{y2_data}, $first_row, $last_row );
803             }
804              
805             #@type Excel::Writer::XLSX::Chart
806 1         20 my $chart = $workbook->add_chart(
807             type => 'scatter',
808             subtype => 'straight_with_markers',
809             embedded => 1
810             );
811              
812             # [ $sheetname, $row_start, $row_end, $col_start, $col_end ]
813             # #"=$sheetname" . '!$A$2:$A$7',
814 1         516 $chart->add_series(
815             categories => [ $sheet_name, $first_row, $last_row, $x_column, $x_column ],
816             values => [ $sheet_name, $first_row, $last_row, $y_column, $y_column ],
817             );
818              
819             # second Y axis
820 1         239 $chart->add_series(
821             categories => [ $sheet_name, $first_row, $last_row, $x_column, $x_column ],
822             values => [ $sheet_name, $first_row, $last_row, $y2_column, $y2_column ],
823             marker => { type => 'square', size => 6, fill => { color => 'white', }, },
824             y2_axis => 1,
825             );
826 1         177 $chart->set_size( width => $width, height => $height );
827              
828             # Remove title and legend
829 1         14 $chart->set_title( none => 1 );
830 1         30 $chart->set_legend( none => 1 );
831              
832             # Blank data is shown as a gap
833 1         17 $chart->show_blanks_as('gap');
834              
835             # set axis
836             $chart->set_x_axis(
837 1         12 name => $self->_replace_text( $opt->{x_title} ),
838             name_font => { name => $font_name, size => $font_size, },
839             num_font => { name => $font_name, size => $font_size, },
840             line => { color => 'black', },
841             major_gridlines => { visible => 0, },
842             minor_gridlines => { visible => 0, },
843             major_tick_mark => 'inside',
844             min => $x_min_scale,
845             max => $x_max_scale,
846             );
847             $chart->set_y_axis(
848             name => $self->_replace_text( $opt->{y_title} ),
849             name_font => { name => $font_name, size => $font_size, },
850             num_font => { name => $font_name, size => $font_size, },
851             line => { color => 'black', },
852             major_gridlines => { visible => 0, },
853             minor_gridlines => { visible => 0, },
854             major_tick_mark => 'inside',
855             defined $y_scale
856             ? ( min => $y_scale->{min}, max => $y_scale->{max}, major_unit => $y_scale->{unit}, )
857 1 50       96 : (),
858             );
859             $chart->set_y2_axis(
860             name => $self->_replace_text( $opt->{y2_title} ),
861             name_font => { name => $font_name, size => $font_size, },
862             num_font => { name => $font_name, size => $font_size, },
863             line => { color => 'black', },
864             major_gridlines => { visible => 0, },
865             minor_gridlines => { visible => 0, },
866             major_tick_mark => 'inside',
867             defined $y2_scale
868             ? ( min => $y2_scale->{min}, max => $y2_scale->{max}, major_unit => $y2_scale->{unit}, )
869 1 50       99 : (),
870             );
871              
872             # plorarea
873 1         81 $chart->set_plotarea( border => { color => 'black', }, );
874              
875 1         52 $sheet->insert_chart( $top, $left, $chart );
876              
877 1         31 return;
878             }
879              
880             sub draw_xy {
881 1     1 0 5 my $self = shift;
882              
883             #@type Excel::Writer::XLSX::Worksheet
884 1         2 my $sheet = shift;
885 1         2 my $opt = shift;
886              
887             #@type Excel::Writer::XLSX::Workbook
888 1         2 my $workbook = $self->{workbook};
889 1         5 my $sheet_name = $sheet->get_name;
890              
891 1   33     7 my $font_name = $opt->{font_name} || $self->{font_name};
892 1   33     8 my $font_size = $opt->{font_size} || $self->{font_size};
893 1   33     3 my $height = $opt->{height} || $self->{height};
894 1   33     4 my $width = $opt->{width} || $self->{width};
895              
896             # trendline
897 1         2 my $add_trend = $opt->{add_trend};
898              
899             # E2
900 1   50     2 my $top = $opt->{top} || 1;
901 1   50     5 my $left = $opt->{left} || 4;
902              
903             # 0 based
904 1         1 my $first_row = $opt->{first_row};
905 1         1 my $last_row = $opt->{last_row};
906 1         2 my $x_column = $opt->{x_column};
907 1         2 my $y_column = $opt->{y_column};
908              
909 1         1 my $x_scale;
910 1 50       2 if ( exists $opt->{x_data} ) {
911 1         3 $x_scale = $self->_find_scale( $opt->{x_data}, $first_row, $last_row );
912              
913             }
914 1         16 my $y_scale;
915 1 50       5 if ( exists $opt->{y_data} ) {
916 1         4 $y_scale = $self->_find_scale( $opt->{y_data}, $first_row, $last_row );
917             }
918              
919             #@type Excel::Writer::XLSX::Chart
920 1         23 my $chart = $workbook->add_chart( type => 'scatter', embedded => 1 );
921              
922             # [ $sheetname, $row_start, $row_end, $col_start, $col_end ]
923             # #"=$sheetname" . '!$A$2:$A$7',
924 1 50       521 $chart->add_series(
925             categories => [ $sheet_name, $first_row, $last_row, $x_column, $x_column ],
926             values => [ $sheet_name, $first_row, $last_row, $y_column, $y_column ],
927             marker => { type => 'diamond' },
928             $add_trend
929             ? ( trendline => {
930             type => 'linear',
931             name => 'Linear Trend',
932             }
933             )
934             : (),
935             );
936 1         296 $chart->set_size( width => $width, height => $height );
937              
938             # Remove title and legend
939 1         14 $chart->set_title( none => 1 );
940 1         30 $chart->set_legend( none => 1 );
941              
942             # Blank data is shown as a gap
943 1         18 $chart->show_blanks_as('gap');
944              
945             # set axis
946             $chart->set_x_axis(
947             name => $self->_replace_text( $opt->{x_title} ),
948             name_font => { name => $font_name, size => $font_size, },
949             num_font => { name => $font_name, size => $font_size, },
950             line => { color => 'black', },
951             major_gridlines => { visible => 0, },
952             minor_gridlines => { visible => 0, },
953             major_tick_mark => 'inside',
954             defined $x_scale
955             ? ( min => $x_scale->{min}, max => $x_scale->{max}, major_unit => $x_scale->{unit}, )
956 1 50       12 : (),
957             );
958             $chart->set_y_axis(
959             name => $self->_replace_text( $opt->{y_title} ),
960             name_font => { name => $font_name, size => $font_size, },
961             num_font => { name => $font_name, size => $font_size, },
962             line => { color => 'black', },
963             major_gridlines => { visible => 0, },
964             minor_gridlines => { visible => 0, },
965             major_tick_mark => 'inside',
966             defined $y_scale
967             ? ( min => $y_scale->{min}, max => $y_scale->{max}, major_unit => $y_scale->{unit}, )
968 1 50       102 : (),
969             );
970              
971             # plorarea
972 1         82 $chart->set_plotarea( border => { color => 'black', }, );
973              
974 1         53 $sheet->insert_chart( $top, $left, $chart );
975              
976 1         30 return;
977             }
978              
979             sub draw_dd {
980 1     1 0 32 my $self = shift;
981              
982             #@type Excel::Writer::XLSX::Worksheet
983 1         1 my $sheet = shift;
984 1         2 my $opt = shift;
985              
986             #@type Excel::Writer::XLSX::Workbook
987 1         2 my $workbook = $self->{workbook};
988 1         5 my $sheet_name = $sheet->get_name;
989              
990 1   33     9 my $font_name = $opt->{font_name} || $self->{font_name};
991 1   33     4 my $font_size = $opt->{font_size} || $self->{font_size};
992 1   33     5 my $height = $opt->{height} || $self->{height};
993 1   33     3 my $width = $opt->{width} || $self->{width};
994              
995             # E2
996 1   50     2 my $top = $opt->{top} || 1;
997 1   50     3 my $left = $opt->{left} || 4;
998              
999             # 0 based
1000 1         1 my $first_row = $opt->{first_row};
1001 1         1 my $last_row = $opt->{last_row};
1002 1         1 my $x_column = $opt->{x_column};
1003 1         3 my $y_column = $opt->{y_column};
1004 1         1 my $y_last_column = $opt->{y_last_column};
1005 1 50       2 unless ( defined $y_last_column ) {
1006 0         0 $y_last_column = $y_column;
1007             }
1008              
1009             # Set axes' scale
1010 1         2 my $x_max_scale = $opt->{x_max_scale};
1011 1         2 my $x_min_scale = $opt->{x_min_scale};
1012 1 50       3 if ( !defined $x_min_scale ) {
1013 0         0 $x_min_scale = 0;
1014             }
1015 1 0 33     3 if ( !defined $x_max_scale and exists $opt->{x_scale_unit} ) {
1016 0         0 my $x_scale_unit = $opt->{x_scale_unit};
1017 0         0 my $x_min_value = List::Util::min( @{ $opt->{x_data} } );
  0         0  
1018 0         0 my $x_max_value = List::Util::max( @{ $opt->{x_data} } );
  0         0  
1019 0         0 $x_min_scale = int( $x_min_value / $x_scale_unit ) * $x_scale_unit;
1020 0         0 $x_max_scale = ( int( $x_max_value / $x_scale_unit ) + 1 ) * $x_scale_unit;
1021             }
1022              
1023 1         1 my $y_scale;
1024 1 50       3 if ( exists $opt->{y_data} ) {
1025 1         4 $y_scale = $self->_find_scale( $opt->{y_data} );
1026             }
1027              
1028             #@type Excel::Writer::XLSX::Chart
1029 1         31 my $chart = $workbook->add_chart(
1030             type => 'line',
1031             embedded => 1
1032             );
1033              
1034             # [ $sheetname, $row_start, $row_end, $col_start, $col_end ]
1035             # #"=$sheetname" . '!$A$2:$A$7',
1036 1         1484 for my $y_col ( $y_column .. $y_last_column ) {
1037 2         289 $chart->add_series(
1038             categories => [ $sheet_name, $first_row, $last_row, $x_column, $x_column ],
1039             values => [ $sheet_name, $first_row, $last_row, $y_col, $y_col ],
1040             );
1041             }
1042 1         156 $chart->set_size( width => $width, height => $height );
1043              
1044             # Remove title and legend
1045 1         17 $chart->set_title( none => 1 );
1046 1         35 $chart->set_legend( none => 1 );
1047              
1048             # Blank data is shown as a gap
1049 1         20 $chart->show_blanks_as('gap');
1050              
1051             # set axis
1052             $chart->set_x_axis(
1053             name => $self->_replace_text( $opt->{x_title} ),
1054             name_font => { name => $font_name, size => $font_size, },
1055             num_font => { name => $font_name, size => $font_size, },
1056             line => { color => 'black', },
1057             major_gridlines => { visible => 0, },
1058             minor_gridlines => { visible => 0, },
1059             major_tick_mark => 'inside',
1060             min => $x_min_scale,
1061             max => $x_max_scale,
1062 1 50       14 exists $opt->{cross} ? ( crossing => $opt->{cross}, ) : (),
1063             );
1064             $chart->set_y_axis(
1065             name => $self->_replace_text( $opt->{y_title} ),
1066             name_font => { name => $font_name, size => $font_size, },
1067             num_font => { name => $font_name, size => $font_size, },
1068             line => { color => 'black', },
1069             major_gridlines => { visible => 0, },
1070             minor_gridlines => { visible => 0, },
1071             major_tick_mark => 'inside',
1072             defined $y_scale
1073             ? ( min => $y_scale->{min}, max => $y_scale->{max}, major_unit => $y_scale->{unit}, )
1074 1 50       115 : (),
1075             );
1076              
1077             # plorarea
1078 1         82 $chart->set_plotarea( border => { color => 'black', }, );
1079              
1080 1         69 $sheet->insert_chart( $top, $left, $chart );
1081              
1082 1         48 return;
1083             }
1084              
1085             sub _find_scale {
1086 6     6   12 my $self = shift;
1087 6         6 my $dataset = shift;
1088 6         11 my $first_row = shift;
1089 6         40 my $last_row = shift;
1090              
1091 6         50 my $axis = Chart::Math::Axis->new;
1092              
1093 6         64 my @data;
1094 6 100       21 if ( !defined $first_row ) {
1095 1 50       3 if ( ref $dataset->[0] eq 'ARRAY' ) {
1096 1         2 for ( @{$dataset} ) {
  1         3  
1097 2         2 push @data, @{$_};
  2         5  
1098             }
1099             }
1100             else {
1101 0         0 push @data, @{$dataset};
  0         0  
1102             }
1103             }
1104             else {
1105 5 50       16 if ( ref $dataset->[0] eq 'ARRAY' ) {
1106 0         0 for ( @{$dataset} ) {
  0         0  
1107 0         0 my @copy = @{$_};
  0         0  
1108 0         0 push @data, splice( @copy, $first_row - 1, $last_row - $first_row + 1 );
1109             }
1110             }
1111             else {
1112 5         8 my @copy = @{$dataset};
  5         24  
1113 5         26 push @data, splice( @copy, $first_row - 1, $last_row - $first_row + 1 );
1114             }
1115             }
1116              
1117 6         27 $axis->add_data(@data);
1118 6         63923 $axis->set_maximum_intervals( $self->{max_ticks} );
1119              
1120             return {
1121 6         41054 max => $axis->top,
1122             min => $axis->bottom,
1123             unit => $axis->interval_size,
1124             };
1125             }
1126              
1127             sub _replace_text {
1128 9     9   11 my $self = shift;
1129 9         14 my $text = shift;
1130 9         15 my $replace = $self->{replace};
1131              
1132 9         18 for my $key ( keys %$replace ) {
1133 2         3 my $value = $replace->{$key};
1134 2         25 $text =~ s/$key/$value/gi;
1135             }
1136              
1137 9         105 return $text;
1138             }
1139              
1140             # instance destructor
1141             # invoked only as object method
1142             sub DESTROY {
1143 5     5   2048 my $self = shift;
1144              
1145             # close excel objects
1146             #@type Excel::Writer::XLSX::Workbook
1147 5         9 my $workbook = $self->{workbook};
1148 5 50       58 $workbook->close if $workbook;
1149              
1150             # close dbh
1151             #@type DBI
1152 5         152335 my $dbh = $self->{dbh};
1153 5 100       110 $dbh->disconnect if $dbh;
1154              
1155 5         252 return;
1156             }
1157              
1158             1;
1159              
1160             __END__
1161              
1162             =head1 NAME
1163              
1164             AlignDB::ToXLSX - Create xlsx files from arrays or SQL queries.
1165              
1166             =head1 SYNOPSIS
1167              
1168             # Mysql
1169             my $write_obj = AlignDB::ToXLSX->new(
1170             outfile => $outfile,
1171             dbh => $dbh,
1172             );
1173              
1174             # MongoDB
1175             my $write_obj = AlignDB::ToXLSX->new(
1176             outfile => $outfile,
1177             );
1178              
1179             =head1 AUTHOR
1180              
1181             Qiang Wang <wang-q@outlook.com>
1182              
1183             =head1 COPYRIGHT AND LICENSE
1184              
1185             This software is copyright (c) 2008 by Qiang Wang.
1186              
1187             This is free software; you can redistribute it and/or modify it under
1188             the same terms as the Perl 5 programming language system itself.
1189              
1190             =cut