File Coverage

blib/lib/Excel/Writer/XLSX/Drawing.pm
Criterion Covered Total %
statement 512 514 99.6
branch 72 80 90.0
condition 14 18 77.7
subroutine 58 58 100.0
pod 0 1 0.0
total 656 671 97.7


line stmt bran cond sub pod time code
1              
2             ###############################################################################
3             #
4             # Drawing - A class for writing the Excel XLSX drawing.xml file.
5             #
6             # Used in conjunction with Excel::Writer::XLSX
7             #
8             # Copyright 2000-2021, John McNamara, jmcnamara@cpan.org
9             #
10             # Documentation after __END__
11             #
12              
13             # perltidy with the following options: -mbl=2 -pt=0 -nola
14              
15             use 5.008002;
16 1126     1126   18396 use strict;
  1126         3194  
17 1126     1126   5042 use warnings;
  1126         2011  
  1126         19451  
18 1126     1126   4674 use Carp;
  1126         2074  
  1126         29587  
19 1126     1126   5514 use Excel::Writer::XLSX::Package::XMLwriter;
  1126         2131  
  1126         58851  
20 1126     1126   409411 use Excel::Writer::XLSX::Worksheet;
  1126         2847  
  1126         48992  
21 1126     1126   7157  
  1126         2156  
  1126         3980025  
22             our @ISA = qw(Excel::Writer::XLSX::Package::XMLwriter);
23             our $VERSION = '1.09';
24              
25              
26             ###############################################################################
27             #
28             # Public and private API methods.
29             #
30             ###############################################################################
31              
32              
33             ###############################################################################
34             #
35             # new()
36             #
37             # Constructor.
38             #
39              
40             my $class = shift;
41             my $fh = shift;
42 566     566 0 17630 my $self = Excel::Writer::XLSX::Package::XMLwriter->new( $fh );
43 566         1070  
44 566         2656 $self->{_drawings} = [];
45             $self->{_embedded} = 0;
46 566         1646 $self->{_orientation} = 0;
47 566         1296  
48 566         1236 bless $self, $class;
49              
50 566         1145 return $self;
51             }
52 566         1488  
53              
54             ###############################################################################
55             #
56             # _assemble_xml_file()
57             #
58             # Assemble and write the XML file.
59             #
60              
61             my $self = shift;
62              
63             $self->xml_declaration;
64 528     528   1235  
65             # Write the xdr:wsDr element.
66 528         4373 $self->_write_drawing_workspace();
67              
68             if ( $self->{_embedded} ) {
69 528         2492  
70             my $index = 0;
71 528 100       2073 for my $drawing_object ( @{ $self->{_drawings} } ) {
72             # Write the xdr:twoCellAnchor element.
73 508         1055 $self->_write_two_cell_anchor( ++$index, $drawing_object );
74 508         902 }
  508         1623  
75             }
76 578         2103 else {
77             my $index = 0;
78              
79             # Write the xdr:absoluteAnchor element.
80 20         49 $self->_write_absolute_anchor( ++$index );
81             }
82              
83 20         96 $self->xml_end_tag( 'xdr:wsDr' );
84              
85             # Close the XML writer filehandle.
86 528         1989 $self->xml_get_fh()->close();
87             }
88              
89 528         2647  
90             ###############################################################################
91             #
92             # _add_drawing_object()
93             #
94             # Add a chart, image or shape sub object to the drawing.
95             #
96              
97             my $self = shift;
98              
99             my $drawing_object = {
100             _type => undef,
101 582     582   1414 _dimensions => [],
102             _width => 0,
103 582         4807 _height => 0,
104             _description => undef,
105             _shape => undef,
106             _anchor => undef,
107             _rel_index => 0,
108             _url_rel_index => 0,
109             _tip => undef,
110             _decorative => undef,
111             };
112              
113             push @{ $self->{_drawings} }, $drawing_object;
114              
115             return $drawing_object;
116             }
117 582         1202  
  582         1455  
118              
119 582         1395 ###############################################################################
120             #
121             # Internal methods.
122             #
123             ###############################################################################
124              
125              
126             ###############################################################################
127             #
128             # XML writing methods.
129             #
130             ###############################################################################
131              
132              
133             ##############################################################################
134             #
135             # _write_drawing_workspace()
136             #
137             # Write the <xdr:wsDr> element.
138             #
139              
140             my $self = shift;
141             my $schema = 'http://schemas.openxmlformats.org/drawingml/';
142             my $xmlns_xdr = $schema . '2006/spreadsheetDrawing';
143             my $xmlns_a = $schema . '2006/main';
144              
145 528     528   1113 my @attributes = (
146 528         1078 'xmlns:xdr' => $xmlns_xdr,
147 528         1633 'xmlns:a' => $xmlns_a,
148 528         1228 );
149              
150 528         1775 $self->xml_start_tag( 'xdr:wsDr', @attributes );
151             }
152              
153              
154             ##############################################################################
155 528         2675 #
156             # _write_two_cell_anchor()
157             #
158             # Write the <xdr:twoCellAnchor> element.
159             #
160              
161             my $self = shift;
162             my $index = shift;
163             my $drawing_object = shift;
164              
165             my $type = $drawing_object->{_type};
166             my $dimensions = $drawing_object->{_dimensions};
167 578     578   1253 my $col_from = $dimensions->[0];
168 578         935 my $row_from = $dimensions->[1];
169 578         1022 my $col_from_offset = $dimensions->[2];
170             my $row_from_offset = $dimensions->[3];
171 578         1329 my $col_to = $dimensions->[4];
172 578         1166 my $row_to = $dimensions->[5];
173 578         1278 my $col_to_offset = $dimensions->[6];
174 578         1157 my $row_to_offset = $dimensions->[7];
175 578         1089 my $col_absolute = $dimensions->[8];
176 578         1062 my $row_absolute = $dimensions->[9];
177 578         1173 my $width = $drawing_object->{_width};
178 578         1132 my $height = $drawing_object->{_height};
179 578         1093 my $description = $drawing_object->{_description};
180 578         1128 my $shape = $drawing_object->{_shape};
181 578         1078 my $anchor = $drawing_object->{_anchor};
182 578         1097 my $rel_index = $drawing_object->{_rel_index};
183 578         1177 my $url_rel_index = $drawing_object->{_url_rel_index};
184 578         1102 my $tip = $drawing_object->{_tip};
185 578         1183 my $decorative = $drawing_object->{_decorative};
186 578         1059  
187 578         1138 my @attributes = ();
188 578         1338  
189 578         1054 # Add attribute for images.
190 578         1007 if ( $anchor == 2 ) {
191 578         979 push @attributes, ( editAs => 'oneCell' );
192             }
193 578         1322 elsif ( $anchor == 3 ) {
194             push @attributes, ( editAs => 'absolute' );
195             }
196 578 100       2736  
    100          
