File Coverage

blib/lib/Excel/Writer/XLSX/Drawing.pm
Criterion Covered Total %
statement 482 484 99.5
branch 68 76 89.4
condition 8 12 66.6
subroutine 54 54 100.0
pod 0 1 0.0
total 612 627 97.6


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