197 122         338 # Add editAs attribute for shapes.
198             push @attributes, ( editAs => $shape->{_editAs} ) if $shape->{_editAs};
199              
200 1         2 $self->xml_start_tag( 'xdr:twoCellAnchor', @attributes );
201              
202             # Write the xdr:from element.
203             $self->_write_from(
204 578 50       2055 $col_from,
205             $row_from,
206 578         2239 $col_from_offset,
207             $row_from_offset,
208              
209 578         2505 );
210              
211             # Write the xdr:from element.
212             $self->_write_to(
213             $col_to,
214             $row_to,
215             $col_to_offset,
216             $row_to_offset,
217              
218 578         2162 );
219              
220             if ( $type == 1 ) {
221              
222             # Graphic frame.
223              
224             # Write the xdr:graphicFrame element for charts.
225             $self->_write_graphic_frame( $index, $rel_index, $description );
226 578 100       2177 }
    100          
227             elsif ( $type == 2 ) {
228              
229             # Write the xdr:pic element.
230             $self->_write_pic(
231 407         1796 $index, $rel_index, $col_absolute, $row_absolute,
232             $width, $height, $description, $url_rel_index,
233             $tip, $decorative
234             );
235             }
236 127         568 else {
237              
238             # Write the xdr:sp element for shapes.
239             $self->_write_sp( $index, $col_absolute, $row_absolute, $width, $height,
240             $shape );
241             }
242              
243             # Write the xdr:clientData element.
244             $self->_write_client_data();
245 44         136  
246             $self->xml_end_tag( 'xdr:twoCellAnchor' );
247             }
248              
249              
250 578         2200 ##############################################################################
251             #
252 578         1613 # _write_absolute_anchor()
253             #
254             # Write the <xdr:absoluteAnchor> element.
255             #
256              
257             my $self = shift;
258             my $index = shift;
259              
260             $self->xml_start_tag( 'xdr:absoluteAnchor' );
261              
262             # Different co-ordinates for horizonatal (= 0) and vertical (= 1).
263             if ( $self->{_orientation} == 0 ) {
264 20     20   38  
265 20         38 # Write the xdr:pos element.
266             $self->_write_pos( 0, 0 );
267 20         64  
268             # Write the xdr:ext element.
269             $self->_write_xdr_ext( 9308969, 6078325 );
270 20 100       124  
271             }
272             else {
273 19         80  
274             # Write the xdr:pos element.
275             $self->_write_pos( 0, -47625 );
276 19         65  
277             # Write the xdr:ext element.
278             $self->_write_xdr_ext( 6162675, 6124575 );
279              
280             }
281              
282 1         4  
283             # Write the xdr:graphicFrame element.
284             $self->_write_graphic_frame( $index, $index );
285 1         4  
286             # Write the xdr:clientData element.
287             $self->_write_client_data();
288              
289             $self->xml_end_tag( 'xdr:absoluteAnchor' );
290             }
291 20         80  
292              
293             ##############################################################################
294 20         69 #
295             # _write_from()
296 20         50 #
297             # Write the <xdr:from> element.
298             #
299              
300             my $self = shift;
301             my $col = shift;
302             my $row = shift;
303             my $col_offset = shift;
304             my $row_offset = shift;
305              
306             $self->xml_start_tag( 'xdr:from' );
307              
308 578     578   1180 # Write the xdr:col element.
309 578         1138 $self->_write_col( $col );
310 578         1044  
311 578         1062 # Write the xdr:colOff element.
312 578         1056 $self->_write_col_off( $col_offset );
313              
314 578         1961 # Write the xdr:row element.
315             $self->_write_row( $row );
316              
317 578         2176 # Write the xdr:rowOff element.
318             $self->_write_row_off( $row_offset );
319              
320 578         1961 $self->xml_end_tag( 'xdr:from' );
321             }
322              
323 578         1885  
324             ##############################################################################
325             #
326 578         1959 # _write_to()
327             #
328 578         4091 # Write the <xdr:to> element.
329             #
330              
331             my $self = shift;
332             my $col = shift;
333             my $row = shift;
334             my $col_offset = shift;
335             my $row_offset = shift;
336              
337             $self->xml_start_tag( 'xdr:to' );
338              
339             # Write the xdr:col element.
340 578     578   1304 $self->_write_col( $col );
341 578         1037  
342 578         1002 # Write the xdr:colOff element.
343 578         1000 $self->_write_col_off( $col_offset );
344 578         1338  
345             # Write the xdr:row element.
346 578         1854 $self->_write_row( $row );
347              
348             # Write the xdr:rowOff element.
349 578         1698 $self->_write_row_off( $row_offset );
350              
351             $self->xml_end_tag( 'xdr:to' );
352 578         2043 }
353              
354              
355 578         1750 ##############################################################################
356             #
357             # _write_col()
358 578         1670 #
359             # Write the <xdr:col> element.
360 578         1719 #
361              
362             my $self = shift;
363             my $data = shift;
364              
365             $self->xml_data_element( 'xdr:col', $data );
366             }
367              
368              
369             ##############################################################################
370             #
371             # _write_col_off()
372 1157     1157   1842 #
373 1157         1751 # Write the <xdr:colOff> element.
374             #
375 1157         6774  
376             my $self = shift;
377             my $data = shift;
378              
379             $self->xml_data_element( 'xdr:colOff', $data );
380             }
381              
382              
383             ##############################################################################
384             #
385             # _write_row()
386             #
387 1157     1157   2502 # Write the <xdr:row> element.
388 1157         1670 #
389              
390 1157         2619 my $self = shift;
391             my $data = shift;
392              
393             $self->xml_data_element( 'xdr:row', $data );
394             }
395              
396              
397             ##############################################################################
398             #
399             # _write_row_off()
400             #
401             # Write the <xdr:rowOff> element.
402 1157     1157   1863 #
403 1157         1805  
404             my $self = shift;
405 1157         2607 my $data = shift;
406              
407             $self->xml_data_element( 'xdr:rowOff', $data );
408             }
409              
410              
411             ##############################################################################
412             #
413             # _write_pos()
414             #
415             # Write the <xdr:pos> element.
416             #
417 1157     1157   1869  
418 1157         1759 my $self = shift;
419             my $x = shift;
420 1157         2594 my $y = shift;
421              
422             my @attributes = (
423             'x' => $x,
424             'y' => $y,
425             );
426              
427             $self->xml_empty_tag( 'xdr:pos', @attributes );
428             }
429              
430              
431             ##############################################################################
432 21     21   43 #
433 21         33 # _write_xdr_ext()
434 21         42 #
435             # Write the <xdr:ext> element.
436 21         65 #
437              
438             my $self = shift;
439             my $cx = shift;
440             my $cy = shift;
441 21         159  
442             my @attributes = (
443             'cx' => $cx,
444             'cy' => $cy,
445             );
446              
447             $self->xml_empty_tag( 'xdr:ext', @attributes );
448             }
449              
450              
451             ##############################################################################
452             #
453 21     21   47 # _write_graphic_frame()
454 21         37 #
455 21         37 # Write the <xdr:graphicFrame> element.
456             #
457 21         59  
458             my $self = shift;
459             my $index = shift;
460             my $rel_index = shift;
461             my $name = shift;
462 21         82 my $macro = '';
463              
464             my @attributes = ( 'macro' => $macro );
465              
466             $self->xml_start_tag( 'xdr:graphicFrame', @attributes );
467              
468             # Write the xdr:nvGraphicFramePr element.
469             $self->_write_nv_graphic_frame_pr( $index, $name );
470              
471             # Write the xdr:xfrm element.
472             $self->_write_xfrm();
473              
474 427     427   963 # Write the a:graphic element.
475 427         854 $self->_write_atag_graphic( $rel_index );
476 427         823  
477 427         886 $self->xml_end_tag( 'xdr:graphicFrame' );
478 427         890 }
479              
480 427         1316  
481             ##############################################################################
482 427         1636 #
483             # _write_nv_graphic_frame_pr()
484             #
485 427         1636 # Write the <xdr:nvGraphicFramePr> element.
486             #
487              
488 427         1677 my $self = shift;
489             my $index = shift;
490             my $name = shift;
491 427         1583  
492             if ( !$name ) {
493 427         1162 $name = 'Chart ' . $index;
494             }
495              
496             $self->xml_start_tag( 'xdr:nvGraphicFramePr' );
497              
498             # Write the xdr:cNvPr element.
499             $self->_write_c_nv_pr( $index + 1, $name );
500              
501             # Write the xdr:cNvGraphicFramePr element.
502             $self->_write_c_nv_graphic_frame_pr();
503              
504             $self->xml_end_tag( 'xdr:nvGraphicFramePr' );
505 427     427   967 }
506 427         900  
507 427         926  
508             ##############################################################################
509 427 100       1432 #
510 422         1165 # _write_c_nv_pr()
511             #
512             # Write the <xdr:cNvPr> element.
513 427         1576 #
514              
515             my $self = shift;
516 427         1964 my $index = shift;
517             my $name = shift;
518             my $description = shift;
519 427         1724 my $url_rel_index = shift;
520             my $tip = shift;
521 427         1277 my $decorative = shift;
522              
523             my @attributes = (
524             'id' => $index,
525             'name' => $name,
526             );
527              
528             # Add description attribute for images.
529             if ($description && !$decorative) {
530             push @attributes, ( descr => $description );
531             }
532              
533 600     600   1230 if ( $url_rel_index || $decorative ) {
534 600         1138 $self->xml_start_tag( 'xdr:cNvPr', @attributes );
535 600         1116  
536 600         1174 if ($url_rel_index) {
537 600         1081 # Write the a:hlinkClick element.
538 600         1104 $self->_write_a_hlink_click( $url_rel_index, $tip );
539 600         1076 }
540              
541 600         1849 if ($decorative) {
542             # Write the adec:decorative element.
543             $self->_write_decorative();
544             }
545              
546             $self->xml_end_tag( 'xdr:cNvPr' );
547 600 100 100     2631 }
548 124         338 else {
549             $self->xml_empty_tag( 'xdr:cNvPr', @attributes );
550             }
551 600 100 100     3602 }
552 27         97  
553              
554 27 100       68 ##############################################################################
555             #
556 26         80 # _write_a_hlink_click()
557             #
558             # Write the <a:hlinkClick> element.
559 27 100       71 #
560              
561 2         5 my $self = shift;
562             my $index = shift;
563             my $tip = shift;
564 27         101 my $schema = 'http://schemas.openxmlformats.org/officeDocument/';
565             my $xmlns_r = $schema . '2006/relationships';
566             my $r_id = 'rId' . $index;
567 573         3473  
568             my @attributes = (
569             'xmlns:r' => $xmlns_r,
570             'r:id' => $r_id,
571             );
572              
573             push( @attributes, ( 'tooltip' => $tip ) ) if $tip;
574              
575             $self->xml_empty_tag('a:hlinkClick', @attributes );
576             }
577              
578              
579             ##############################################################################
580 26     26   47 #
581 26         122 # _write_decorative()
582 26         41 #
583 26         37 # Write the <adec:decorative> element.
584 26         67 #
585 26         54  
586             my $self = shift;
587 26         84  
588              
589             $self->xml_start_tag( 'a:extLst' );
590              
591             $self->_write_a_uri_ext( '{FF2B5EF4-FFF2-40B4-BE49-F238E27FC236}' );
592 26 100       78 $self->_write_a16_creation_id();
593             $self->xml_end_tag( 'a:ext' );
594 26         115  
595             $self->_write_a_uri_ext( '{C183D7F6-B498-43B3-948B-1728B52AA6E4}' );
596             $self->_write_adec_decorative();
597             $self->xml_end_tag( 'a:ext' );
598              
599             $self->xml_end_tag( 'a:extLst' );
600             }
601              
602             ##############################################################################
603             #
604             # _write_a_uri_ext()
605             #
606 2     2   10 # Write the <a:ext> element.
607             #
608              
609 2         12 my $self = shift;
610             my $uri = shift;
611 2         6  
612 2         7 my @attributes = ( 'uri' => $uri );
613 2         6  
614             $self->xml_start_tag( 'a:ext', @attributes );
615 2         5 }
616 2         6  
617 2         5 ##############################################################################
618             #
619 2         4 # _write_adec_decorative()
620             #
621             # Write the <adec:decorative> element.
622             #
623              
624             my $self = shift;
625             my $xmlns_adec = 'http://schemas.microsoft.com/office/' .
626             'drawing/2017/decorative';
627             my $val = 1;
628              
629             my @attributes = (
630 4     4   6 'xmlns:adec' => $xmlns_adec,
631 4         6 'val' => $val,
632             );
633 4         7  
634             $self->xml_empty_tag( 'adec:decorative', @attributes );
635 4         7 }
636              
637             ##############################################################################
638             #
639             # _write_a16_creation_id()
640             #
641             # Write the <a16:creationId> element.
642             #
643              
644             my $self = shift;
645             my $xmlns_a_16 = 'http://schemas.microsoft.com/office/drawing/2014/main';
646 2     2   4 my $id = '{00000000-0008-0000-0000-000002000000}';
647 2         3  
648             my @attributes = (
649 2         2 'xmlns:a16' => $xmlns_a_16,
650             'id' => $id,
651 2         5 );
652              
653             $self->xml_empty_tag( 'a16:creationId', @attributes );
654             }
655              
656 2         6 ##############################################################################
657             #
658             # _write_c_nv_graphic_frame_pr()
659             #
660             # Write the <xdr:cNvGraphicFramePr> element.
661             #
662              
663             my $self = shift;
664              
665             if ( $self->{_embedded} ) {
666             $self->xml_empty_tag( 'xdr:cNvGraphicFramePr' );
667 2     2   3 }
668 2         3 else {
669 2         9 $self->xml_start_tag( 'xdr:cNvGraphicFramePr' );
670              
671 2         6 # Write the a:graphicFrameLocks element.
672             $self->_write_a_graphic_frame_locks();
673              
674             $self->xml_end_tag( 'xdr:cNvGraphicFramePr' );
675             }
676 2         8 }
677              
678              
679             ##############################################################################
680             #
681             # _write_a_graphic_frame_locks()
682             #
683             # Write the <a:graphicFrameLocks> element.
684             #
685              
686             my $self = shift;
687 429     429   913 my $no_grp = 1;
688              
689 429 100       1528 my @attributes = ( 'noGrp' => $no_grp );
690 408         1668  
691             $self->xml_empty_tag( 'a:graphicFrameLocks', @attributes );
692             }
693 21         84  
694              
695             ##############################################################################
696 21         83 #
697             # _write_xfrm()
698 21         110 #
699             # Write the <xdr:xfrm> element.
700             #
701              
702             my $self = shift;
703              
704             $self->xml_start_tag( 'xdr:xfrm' );
705              
706             # Write the xfrmOffset element.
707             $self->_write_xfrm_offset();
708              
709             # Write the xfrmOffset element.
710             $self->_write_xfrm_extension();
711 22     22   41  
712 22         48 $self->xml_end_tag( 'xdr:xfrm' );
713             }
714 22         64  
715              
716 22         79 ##############################################################################
717             #
718             # _write_xfrm_offset()
719             #
720             # Write the <a:off> xfrm sub-element.
721             #
722              
723             my $self = shift;
724             my $x = 0;
725             my $y = 0;
726              
727             my @attributes = (
728 427     427   1267 'x' => $x,
729             'y' => $y,
730 427         1536 );
731              
732             $self->xml_empty_tag( 'a:off', @attributes );
733 427         1535 }
734              
735              
736 427         1717 ##############################################################################
737             #
738 427         1239 # _write_xfrm_extension()
739             #
740             # Write the <a:ext> xfrm sub-element.
741             #
742              
743             my $self = shift;
744             my $x = 0;
745             my $y = 0;
746              
747             my @attributes = (
748             'cx' => $x,
749             'cy' => $y,
750 428     428   932 );
751 428         903  
752 428         791 $self->xml_empty_tag( 'a:ext', @attributes );
753             }
754 428         1410  
755              
756             ##############################################################################
757             #
758             # _write_atag_graphic()
759 428         1478 #
760             # Write the <a:graphic> element.
761             #
762              
763             my $self = shift;
764             my $index = shift;
765              
766             $self->xml_start_tag( 'a:graphic' );
767              
768             # Write the a:graphicData element.
769             $self->_write_atag_graphic_data( $index );
770              
771 428     428   826 $self->xml_end_tag( 'a:graphic' );
772 428         777 }
773 428         847  
774              
775 428         1343 ##############################################################################
776             #
777             # _write_atag_graphic_data()
778             #
779             # Write the <a:graphicData> element.
780 428         1511 #
781              
782             my $self = shift;
783             my $index = shift;
784             my $uri = 'http://schemas.openxmlformats.org/drawingml/2006/chart';
785              
786             my @attributes = ( 'uri' => $uri, );
787              
788             $self->xml_start_tag( 'a:graphicData', @attributes );
789              
790             # Write the c:chart element.
791             $self->_write_c_chart( 'rId' . $index );
792 427     427   880  
793 427         816 $self->xml_end_tag( 'a:graphicData' );
794             }
795 427         1476  
796              
797             ##############################################################################
798 427         1533 #
799             # _write_c_chart()
800 427         1196 #
801             # Write the <c:chart> element.
802             #
803              
804             my $self = shift;
805             my $r_id = shift;
806             my $schema = 'http://schemas.openxmlformats.org/';
807             my $xmlns_c = $schema . 'drawingml/2006/chart';
808             my $xmlns_r = $schema . 'officeDocument/2006/relationships';
809              
810              
811             my @attributes = (
812 427     427   973 'xmlns:c' => $xmlns_c,
813 427         865 'xmlns:r' => $xmlns_r,
814 427         896 'r:id' => $r_id,
815             );
816 427         1217  
817             $self->xml_empty_tag( 'c:chart', @attributes );
818 427         1695 }
819              
820              
821 427         2020 ##############################################################################
822             #
823 427         1275 # _write_client_data()
824             #
825             # Write the <xdr:clientData> element.
826             #
827              
828             my $self = shift;
829              
830             $self->xml_empty_tag( 'xdr:clientData' );
831             }
832              
833              
834             ##############################################################################
835 428     428   901 #
836 428         930 # _write_sp()
837 428         909 #
838 428         1213 # Write the <xdr:sp> element.
839 428         1158 #
840              
841             my $self = shift;
842 428         1593 my $index = shift;
843             my $col_absolute = shift;
844             my $row_absolute = shift;
845             my $width = shift;
846             my $height = shift;
847             my $shape = shift;
848 428         1654  
849             if ( $shape->{_connect} ) {
850             my @attributes = ( macro => '' );
851             $self->xml_start_tag( 'xdr:cxnSp', @attributes );
852              
853             # Write the xdr:nvCxnSpPr element.
854             $self->_write_nv_cxn_sp_pr( $index, $shape );
855              
856             # Write the xdr:spPr element.
857             $self->_write_xdr_sp_pr( $index, $col_absolute, $row_absolute, $width,
858             $height, $shape );
859              
860 598     598   1244 $self->xml_end_tag( 'xdr:cxnSp' );
861             }
862 598         1693 else {
863              
864             # Add attribute for shapes.
865             my @attributes = ( macro => '', textlink => '' );
866             $self->xml_start_tag( 'xdr:sp', @attributes );
867              
868             # Write the xdr:nvSpPr element.
869             $self->_write_nv_sp_pr( $index, $shape );
870              
871             # Write the xdr:spPr element.
872             $self->_write_xdr_sp_pr( $index, $col_absolute, $row_absolute, $width,
873             $height, $shape );
874 44     44   62  
875 44         59 # Write the xdr:txBody element.
876 44         51 if ( $shape->{_text} ) {
877 44         63 $self->_write_txBody( $col_absolute, $row_absolute, $width, $height,
878 44         56 $shape );
879 44         73 }
880 44         57  
881             $self->xml_end_tag( 'xdr:sp' );
882 44 100       93 }
883 11         23 }
884 11         25 ##############################################################################
885             #
886             # _write_nv_cxn_sp_pr()
887 11         29 #
888             # Write the <xdr:nvCxnSpPr> element.
889             #
890 11         31  
891             my $self = shift;
892             my $index = shift;
893 11         24 my $shape = shift;
894              
895             $self->xml_start_tag( 'xdr:nvCxnSpPr' );
896              
897             $shape->{_name} = join( ' ', $shape->{_type}, $index )
898 33         90 unless defined $shape->{_name};
899 33         102 $self->_write_c_nv_pr( $shape->{_id}, $shape->{_name} );
900              
901             $self->xml_start_tag( 'xdr:cNvCxnSpPr' );
902 33         103  
903             my @attributes = ( noChangeShapeType => '1' );
904             $self->xml_empty_tag( 'a:cxnSpLocks', @attributes );
905 33         125  
906             if ( $shape->{_start} ) {
907             @attributes =
908             ( 'id' => $shape->{_start}, 'idx' => $shape->{_start_index} );
909 33 100       86 $self->xml_empty_tag( 'a:stCxn', @attributes );
910 16         228 }
911              
912             if ( $shape->{_end} ) {
913             @attributes = ( 'id' => $shape->{_end}, 'idx' => $shape->{_end_index} );
914 33         67 $self->xml_empty_tag( 'a:endCxn', @attributes );
915             }
916             $self->xml_end_tag( 'xdr:cNvCxnSpPr' );
917             $self->xml_end_tag( 'xdr:nvCxnSpPr' );
918             }
919              
920              
921             ##############################################################################
922             #
923             # _write_nv_sp_pr()
924             #
925 12     12   23 # Write the <xdr:NvSpPr> element.
926 12         14 #
927 12         18  
928             my $self = shift;
929 12         33 my $index = shift;
930             my $shape = shift;
931              
932 12 100       52 my @attributes = ();
933 12         60  
934             $self->xml_start_tag( 'xdr:nvSpPr' );
935 12         31  
936             my $shape_name = $shape->{_type} . ' ' . $index;
937 12         24  
938 12         32 $self->_write_c_nv_pr( $shape->{_id}, $shape_name );
939              
940 12 100       30 @attributes = ( 'txBox' => 1 ) if $shape->{_txBox};
941              
942 11         27 $self->xml_start_tag( 'xdr:cNvSpPr', @attributes );
943 11         26  
944             @attributes = ( noChangeArrowheads => '1' );
945              
946 12 100       30 $self->xml_empty_tag( 'a:spLocks', @attributes );
947 11         28  
948 11         30 $self->xml_end_tag( 'xdr:cNvSpPr' );
949             $self->xml_end_tag( 'xdr:nvSpPr' );
950 12         38 }
951 12         25  
952              
953             ##############################################################################
954             #
955             # _write_pic()
956             #
957             # Write the <xdr:pic> element.
958             #
959              
960             my $self = shift;
961             my $index = shift;
962             my $rel_index = shift;
963 33     33   47 my $col_absolute = shift;
964 33         51 my $row_absolute = shift;
965 33         38 my $width = shift;
966             my $height = shift;
967 33         62 my $description = shift;
968             my $url_rel_index = shift;
969 33         78 my $tip = shift;
970             my $decorative = shift;
971 33         93  
972             $self->xml_start_tag( 'xdr:pic' );
973 33         108  
974             # Write the xdr:nvPicPr element.
975 33 50       85 $self->_write_nv_pic_pr( $index, $rel_index, $description, $url_rel_index,
976             $tip, $decorative );
977 33         94  
978             # Write the xdr:blipFill element.
979 33         73 $self->_write_blip_fill( $rel_index );
980              
981 33         92 # Pictures are rectangle shapes by default.
982             my $shape = { _type => 'rect' };
983 33         88  
984 33         71 # Write the xdr:spPr element.
985             $self->_write_sp_pr( $col_absolute, $row_absolute, $width, $height,
986             $shape );
987              
988             $self->xml_end_tag( 'xdr:pic' );
989             }
990              
991              
992             ##############################################################################
993             #
994             # _write_nv_pic_pr()
995             #
996 127     127   350 # Write the <xdr:nvPicPr> element.
997 127         269 #
998 127         222  
999 127         221 my $self = shift;
1000 127         244 my $index = shift;
1001 127         221 my $rel_index = shift;
1002 127         205 my $description = shift;
1003 127         230 my $url_rel_index = shift;
1004 127         198 my $tip = shift;
1005 127         218 my $decorative = shift;
1006 127         216  
1007             $self->xml_start_tag( 'xdr:nvPicPr' );
1008 127         462  
1009             # Write the xdr:cNvPr element.
1010             $self->_write_c_nv_pr( $index + 1, 'Picture ' . $index,
1011 127         488 $description, $url_rel_index, $tip, $decorative );
1012              
1013             # Write the xdr:cNvPicPr element.
1014             $self->_write_c_nv_pic_pr();
1015 127         426  
1016             $self->xml_end_tag( 'xdr:nvPicPr' );
1017             }
1018 127         354  
1019              
1020             ##############################################################################
1021 127         549 #
1022             # _write_c_nv_pic_pr()
1023             #
1024 127         303 # Write the <xdr:cNvPicPr> element.
1025             #
1026              
1027             my $self = shift;
1028              
1029             $self->xml_start_tag( 'xdr:cNvPicPr' );
1030              
1031             # Write the a:picLocks element.
1032             $self->_write_a_pic_locks();
1033              
1034             $self->xml_end_tag( 'xdr:cNvPicPr' );
1035             }
1036 127     127   227  
1037 127         329  
1038 127         197 ##############################################################################
1039 127         235 #
1040 127         249 # _write_a_pic_locks()
1041 127         221 #
1042 127         271 # Write the <a:picLocks> element.
1043             #
1044 127         426  
1045             my $self = shift;
1046             my $no_change_aspect = 1;
1047 127         590  
1048             my @attributes = ( 'noChangeAspect' => $no_change_aspect );
1049              
1050             $self->xml_empty_tag( 'a:picLocks', @attributes );
1051 127         425 }
1052              
1053 127         574  
1054             ##############################################################################
1055             #
1056             # _write_blip_fill()
1057             #
1058             # Write the <xdr:blipFill> element.
1059             #
1060              
1061             my $self = shift;
1062             my $index = shift;
1063              
1064             $self->xml_start_tag( 'xdr:blipFill' );
1065 127     127   253  
1066             # Write the a:blip element.
1067 127         425 $self->_write_a_blip( $index );
1068              
1069             # Write the a:stretch element.
1070 127         407 $self->_write_a_stretch();
1071              
1072 127         342 $self->xml_end_tag( 'xdr:blipFill' );
1073             }
1074              
1075              
1076             ##############################################################################
1077             #
1078             # _write_a_blip()
1079             #
1080             # Write the <a:blip> element.
1081             #
1082              
1083             my $self = shift;
1084 127     127   240 my $index = shift;
1085 127         235 my $schema = 'http://schemas.openxmlformats.org/officeDocument/';
1086             my $xmlns_r = $schema . '2006/relationships';
1087 127         328 my $r_embed = 'rId' . $index;
1088              
1089 127         399 my @attributes = (
1090             'xmlns:r' => $xmlns_r,
1091             'r:embed' => $r_embed,
1092             );
1093              
1094             $self->xml_empty_tag( 'a:blip', @attributes );
1095             }
1096              
1097              
1098             ##############################################################################
1099             #
1100             # _write_a_stretch()
1101 127     127   234 #
1102 127         255 # Write the <a:stretch> element.
1103             #
1104 127         835  
1105             my $self = shift;
1106              
1107 127         630 $self->xml_start_tag( 'a:stretch' );
1108              
1109             # Write the a:fillRect element.
1110 127         391 $self->_write_a_fill_rect();
1111              
1112 127         494 $self->xml_end_tag( 'a:stretch' );
1113             }
1114              
1115              
1116             ##############################################################################
1117             #
1118             # _write_a_fill_rect()
1119             #
1120             # Write the <a:fillRect> element.
1121             #
1122              
1123             my $self = shift;
1124 127     127   245  
1125 127         207 $self->xml_empty_tag( 'a:fillRect' );
1126 127         223 }
1127 127         308  
1128 127         377  
1129             ##############################################################################
1130 127         373 #
1131             # _write_sp_pr()
1132             #
1133             # Write the <xdr:spPr> element, for charts.
1134             #
1135 127         340  
1136             my $self = shift;
1137             my $col_absolute = shift;
1138             my $row_absolute = shift;
1139             my $width = shift;
1140             my $height = shift;
1141             my $shape = shift || {};
1142              
1143             $self->xml_start_tag( 'xdr:spPr' );
1144              
1145             # Write the a:xfrm element.
1146             $self->_write_a_xfrm( $col_absolute, $row_absolute, $width, $height );
1147 127     127   292  
1148             # Write the a:prstGeom element.
1149 127         443 $self->_write_a_prst_geom( $shape );
1150              
1151             $self->xml_end_tag( 'xdr:spPr' );
1152 127         569 }
1153              
1154 127         324  
1155             ##############################################################################
1156             #
1157             # _write_xdr_sp_pr()
1158             #
1159             # Write the <xdr:spPr> element for shapes.
1160             #
1161              
1162             my $self = shift;
1163             my $index = shift;
1164             my $col_absolute = shift;
1165             my $row_absolute = shift;
1166 127     127   245 my $width = shift;
1167             my $height = shift;
1168 127         352 my $shape = shift;
1169              
1170             my @attributes = ( 'bwMode' => 'auto' );
1171              
1172             $self->xml_start_tag( 'xdr:spPr', @attributes );
1173              
1174             # Write the a:xfrm element.
1175             $self->_write_a_xfrm( $col_absolute, $row_absolute, $width, $height,
1176             $shape );
1177              
1178             # Write the a:prstGeom element.
1179             $self->_write_a_prst_geom( $shape );
1180 127     127   263  
1181 127         373 my $fill = $shape->{_fill};
1182 127         419  
1183 127         185 if ( length $fill > 1 ) {
1184 127         212  
1185 127   50     390 # Write the a:solidFill element.
1186             $self->_write_a_solid_fill( $fill );
1187 127         383 }
1188             else {
1189             $self->xml_empty_tag( 'a:noFill' );
1190 127         509 }
1191              
1192             # Write the a:ln element.
1193 127         482 $self->_write_a_ln( $shape );
1194              
1195 127         313 $self->xml_end_tag( 'xdr:spPr' );
1196             }
1197              
1198             ##############################################################################
1199             #
1200             # _write_a_xfrm()
1201             #
1202             # Write the <a:xfrm> element.
1203             #
1204              
1205             my $self = shift;
1206             my $col_absolute = shift;
1207 44     44   73 my $row_absolute = shift;
1208 44         57 my $width = shift;
1209 44         60 my $height = shift;
1210 44         61 my $shape = shift || {};
1211 44         70 my @attributes = ();
1212 44         56  
1213 44         60 my $rotation = $shape->{_rotation} || 0;
1214             $rotation *= 60000;
1215 44         83  
1216             push( @attributes, ( 'rot' => $rotation ) ) if $rotation;
1217 44         143 push( @attributes, ( 'flipH' => 1 ) ) if $shape->{_flip_h};
1218             push( @attributes, ( 'flipV' => 1 ) ) if $shape->{_flip_v};
1219              
1220 44         139 $self->xml_start_tag( 'a:xfrm', @attributes );
1221              
1222             # Write the a:off element.
1223             $self->_write_a_off( $col_absolute, $row_absolute );
1224 44         205  
1225             # Write the a:ext element.
1226 44         74 $self->_write_a_ext( $width, $height );
1227              
1228 44 50       115 $self->xml_end_tag( 'a:xfrm' );
1229             }
1230              
1231 0         0  
1232             ##############################################################################
1233             #
1234 44         102 # _write_a_off()
1235             #
1236             # Write the <a:off> element.
1237             #
1238 44         239  
1239             my $self = shift;
1240 44         85 my $x = shift;
1241             my $y = shift;
1242              
1243             my @attributes = (
1244             'x' => $x,
1245             'y' => $y,
1246             );
1247              
1248             $self->xml_empty_tag( 'a:off', @attributes );
1249             }
1250              
1251 172     172   311  
1252 172         257 ##############################################################################
1253 172         353 #
1254 172         348 # _write_a_ext()
1255 172         383 #
1256 172   100     971 # Write the <a:ext> element.
1257 172         528 #
1258              
1259 172   100     840 my $self = shift;
1260 172         426 my $cx = shift;
1261             my $cy = shift;
1262 172 100       417  
1263 172 100       607 my @attributes = (
1264 172 100       479 'cx' => $cx,
1265             'cy' => $cy,
1266 172         673 );
1267              
1268             $self->xml_empty_tag( 'a:ext', @attributes );
1269 172         700 }
1270              
1271              
1272 172         532 ##############################################################################
1273             #
1274 172         687 # _write_a_prst_geom()
1275             #
1276             # Write the <a:prstGeom> element.
1277             #
1278              
1279             my $self = shift;
1280             my $shape = shift || {};
1281              
1282             my @attributes = ();
1283              
1284             @attributes = ( 'prst' => $shape->{_type} ) if $shape->{_type};
1285              
1286 172     172   339 $self->xml_start_tag( 'a:prstGeom', @attributes );
1287 172         247  
1288 172         265 # Write the a:avLst element.
1289             $self->_write_a_av_lst( $shape );
1290 172         450  
1291             $self->xml_end_tag( 'a:prstGeom' );
1292             }
1293              
1294              
1295 172         492 ##############################################################################
1296             #
1297             # _write_a_av_lst()
1298             #
1299             # Write the <a:avLst> element.
1300             #
1301              
1302             my $self = shift;
1303             my $shape = shift || {};
1304             my $adjustments = [];
1305              
1306             if ( defined $shape->{_adjustments} ) {
1307 172     172   285 $adjustments = $shape->{_adjustments};
1308 172         277 }
1309 172         276  
1310             if ( @$adjustments ) {
1311 172         592 $self->xml_start_tag( 'a:avLst' );
1312              
1313             my $i = 0;
1314             foreach my $adj ( @{$adjustments} ) {
1315             $i++;
1316 172         718  
1317             # Only connectors have multiple adjustments.
1318             my $suffix = $shape->{_connect} ? $i : '';
1319              
1320             # Scale Adjustments: 100,000 = 100%.
1321             my $adj_int = int( $adj * 1000 );
1322              
1323             my @attributes =
1324             ( name => 'adj' . $suffix, fmla => "val $adj_int" );
1325              
1326             $self->xml_empty_tag( 'a:gd', @attributes );
1327             }
1328 171     171   401 $self->xml_end_tag( 'a:avLst' );
1329 171   50     491 }
1330             else {
1331 171         410 $self->xml_empty_tag( 'a:avLst' );
1332             }
1333 171 50       651 }
1334              
1335 171         707  
1336             ##############################################################################
1337             #
1338 171         705 # _write_a_solid_fill()
1339             #
1340 171         505 # Write the <a:solidFill> element.
1341             #
1342              
1343             my $self = shift;
1344             my $rgb = shift;
1345              
1346             $rgb = '000000' unless defined $rgb;
1347              
1348             my @attributes = ( 'val' => $rgb );
1349              
1350             $self->xml_start_tag( 'a:solidFill' );
1351              
1352 172     172   324 $self->xml_empty_tag( 'a:srgbClr', @attributes );
1353 172   50     437  
1354 172         319 $self->xml_end_tag( 'a:solidFill' );
1355             }
1356 172 100       554  
1357 45         168  
1358             ##############################################################################
1359             #
1360 172 100       815 # _write_a_ln()
1361 6         17 #
1362             # Write the <a:ln> element.
1363 6         9 #
1364 6         16  
  6         11  
1365 16         20 my $self = shift;
1366             my $shape = shift || {};
1367              
1368 16 100       31 my $weight = $shape->{_line_weight};
1369              
1370             my @attributes = ( 'w' => $weight * 9525 );
1371 16         20  
1372             $self->xml_start_tag( 'a:ln', @attributes );
1373 16         46  
1374             my $line = $shape->{_line};
1375              
1376 16         32 if ( length $line > 1 ) {
1377              
1378 6         14 # Write the a:solidFill element.
1379             $self->_write_a_solid_fill( $line );
1380             }
1381 166         453 else {
1382             $self->xml_empty_tag( 'a:noFill' );
1383             }
1384              
1385             if ( $shape->{_line_type} ) {
1386              
1387             @attributes = ( 'val' => $shape->{_line_type} );
1388             $self->xml_empty_tag( 'a:prstDash', @attributes );
1389             }
1390              
1391             if ( $shape->{_connect} ) {
1392             $self->xml_empty_tag( 'a:round' );
1393             }
1394 61     61   83 else {
1395 61         74 @attributes = ( 'lim' => 800000 );
1396             $self->xml_empty_tag( 'a:miter', @attributes );
1397 61 50       207 }
1398              
1399 61         100 $self->xml_empty_tag( 'a:headEnd' );
1400             $self->xml_empty_tag( 'a:tailEnd' );
1401 61         258  
1402             $self->xml_end_tag( 'a:ln' );
1403 61         160 }
1404              
1405 61         130  
1406             ##############################################################################
1407             #
1408             # _write_txBody
1409             #
1410             # Write the <xdr:txBody> element.
1411             #
1412              
1413             my $self = shift;
1414             my $col_absolute = shift;
1415             my $row_absolute = shift;
1416             my $width = shift;
1417 45     45   64 my $height = shift;
1418 45   50     291 my $shape = shift;
1419              
1420 45         70 my @attributes = (
1421             vertOverflow => "clip",
1422 45         105 wrap => "square",
1423             lIns => "27432",
1424 45         129 tIns => "22860",
1425             rIns => "27432",
1426 45         84 bIns => "22860",
1427             anchor => $shape->{_valign},
1428 45 50       107 upright => "1",
1429             );
1430              
1431 45         121 $self->xml_start_tag( 'xdr:txBody' );
1432             $self->xml_empty_tag( 'a:bodyPr', @attributes );
1433             $self->xml_empty_tag( 'a:lstStyle' );
1434 0         0  
1435             $self->xml_start_tag( 'a:p' );
1436              
1437 45 100       131 my $rotation = $shape->{_format}->{_rotation};
1438             $rotation = 0 unless defined $rotation;
1439 1         3 $rotation *= 60000;
1440 1         3  
1441             @attributes = ( algn => $shape->{_align}, rtl => $rotation );
1442             $self->xml_start_tag( 'a:pPr', @attributes );
1443 45 100       102  
1444 11         38 @attributes = ( sz => "1000" );
1445             $self->xml_empty_tag( 'a:defRPr', @attributes );
1446              
1447 34         76 $self->xml_end_tag( 'a:pPr' );
1448 34         79 $self->xml_start_tag( 'a:r' );
1449              
1450             my $size = $shape->{_format}->{_size};
1451 45         135 $size = 8 unless defined $size;
1452 45         112 $size *= 100;
1453              
1454 45         92 my $bold = $shape->{_format}->{_bold};
1455             $bold = 0 unless defined $bold;
1456              
1457             my $italic = $shape->{_format}->{_italic};
1458             $italic = 0 unless defined $italic;
1459              
1460             my $underline = $shape->{_format}->{_underline};
1461             $underline = $underline ? 'sng' : 'none';
1462              
1463             my $strike = $shape->{_format}->{_font_strikeout};
1464             $strike = $strike ? 'Strike' : 'noStrike';
1465              
1466 16     16   23 @attributes = (
1467 16         31 lang => "en-US",
1468 16         24 sz => $size,
1469 16         22 b => $bold,
1470 16         18 i => $italic,
1471 16         22 u => $underline,
1472             strike => $strike,
1473             baseline => 0,
1474             );
1475              
1476             $self->xml_start_tag( 'a:rPr', @attributes );
1477              
1478             my $color = $shape->{_format}->{_color};
1479             if ( defined $color ) {
1480             $color = $shape->_get_palette_color( $color );
1481 16         64 $color =~ s/^FF//; # Remove leading FF from rgb for shape color.
1482             }
1483             else {
1484 16         40 $color = '000000';
1485 16         50 }
1486 16         43  
1487             $self->_write_a_solid_fill( $color );
1488 16         142  
1489             my $font = $shape->{_format}->{_font};
1490 16         33 $font = 'Calibri' unless defined $font;
1491 16 100       36 @attributes = ( typeface => $font );
1492 16         23 $self->xml_empty_tag( 'a:latin', @attributes );
1493              
1494 16         132 $self->xml_empty_tag( 'a:cs', @attributes );
1495 16         42  
1496             $self->xml_end_tag( 'a:rPr' );
1497 16         33  
1498 16         42 $self->xml_data_element( 'a:t', $shape->{_text} );
1499              
1500 16         53 $self->xml_end_tag( 'a:r' );
1501 16         51 $self->xml_end_tag( 'a:p' );
1502             $self->xml_end_tag( 'xdr:txBody' );
1503 16         33  
1504 16 100       39 }
1505 16         24  
1506              
1507 16         23 1;
1508 16 100       32  
1509             =pod
1510 16         109  
1511 16 100       42 =head1 NAME
1512              
1513 16         26 Drawing - A class for writing the Excel XLSX drawing.xml file.
1514 16 50       35  
1515             =head1 SYNOPSIS
1516 16         27  
1517 16 50       32 See the documentation for L<Excel::Writer::XLSX>.
1518              
1519 16         47 =head1 DESCRIPTION
1520              
1521             This module is used in conjunction with L<Excel::Writer::XLSX>.
1522              
1523             =head1 AUTHOR
1524              
1525             John McNamara jmcnamara@cpan.org
1526              
1527             =head1 COPYRIGHT
1528              
1529 16         46 (c) MM-MMXXI, John McNamara.
1530              
1531 16         27 All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
1532 16 100       37  
1533 14         47 =head1 LICENSE
1534 14         35  
1535             Either the Perl Artistic Licence L<http://dev.perl.org/licenses/artistic.html> or the GPL L<http://www.opensource.org/licenses/gpl-license.php>.
1536              
1537 2         4 =head1 DISCLAIMER OF WARRANTY
1538              
1539             See the documentation for L<Excel::Writer::XLSX>.
1540 16         40  
1541             =cut