1#---------------------------------------------------------------------------- 2# 3# $Id : Text.pm 2.243 2010-07-08 JMG$ 4# 5# Created and maintained by Jean-Marie Gouarne 6# Copyright 2010 by Genicorp, S.A. (www.genicorp.com) 7# 8#----------------------------------------------------------------------------- 9 10package OpenOffice::OODoc::Text; 11use 5.008_000; 12use strict; 13use OpenOffice::OODoc::XPath 2.237; 14our @ISA = qw ( OpenOffice::OODoc::XPath ); 15our $VERSION = '2.243'; 16 17#----------------------------------------------------------------------------- 18# synonyms 19 20BEGIN { 21 *findElementsByContent = *selectElementsByContent; 22 *replaceAll = *selectElementsByContent; 23 *findTextContent = *selectTextContent; 24 *getHeaderList = *getHeadingList; 25 *getHeaderTextList = *getHeadingTextList; 26 *getBibliographyElements = *getBibliographyMarks; 27 *bibliographyElementContent = *bibliographyEntryContent; 28 *setBibliographyElement = *setBibliographyMark; 29 *bookmarkElement = *setBookmark; 30 *removeBookmark = *deleteBookmark; 31 *getHeader = *getHeading; 32 *getHeaderContent = *getHeadingContent; 33 *getHeaderText = *getHeadingText; 34 *getOutlineLevel = *getLevel; 35 *setOutlineLevel = *setLevel; 36 *getSections = *getSectionList; 37 *getChapter = *getChapterContent; 38 *getParagraphContent = *getParagraphText; 39 *createTextBox = *createTextBoxElement; 40 *getTextBox = *getTextBoxElement; 41 *getTextBoxElements = *getTextBoxElementList; 42 *getList = *getItemList; 43 *getColumn = *getTableColumn; 44 *getRow = *getTableRow; 45 *getHeaderRow = *getTableHeaderRow; 46 *getCell = *getTableCell; 47 *getSheet = *getTable; 48 *selectTableByName = *getTableByName; 49 *getSheetByName = *getTableByName; 50 *getTableContent = *getTableText; 51 *normalizeTable = *normalizeSheet; 52 *normalizeTables = *normalizeSheets; 53 *expandSheet = *expandTable; 54 *insertColumn = *insertTableColumn; 55 *deleteColumn = *deleteTableColumn; 56 *replicateRow = *replicateTableRow; 57 *insertRow = *insertTableRow; 58 *appendRow = *appendTableRow; 59 *deleteRow = *deleteTableRow; 60 *appendHeader = *appendHeading; 61 *insertHeader = *insertHeading; 62 *removeHeader = *removeHeading; 63 *deleteHeading = *removeHeading; 64 *getNote = *getNoteElement; 65 *getNoteList = *getNoteElementList; 66 *getHeadingText = *getHeadingContent; 67 *cellType = *fieldType; 68 *cellValueAttributeName = *fieldValueAttributeName; 69 *cellCurrency = *fieldCurrency; 70 *getStyle = *textStyle; 71 *setStyle = *textStyle; 72 *removeMark = *deleteMark; 73 *removeSpan = *removeTextStyleChanges; 74 } 75 76#----------------------------------------------------------------------------- 77# default text style attributes 78 79our %DEFAULT_TEXT_STYLE = 80 ( 81 references => 82 { 83 'style:name' => undef, 84 'style:family' => 'paragraph', 85 'style:parent-style-name' => 'Standard', 86 'style:next-style-name' => 'Standard', 87 'style:class' => 'text' 88 }, 89 properties => 90 { 91 } 92 ); 93 94#----------------------------------------------------------------------------- 95# default delimiters for flat text export 96 97our %DEFAULT_DELIMITERS = 98 ( 99 'text:footnote-citation' => 100 { 101 begin => '[', 102 end => ']' 103 }, 104 'text:note-citation' => 105 { 106 begin => '[', 107 end => ']' 108 }, 109 'text:footnote-body' => 110 { 111 begin => '{NOTE: ', 112 end => '}' 113 }, 114 'text:note-body' => 115 { 116 begin => '{NOTE: ', 117 end => '}' 118 }, 119 'text:span' => 120 { 121 begin => '<<', 122 end => '>>' 123 }, 124 'text:list-item' => 125 { 126 begin => '- ', 127 end => '' 128 }, 129 ); 130 131#----------------------------------------------------------------------------- 132 133our $ROW_REPEAT_ATTRIBUTE = 'table:number-rows-repeated'; 134our $COL_REPEAT_ATTRIBUTE = 'table:number-columns-repeated'; 135 136#----------------------------------------------------------------------------- 137 138sub fieldType 139 { 140 my $self = shift; 141 my $field = shift or return undef; 142 my $newtype = shift; 143 my $prefix = 'office'; 144 unless ($self->{'opendocument'}) 145 { 146 $prefix = $field->isTableCell() ? 'table' : 'text'; 147 } 148 my $attribute = $prefix . ':value-type'; 149 my $oldtype = $field->att($attribute); 150 unless (defined $newtype) 151 { 152 return $oldtype; 153 } 154 else 155 { 156 if (($newtype eq 'date') || ($newtype eq 'time')) 157 { 158 $field->del_att($prefix . ':value'); 159 } 160 else 161 { 162 $field->del_att($prefix . ':date-value'); 163 $field->del_att($prefix . ':time-value'); 164 } 165 return $field->set_att($attribute, $newtype); 166 } 167 } 168 169sub fieldValueAttributeName 170 { 171 my $self = shift; 172 my $field = shift or return undef; 173 174 my $value_type = ref $field ? 175 $self->fieldType($field) : 176 $field; 177 my $attribute = ""; 178 179 my $prefix = 'office'; 180 unless ($self->{'opendocument'}) 181 { 182 $prefix = $field->isTableCell() ? 'table' : 'text'; 183 } 184 185 if ( 186 ($value_type eq 'string') || 187 ($value_type eq 'date') || 188 ($value_type eq 'time') 189 ) 190 { 191 $attribute = $prefix . ':' . $value_type . '-value'; 192 } 193 else 194 { 195 $attribute = $prefix . ':value'; 196 } 197 return $attribute; 198 } 199 200#----------------------------------------------------------------------------- 201# constructor 202 203sub new 204 { 205 my $caller = shift; 206 my $class = ref($caller) || $caller; 207 my %options = 208 ( 209 level_attr => 'text:outline-level', 210 paragraph_style => 'Standard', 211 heading_style => 'Heading_20_1', 212 use_delimiters => 'on', 213 field_separator => ';', 214 line_separator => "\n", 215 max_rows => 32, 216 max_cols => 26, 217 delimiters => 218 { %OpenOffice::OODoc::Text::DEFAULT_DELIMITERS }, 219 @_ 220 ); 221 $options{heading_style} = $options{header_style} 222 if $options{header_style}; 223 224 my $object = $class->SUPER::new(%options); 225 226 if ($object) 227 { 228 bless $object, $class; 229 unless ($object->{'opendocument'}) 230 { 231 $object->{'level_attr'} = 'text:level'; 232 $object->{'heading_style'} = 'Heading 1'; 233 } 234 } 235 return $object; 236 } 237 238#----------------------------------------------------------------------------- 239# getText() method adaptation for complex elements 240# and text output "enrichment" 241# (overrides getText from OODoc::XPath) 242 243sub getText 244 { 245 my $self = shift; 246 my $path = shift; 247 my $element = ref $path ? $path : $self->getElement(@_); 248 return undef unless $element; 249 return $self->getFlatText($element) if $element->isTextNode; 250 return undef unless $element->isElementNode; 251 my $text = undef; 252 my $begin_text = ''; 253 my $end_text = ''; 254 255 my $line_break = $self->{'line_separator'} || ''; 256 if (is_true($self->{'use_delimiters'})) 257 { 258 my $name = $element->getName; 259 $begin_text = 260 defined $self->{'delimiters'}{$name}{'begin'} ? 261 $self->{'delimiters'}{$name}{'begin'} : 262 ($self->{'delimiters'}{'default'}{'begin'} || ''); 263 $end_text = 264 defined $self->{'delimiters'}{$name}{'end'} ? 265 $self->{'delimiters'}{$name}{'end'} : 266 ($self->{'delimiters'}{'default'}{'end'} || ''); 267 } 268 269 $text = $begin_text; 270 271 if ($element->isParagraph) 272 { 273 my $t = $self->SUPER::getText($element); 274 $text .= $t if defined $t; 275 } 276 elsif ($element->isItemList) 277 { 278 return $self->getItemListText($element); 279 } 280 elsif ( 281 $element->isListItem || 282 $element->isNoteBody || 283 $element->isTableCell || 284 $element->isSection || 285 $element->isTextBox 286 ) 287 { 288 $element = $element->first_child('draw:text-box') 289 if ($element->hasTag('draw:frame')); 290 my @paragraphs = $element->children(qr '^text:(p|h)$'); 291 while (@paragraphs) 292 { 293 my $p = shift @paragraphs; 294 my $t = $self->SUPER::getText($p); 295 $text .= $t if defined $t; 296 $text .= $line_break if @paragraphs; 297 } 298 } 299 elsif ($element->isNote) 300 { 301 my $b = $element->selectChildElement 302 ('text:(|foot|end)note-body'); 303 return $self->getText($b); 304 } 305 elsif ($element->isTable) 306 { 307 $text .= $self->getTableContent($element); 308 } 309 else 310 { 311 my $t = $self->SUPER::getText($element); 312 $text .= $t if defined $t; 313 } 314 315 $text .= $end_text; 316 317 return $text; 318 } 319 320#----------------------------------------------------------------------------- 321# use or don't use delimiters for flat text output 322 323sub outputDelimitersOn 324 { 325 my $self = shift; 326 $self->{'use_delimiters'} = 'on' ; 327 } 328 329sub outputDelimitersOff 330 { 331 my $self = shift; 332 $self->{'use_delimiters'} = 'off'; 333 } 334 335sub defaultOutputTerminator 336 { 337 my $self = shift; 338 my $delimiter = shift; 339 $self->{'delimiters'}{'default'}{'end'} = $delimiter 340 if defined $delimiter; 341 return $self->{'delimiters'}{'default'}{'end'}; 342 } 343 344#----------------------------------------------------------------------------- 345# setText() method adaptation for complex elements 346# overrides setText from OODoc::XPath 347 348sub setText 349 { 350 my $self = shift; 351 my $path = shift; 352 my $pos = (ref $path) ? undef : shift; 353 my $element = $self->getElement($path, $pos); 354 return undef unless $element; 355 356 return $self->SUPER::setText($element, @_) if $element->isParagraph; 357 358 my $line_break = $self->{'line_separator'} || ''; 359 if ($element->isItemList) 360 { 361 my @text = @_; 362 foreach my $line (@text) 363 { 364 $self->appendItem($element, text => $line); 365 } 366 return wantarray ? @text : join $line_break, @text; 367 } 368 elsif ($element->isListItem) 369 { 370 return $self->setItemText($element, @_); 371 } 372 elsif ($element->isTableCell) 373 { 374 return $self->updateCell($element, @_); 375 } 376 elsif ( 377 $element->isNoteBody || 378 $element->isTableCell || 379 $element->isSection 380 ) 381 { 382 $element->cut_children; 383 return $self->appendParagraph 384 ( 385 attachment => $element, 386 text => shift, 387 @_ 388 ); 389 } 390 elsif ($element->isTextBox) 391 { 392 return $self->setTextBoxContent($element, shift); 393 } 394 elsif ($element->isNote) 395 { 396 my $b = $element->selectChildElement 397 ('text:(|foot|end)note-body'); 398 return $self->setText($b, @_); 399 } 400 else 401 { 402 return $self->SUPER::setText($element, @_); 403 } 404 } 405 406#----------------------------------------------------------------------------- 407# get the whole text content of the document in a readable (non-XML) form 408# result is a list of strings or a single string 409 410sub getTextContent 411 { 412 my $self = shift; 413 return $self->selectTextContent('.*', @_); 414 } 415 416#----------------------------------------------------------------------------- 417# get/set the text:id attribute of a given element 418 419sub textId 420 { 421 my $self = shift; 422 return $self->identifier(@_); 423 } 424 425#----------------------------------------------------------------------------- 426# selects headings, paragraph & list item elements matching a given pattern 427# returns a list of elements 428# if $action is defined, it's treated as a reference to a callback procedure 429# to be executed for each node matching the pattern, with the node as arg. 430 431sub selectElementsByContent 432 { 433 my $self = shift; 434 my $arg1 = shift; 435 my $pattern = undef; 436 my $context = undef; 437 438 if (ref $arg1) 439 { 440 $context = $arg1; 441 $pattern = shift; 442 } 443 else 444 { 445 $context = 446 $self->{'context'}->isa('OpenOffice::OODoc::Element') ? 447 $self->{'context'} : $self->{'body'}; 448 $pattern = $arg1; 449 } 450 451 my @elements = (); 452 foreach my $node ($context->getTextDescendants) 453 { 454 if 455 ( 456 (! $pattern) 457 || 458 ($pattern eq '.*') 459 || 460 ( 461 defined $self->_search_content 462 ($node, $pattern, @_, $node->parent) 463 ) 464 ) 465 { 466 my $element = $node->parent or next; 467 push @elements, $element if $element->is_elt; 468 } 469 } 470 return @elements; 471 } 472 473#----------------------------------------------------------------------------- 474# select the 1st element matching a given pattern 475 476sub selectElementByContent 477 { 478 my $self = shift; 479 my $arg1 = shift; 480 my $pattern = undef; 481 my $context = undef; 482 483 if (ref $arg1) 484 { 485 $context = $arg1; 486 $pattern = shift; 487 } 488 else 489 { 490 $context = 491 $self->{'context'}->isa('OpenOffice::OODoc::Element') ? 492 $self->{'context'} : $self->{'body'}; 493 $pattern = $arg1; 494 } 495 496 foreach my $node ($context->getTextDescendants) 497 { 498 if 499 ( 500 (! $pattern) 501 || 502 ($pattern eq '.*') 503 || 504 ( 505 defined $self->_search_content 506 ($node, $pattern, @_, $node->parent) 507 ) 508 ) 509 { 510 my $element = $node->parent or next; 511 return $element if $element->is_elt; 512 } 513 } 514 515 return undef; 516 } 517 518#----------------------------------------------------------------------------- 519# selects texts matching a given pattern, with optional replacement on the fly 520# returns the whole text content 521# result is a list of strings or a single string 522 523sub selectTextContent 524 { 525 my $self = shift; 526 my $pattern = shift; 527 528 my $line_break = $self->{'line_separator'} || ''; 529 my @lines = (); 530 531 my $context = $self->{'context'}->isa('OpenOffice::OODoc::Element') ? 532 $self->{'context'} : $self->{'body'}; 533 534 foreach my $element ($context->getChildNodes) 535 { 536 next if 537 ( 538 (! $element->isElementNode) 539 || 540 ($element->isSequenceDeclarations) 541 ); 542 push @lines, $self->getText($element) 543 if ( 544 (! $pattern) 545 || 546 ($pattern eq '.*') 547 || 548 (defined $self->_search_content 549 ($element, $pattern, @_, $element)) 550 ); 551 } 552 return wantarray ? @lines : join $line_break, @lines; 553 } 554 555#----------------------------------------------------------------------------- 556# get the list of text elements 557 558sub getTextElementList 559 { 560 my $self = shift; 561 my $context = shift || $self->getBody(); 562 563 return $self->selectChildElementsByName 564 ( 565 $context, 566 qr '^t(ext:(h|p|.*list|table.*)|able:.*)$', 567 @_ 568 ); 569 } 570 571#----------------------------------------------------------------------------- 572# get the list of paragraph elements 573 574sub getParagraphList 575 { 576 my $self = shift; 577 return $self->getDescendants('text:p', @_) 578 } 579 580#----------------------------------------------------------------------------- 581# get the paragraphs as a list of strings 582 583sub getParagraphTextList 584 { 585 my $self = shift; 586 587 return $self->getTextList('//text:p', @_); 588 } 589 590#----------------------------------------------------------------------------- 591# get the list of heading elements 592 593sub getHeadingList 594 { 595 my $self = shift; 596 my %opt = @_; 597 my $path = undef; 598 599 unless ($opt{'level'}) 600 { 601 return $self->getDescendants('text:h', $opt{'context'}); 602 } 603 else 604 { 605 $path = '//text:h[@' . $self->{'level_attr'} . 606 '="' . $opt{'level'} . '"]'; 607 } 608 return $self->getElementList($path, $opt{'context'}); 609 } 610 611#----------------------------------------------------------------------------- 612# get the headings as a list of strings 613 614sub getHeadingTextList 615 { 616 my $self = shift; 617 my @nodes = $self->getHeadingList(@_); 618 if (wantarray) 619 { 620 my @list = (); 621 foreach my $node (@nodes) 622 { 623 push @list, $self->getText($node); 624 } 625 return @list; 626 } 627 else 628 { 629 my $text = ""; 630 my $separator = $self->{'line_separator'} || ''; 631 foreach my $node (@nodes) 632 { 633 $text .= $self->getText($node); 634 $text .= $separator; 635 } 636 return $text; 637 } 638 } 639 640#----------------------------------------------------------------------------- 641# get the list of span elements (i.e. text elements distinguished from their 642# containing paragraph by any kind of attribute such as font, color, etc) 643 644sub getSpanList 645 { 646 my $self = shift; 647 return $self->getDescendants('text:span', @_); 648 } 649 650#----------------------------------------------------------------------------- 651# get the span elements as a list of strings 652 653sub getSpanTextList 654 { 655 my $self = shift; 656 657 return $self->getTextList('//text:span', @_); 658 } 659 660#----------------------------------------------------------------------------- 661# set text spans that are attributed using a particular style 662 663sub setSpan 664 { 665 my $self = shift; 666 my $path = shift; 667 my $context = (ref $path) ? $path : $self->getElement($path, shift) 668 or return undef; 669 my $expr = $self->inputTextConversion(shift); 670 return undef unless defined $expr; 671 my $style = $self->inputTextConversion(shift) or return undef; 672 673 return $self->markElement 674 ($context, 'text:span', $expr, 'text:style-name' => $style); 675 } 676 677#----------------------------------------------------------------------------- 678# set text spans that are attributed using a particular style 679 680sub setTextSpan 681 { 682 my $self = shift; 683 my $path = shift; 684 my $element = (ref $path) ? $path : $self->getElement($path, shift) 685 or return undef; 686 my $style = shift or return undef; 687 my %opt = @_; 688 689 my $tag = $opt{'tag'} || 'text:span'; 690 delete $opt{'tag'}; 691 $opt{'attributes'}{'text:style-name'} = $style; 692 if (is_true($opt{'repeat'})) 693 { 694 delete $opt{'repeat'}; 695 return $self->setChildElements($element, $tag, %opt); 696 } 697 else 698 { 699 return $self->setChildElement($element, $tag, %opt); 700 } 701 } 702 703#----------------------------------------------------------------------------- 704 705sub setTextSpans 706 { 707 my $self = shift; 708 my $path = shift; 709 my $element = (ref $path) ? $path : $self->getElement($path, shift) 710 or return undef; 711 my $style = shift or return undef; 712 my %opt = @_; 713 714 return $self->setTextSpan($element, $style, %opt, repeat => 'true'); 715 } 716 717#----------------------------------------------------------------------------- 718 719sub textField 720 { 721 my $self = shift; 722 my $name = shift; 723 my %opt = 724 ( 725 '-prefix' => 'text', 726 @_ 727 ); 728 return $self->create_field($name, %opt); 729 } 730 731#----------------------------------------------------------------------------- 732 733sub setTextField 734 { 735 my $self = shift; 736 my $path = shift; 737 my $context = (ref $path) ? $path : $self->getElement($path, shift) 738 or return undef; 739 my $field_type = shift; 740 my %opt = @_; 741 742 if ($field_type eq 'variable') 743 { 744 $field_type = 'text:user-field-get'; 745 $opt{'attributes'}{'text:name'} = $opt{'name'}; 746 $opt{'attributes'}{'style:data-style-name'} = $opt{'style'}; 747 $opt{'no_text'} = 'true'; 748 if (is_true($opt{'check'})) 749 { 750 my $name = $opt{'name'} || ""; 751 unless ($self->getUserField($name)) 752 { 753 warn "[" . __PACKAGE__ . "::setTextField] " . 754 "Unknown variable $name\n"; 755 return undef; 756 } 757 } 758 delete @opt{qw(name style)}; 759 } 760 else 761 { 762 $field_type = 'text:' . $field_type unless $field_type =~ /:/; 763 } 764 765 return $self->setChildElement($context, $field_type, %opt); 766 } 767 768#----------------------------------------------------------------------------- 769 770sub setTextFields 771 { 772 my $self = shift; 773 my $path = shift; 774 my $context = (ref $path) ? $path : $self->getElement($path, shift) 775 or return undef; 776 my $expr = $self->inputTextConversion(shift); 777 my $tag = shift; 778 my %opt = @_; 779 780 if ($tag eq 'variable') 781 { 782 $tag = 'text:user-field-get'; 783 $opt{'text:name'} = $opt{'name'}; 784 if (is_true($opt{'check'})) 785 { 786 my $name = $opt{'name'} || ""; 787 unless ($self->getUserField($name)) 788 { 789 warn "[" . __PACKAGE__ . "::setTextField] " . 790 "Unknown variable $name\n"; 791 return undef; 792 } 793 } 794 } 795 $opt{'style:data-style-name'} = $opt{'style'}; 796 delete @opt{qw(name style check)}; 797 798 return $self->splitContent($context, $tag, $expr, %opt); 799 } 800 801#----------------------------------------------------------------------------- 802 803sub extendText 804 { 805 my $self = shift; 806 my $path = shift; 807 my $pos = (ref $path) ? undef : shift; 808 my $element = $self->getElement($path, $pos) or return undef; 809 my $text = shift; 810 return undef unless defined $text; 811 my $style = shift; 812 813 if (ref $text) 814 { 815 my $tagname = $text->getName; 816 if ($tagname =~ /^text:(p|h)$/) 817 { 818 $text = $self->getFlatText($text); 819 } 820 } 821 822 if ($style) 823 { 824 $text = $self->createElement('text:span', $text) 825 unless ref $text; 826 $self->textStyle($text, $style); 827 } 828 return $self->SUPER::extendText($element, $text, @_); 829 } 830 831#------------------------------------------------------------------------------ 832# replaces substring in an element and its descendants 833 834sub replaceText 835 { 836 my $self = shift; 837 my $path = shift; 838 my $element = (ref $path) ? 839 $path : 840 $self->getElement($path, shift); 841 842 return $self->_search_content($element, @_); 843 } 844 845#------------------------------------------------------------------------------ 846# replaces substring in an element and its descendants 847 848sub substituteText 849 { 850 my $self = shift; 851 my $path = shift; 852 my $element = (ref $path) ? 853 $path : 854 $self->getElement($path, shift); 855 return undef unless $element; 856 my $filter = $self->inputTextConversion(shift) or return undef; 857 my $replace = shift; 858 my %opt = @_; 859 860 unless (%opt) 861 { 862 $replace = $self->inputTextConversion($replace) 863 unless ref $replace; 864 return $element->subs_text($filter, $replace); 865 } 866 867 $opt{'replace'} = $filter; 868 if ($opt{'element'}) 869 { 870 my $child = $opt{'element'}; delete $opt{'element'}; 871 return $self->setChildElement($element, $child, %opt); 872 } 873 874 my ($text_node, $start_pos, $end_pos, $match) = 875 $self->textIndex($element, %opt); 876 if ($text_node) 877 { 878 my $t = $text_node->text; 879 substr($t, $start_pos, $end_pos - $start_pos, $replace); 880 $text_node->set_text($t); 881 } 882 return undef; 883 } 884 885#----------------------------------------------------------------------------- 886 887sub updateText 888 { 889 my $self = shift; 890 my $path = shift; 891 my $pos = (ref $path) ? undef : shift; 892 my $node = $self->getElement($path, $pos) or return undef; 893 my %opt = @_; 894 return undef unless @_; 895 896 my $replace = $opt{'replace'}; 897 $replace = $opt{'capture'} unless defined $replace; 898 my $after = $opt{'after'}; 899 my $before = $opt{'before'}; 900 my $new_text = $opt{'text'}; 901 $new_text = "" unless defined $new_text; 902 $new_text = $self->inputTextConversion($new_text) 903 unless ref $new_text; 904 my $ln_new = ref $new_text ? 0 : length($new_text); 905 my $offset = lc($opt{'offset'}) || 0; 906 my $repeat = $opt{'repeat'}; delete $opt{'repeat'}; 907 my $forward = (! defined $opt{'way'} || $opt{'way'} ne 'backward'); 908 my $search_string = 909 (defined $after || defined $before || defined $replace); 910 my $nt = ref $new_text ? undef : $new_text; 911 912 unless (defined $new_text && (ref $new_text || $new_text gt "")) 913 { 914 return undef unless defined $replace; 915 } 916 917 if ($offset eq 'start') 918 { 919 $nt = ref $new_text ? 920 $self->inputTextConversion(&$new_text($self, $node)) : 921 $new_text; 922 $node->insertTextChild($nt, 0); 923 $node->normalize; 924 return 1; 925 } 926 elsif ($offset eq 'end') 927 { 928 $nt = ref $new_text ? 929 $self->inputTextConversion(&$new_text($self, $node)) : 930 $new_text; 931 $node->appendTextChild($nt); 932 $node->normalize; 933 return 1; 934 } 935 936 my ($text_node, $start_pos, $end_pos, $match) = 937 $self->textIndex($node, %opt); 938 939 return undef unless $text_node; 940 941 my $t = $text_node->text; 942 my $p = defined $after ? $end_pos : $start_pos; 943 my $size = defined $replace ? $end_pos - $start_pos : 0; 944 if (ref $new_text) 945 { 946 $nt = $self->inputTextConversion 947 (&$new_text($self, $text_node, $match)); 948 $ln_new = length($nt); 949 } 950 substr($t, $p, $size, $nt); 951 $text_node->set_text($t); 952 953 return 1 unless is_true($repeat); 954 955 my $ln_match = defined $match ? length($match) : 0; 956 my $count = 1; 957 $text_node = undef unless (($offset != 0) || $search_string); 958 while ($text_node) 959 { 960 if ($search_string) 961 { 962 if ($forward) 963 { 964 $opt{'offset'} = $p + $ln_new; 965 $opt{'offset'} += $ln_match if defined $before; 966 } 967 else 968 { 969 $opt{'offset'} = $p - length($t); 970 $opt{'offset'} -= $ln_match if defined $after; 971 } 972 $opt{'start_mark'} = $text_node; 973 } 974 else 975 { 976 $opt{'offset'} += ($offset + $ln_new); 977 } 978 ($text_node, $start_pos, $end_pos, $match) = 979 $self->textIndex($node, %opt); 980 if ($text_node) 981 { 982 $ln_match = defined $match ? length($match) : 0; 983 $t = $text_node->text; 984 $p = defined $after ? $end_pos : $start_pos; 985 $size = defined $replace ? $end_pos - $start_pos : 0; 986 if (ref $new_text) 987 { 988 $nt = $self->inputTextConversion 989 ( 990 &$new_text 991 ($self, $text_node, $match) 992 ) || ""; 993 $ln_new = length($nt); 994 } 995 substr($t, $p, $size, $nt); 996 $text_node->set_text($t); 997 $count++; 998 } 999 } 1000 return $count; 1001 } 1002 1003#------------------------------------------------------------------------------ 1004 1005sub setHyperlink 1006 { 1007 my $self = shift; 1008 my $path = shift; 1009 my $pos = (ref $path) ? undef : shift; 1010 my $context = $self->getElement($path, $pos) or return undef; 1011 my $expr = shift; return undef unless defined $expr; 1012 my $url = shift or return undef; 1013 my %opt = @_; 1014 my $tag = 'text:a'; 1015 1016 $opt{'attributes'}{'xlink:href'} = $url; 1017 $opt{'attributes'}{'xlink:type'} = 'simple' 1018 unless $opt{'attributes'}{'xlink:type'}; 1019 $opt{'attributes'}{'office:name'} = $opt{'name'}; 1020 delete @opt{qw(name before after content)}; 1021 $opt{'capture'} = $expr; 1022 1023 return $self->setChildElement($context, $tag, %opt); 1024 } 1025 1026#----------------------------------------------------------------------------- 1027 1028sub setHyperlinks 1029 { 1030 my $self = shift; 1031 my $path = shift; 1032 my $pos = (ref $path) ? undef : shift; 1033 my $context = $self->getElement($path, $pos) or return undef; 1034 my $expr = shift; return undef unless defined $expr; 1035 my $url = shift or return undef; 1036 my %opt = 1037 ( 1038 'xlink:href' => $url, 1039 'xlink:type' => 'simple', 1040 @_ 1041 ); 1042 1043 return $self->markElement($context, 'text:a', $expr, %opt); 1044 } 1045 1046#----------------------------------------------------------------------------- 1047 1048sub selectHyperlinkElements 1049 { 1050 my $self = shift; 1051 my $url = shift; 1052 return $self->selectElementsByAttribute 1053 ('//text:a', 'xlink:href', $url, @_); 1054 } 1055 1056#----------------------------------------------------------------------------- 1057 1058sub selectHyperlinkElement 1059 { 1060 my $self = shift; 1061 my $url = shift; 1062 return $self->selectElementByAttribute 1063 ('//text:a', 'xlink:href', $url, @_); 1064 } 1065 1066#----------------------------------------------------------------------------- 1067 1068sub hyperlinkURL 1069 { 1070 my $self = shift; 1071 my $hl = shift or return undef; 1072 unless (ref $hl) 1073 { 1074 $hl = $self->selectHyperlinkElement($hl); 1075 return undef unless $hl; 1076 } 1077 my $url = shift; 1078 if ($url) 1079 { 1080 $self->setAttribute($hl, 'xlink:href', $url); 1081 } 1082 return $self->getAttribute($hl, 'xlink:href'); 1083 } 1084 1085#----------------------------------------------------------------------------- 1086 1087sub setAnnotation 1088 { 1089 my $self = shift; 1090 my $path = shift; 1091 my $pos = ref $path ? undef : shift; 1092 my $element = $self->getElement($path, $pos); 1093 my %opt = @_; 1094 1095 my $text = $opt{'text'}; delete $opt{'text'}; 1096 my $style = $opt{'style'}; delete $opt{'style'}; 1097 1098 my $creator = $opt{'creator'} || $opt{'author'} || $ENV{'USER'}; 1099 delete $opt{'author'}; delete $opt{'creator'}; 1100 my $date = (defined $opt{'date'}) ? 1101 $opt{'date'} : odfLocaltime(); 1102 delete $opt{'date'}; 1103 delete $opt{'capture'}; 1104 my $annotation = $self->setChildElement 1105 ($element, 'office:annotation', %opt); 1106 1107 $self->appendElement 1108 ($annotation, 'dc:creator', text => $creator); 1109 $self->appendElement 1110 ($annotation, 'dc:date', text => $date); 1111 $self->appendParagraph 1112 ( 1113 attachment => $annotation, 1114 text => $text, 1115 style => $style 1116 ); 1117 1118 return $annotation; 1119 } 1120 1121#----------------------------------------------------------------------------- 1122# creates and inserts a footnote or endnote 1123 1124sub setNote 1125 { 1126 my $self = shift; 1127 my $path = shift; 1128 my $pos = ref $path ? undef : shift; 1129 my $element = $self->getElement($path, $pos) or return undef; 1130 my %opt = 1131 ( 1132 'style' => 'Standard', 1133 'citation' => undef, 1134 'id' => undef, 1135 'class' => 'footnote', 1136 'label' => undef, 1137 @_ 1138 ); 1139 my $text = $opt{'text'}; delete $opt{'text'}; 1140 1141 my $note = $self->setChildElement($element, 'text:note', %opt); 1142 $self->setAttributes 1143 ( 1144 $note, 1145 'text:id' => $opt{'id'}, 1146 'text:note-class' => $opt{'class'} 1147 ); 1148 my $note_citation = $note->appendChild('text:note-citation'); 1149 if (defined $opt{'label'}) 1150 { 1151 $self->setAttribute 1152 ($note_citation, 'text:label', $opt{'label'}); 1153 $opt{'citation'} = $opt{'label'} 1154 unless defined $opt{'citation'}; 1155 } 1156 $self->setText($note_citation, $opt{'citation'}); 1157 my $note_body = $note->appendChild('text:note-body'); 1158 $self->appendParagraph 1159 ( 1160 attachment => $note_body, 1161 text => $text, 1162 style => $opt{'style'} 1163 ); 1164 return $note; 1165 } 1166 1167#----------------------------------------------------------------------------- 1168 1169sub removeTextStyleChanges 1170 { 1171 my $self = shift; 1172 my $path = shift or return undef; 1173 my $context = ref $path ? $path : $self->getElement($path, @_); 1174 return undef unless $context; 1175 my $span_name = 'text:span'; 1176 1177 my $name = $context->getName; 1178 unless ($name =~ /^text:(p|h|span)$/) 1179 { 1180 warn "[" . __PACKAGE__ . "::removeTextStyleChanges] " . 1181 "$name is not a text container\n"; 1182 return undef; 1183 } 1184 my $new_elt = OpenOffice::OODoc::Element->new($name); 1185 $new_elt->set_atts($context->atts); 1186 my $count = 0; 1187 foreach my $n ($context->descendants) 1188 { 1189 if ($n->getName() ne $span_name) 1190 { 1191 $n->move(last_child => $new_elt); 1192 } 1193 else 1194 { 1195 $count++; 1196 } 1197 } 1198 1199 if ($count > 0) 1200 { 1201 $new_elt->replace($context); 1202 return $new_elt; 1203 } 1204 else 1205 { 1206 $new_elt->delete; 1207 return $context; 1208 } 1209 } 1210 1211#----------------------------------------------------------------------------- 1212 1213sub removeHyperlink 1214 { 1215 my $self = shift; 1216 return $self->removeSpan(@_, 'text:a'); 1217 } 1218 1219#----------------------------------------------------------------------------- 1220# get all the bibliographic entries 1221 1222sub getBibliographyMarks 1223 { 1224 my $self = shift; 1225 my $id = shift; 1226 1227 unless ($id) 1228 { 1229 return $self->getDescendants('text:bibliography-mark'); 1230 } 1231 else 1232 { 1233 return $self->selectElementsByAttribute 1234 ( 1235 '//text:bibliography-mark', 'text:identifier', 1236 $id, @_ 1237 ); 1238 } 1239 } 1240 1241#----------------------------------------------------------------------------- 1242# get/set the content of a bibliography entry 1243 1244sub bibliographyEntryContent 1245 { 1246 my $self = shift; 1247 my $id = shift; 1248 my $e = undef; 1249 my %desc = @_; 1250 unless (ref $id) 1251 { 1252 my $i = $self->inputTextConversion($id); 1253 $e = $self->getNodeByXPath 1254 ( 1255 "//text:bibliography-mark[\@text:identifier=\"$i\"]", 1256 $desc{'context'} 1257 ); 1258 } 1259 else 1260 { 1261 $e = $id; 1262 } 1263 return undef unless $e; 1264 1265 my $k = undef; 1266 foreach $k (keys %desc) 1267 { 1268 next if $k =~ /:/; 1269 my $v = $desc{$k}; 1270 delete $desc{$k}; 1271 $k = 'text:' . $k; 1272 $desc{$k} = $v; 1273 } 1274 $self->setAttributes($e, %desc); 1275 %desc = $self->getAttributes($e); 1276 foreach $k (keys %desc) 1277 { 1278 my $new_key = $k; 1279 $new_key =~ s/^text://; 1280 my $v = $desc{$k}; delete $desc{$k}; $desc{$new_key} = $v; 1281 } 1282 return %desc; 1283 } 1284 1285#----------------------------------------------------------------------------- 1286# inserts a new bibliography entry within a text element 1287 1288sub setBibliographyMark 1289 { 1290 my $self = shift; 1291 my $path = shift; 1292 my $pos = ref $path ? undef : shift; 1293 my $element = $self->getElement($path, $pos); 1294 my %opt = @_; 1295 1296 my $bib = $self->setChildElement( 1297 $element, 'bibliography-mark', @_ 1298 ); 1299# my $bib = $self->createElement('text:bibliography-mark'); 1300 $self->bibliographyEntryContent($bib, @_); 1301 return $bib; 1302 } 1303 1304#----------------------------------------------------------------------------- 1305# creates a pair of markup elements as range delimiters 1306 1307sub setRangeMark 1308 { 1309 my $self = shift; 1310 my $type = shift or return undef; 1311 my $id = shift or return undef; 1312 my %opt = @_; 1313 1314 $type =~ s/ /-/g; 1315 my $check = $opt{'check'}; delete $opt{'check'}; 1316 my $prefix = $opt{'prefix'} || 'text'; 1317 my $context = $opt{'context'}; delete $opt{'context'}; 1318 my $content = $opt{'content'}; 1319 delete @opt{qw(after before replace)}; 1320 my %start = (); 1321 my %end = (); 1322 my %attributes = (); 1323 if ($opt{'start'}) 1324 { 1325 %start = %{$opt{'start'}}; delete $opt{'start'}; 1326 } 1327 if ($opt{'end'}) 1328 { 1329 %end = %{$opt{'end'}}; delete $opt{'end'}; 1330 } 1331 delete $start{'attributes'}; 1332 delete $end{'attributes'}; 1333 $end{'context'} = $start{'context'} unless $end{'context'}; 1334 if ($opt{'attributes'}) 1335 { 1336 %attributes = %{$opt{'attributes'}}; delete $opt{'attributes'}; 1337 } 1338 1339 $type = "$prefix:$type" unless $type =~ /:/; 1340 my $start_tag = $type . '-start'; 1341 my $end_tag = $type . '-end'; 1342 my $start_context = 1343 $context || $start{'context'}; 1344 my $end_context = 1345 $context || $end{'context'} || $start_context; 1346 delete $start{'context'}; 1347 delete $end{'context'}; 1348 1349 my $start_mark = undef; 1350 my $end_mark = undef; 1351 $opt{'no_text'} = 'true'; 1352 if (defined $content) 1353 { 1354 delete @opt{qw(before after replace content)}; 1355 $opt{'no_text'} = 'true'; 1356 $end_mark = $self->setChildElement 1357 ( 1358 $context, $end_tag, 1359 %opt, after => $content 1360 ); 1361 $start_mark = $self->setChildElement 1362 ( 1363 $context, $start_tag, 1364 %opt, before => $content 1365 ); 1366 } 1367 else 1368 { 1369 $end_mark = $self->setChildElement 1370 ( 1371 $end_context, $end_tag, %end, 1372 no_text => 'true' 1373 ); 1374 $start_mark = $self->setChildElement 1375 ( 1376 $start_context, $start_tag, %start, 1377 no_text => 'true' 1378 ); 1379 } 1380 unless ($start_mark && $end_mark) 1381 { 1382 $self->removeElement($start_mark); 1383 $self->removeElement($end_mark); 1384 return wantarray ? (undef, undef) : undef; 1385 } 1386 elsif (is_true($check)) 1387 { 1388 if ($end_mark->before($start_mark)) 1389 { 1390 warn "[" . __PACKAGE__ . "::setRangeMark] " . 1391 "End position before start position\n"; 1392 $start_mark->delete; 1393 $end_mark->delete; 1394 return wantarray ? (undef, undef) : undef; 1395 } 1396 } 1397 unless ($type =~ /bookmark/) 1398 { 1399 $self->setIdentifier($start_mark, $id); 1400 $self->setIdentifier($end_mark, $id); 1401 } 1402 else 1403 { 1404 $self->elementName($start_mark, $id); 1405 $self->elementName($end_mark, $id); 1406 } 1407 $self->setAttributes($start_mark, %attributes); 1408 return wantarray ? ($start_mark, $end_mark) : $start_mark; 1409 } 1410 1411#------------------------------------------------------------------------------ 1412 1413sub checkRangeMark 1414 { 1415 my $self = shift; 1416 my $id = shift; 1417 my $type = shift; 1418 my $context = shift; 1419 1420 $type =~ s/ /-/g; $type = 'text:' . $type unless $type =~ /:/; 1421 my $attr = ($type =~ /bookmark/) ? 'text:name' : 'text:id'; 1422 my $start_tag = $type . '-start'; 1423 my $end_tag = $type . '-end'; 1424 1425 my $start = $self->selectNodeByXPath 1426 ("//$start_tag\[\@$attr=\"$id\"\]", $context); 1427 my $end = $self->selectNodeByXPath 1428 ("//$end_tag\[\@$attr=\"$id\"\]", $context); 1429 if ($start && $end) 1430 { 1431 return $start->before($end) ? TRUE : FALSE; 1432 } 1433 elsif ($start || $end) 1434 { 1435 return FALSE; 1436 } 1437 return undef; 1438 } 1439 1440#------------------------------------------------------------------------------ 1441 1442sub deleteMark 1443 { 1444 my $self = shift; 1445 my $id = $self->inputTextConversion(shift); 1446 my $type = shift; 1447 my $attr = shift || 'text:id'; 1448 my $context = shift; 1449 1450 $attr =~ s/ /-/g; $attr = 'text:' . $attr unless $attr =~ /:/; 1451 $type =~ s/ /-/g; $type = 'text:' . $type unless $type =~ /:/; 1452 my $start_tag = $type . '-start'; 1453 my $end_tag = $type . '-end'; 1454 my $count = 0; 1455 1456 foreach my $e ( 1457 $self->getElementList 1458 ("//$type\[\@$attr=\"$id\"\]", $context), 1459 $self->getElementList 1460 ("//$start_tag\[\@$attr=\"$id\"\]", $context), 1461 $self->getElementList 1462 ("//$end_tag\[\@$attr=\"$id\"\]", $context) 1463 ) 1464 { 1465 $e->delete; $count++; 1466 } 1467 1468 return $count; 1469 } 1470 1471#------------------------------------------------------------------------------ 1472 1473sub deleteMarks 1474 { 1475 my $self = shift; 1476 my $type = shift; 1477 my $context = shift; 1478 1479 $type =~ s/ /-/g; $type = 'text:' . $type unless $type =~ /:/; 1480 my $start_tag = $type . '-start'; 1481 my $end_tag = $type . '-end'; 1482 1483 my $count = 0; 1484 foreach my $e ( 1485 $self->getElementList("//$type", $context), 1486 $self->getElementList("//$start_tag", $context), 1487 $self->getElementList("//$end_tag", $context) 1488 ) 1489 { 1490 $e->delete; $count++; 1491 } 1492 1493 return $count; 1494 } 1495 1496#----------------------------------------------------------------------------- 1497# get a bookmark 1498 1499sub getBookmark 1500 { 1501 my $self = shift; 1502 my $name = shift or return undef; 1503 1504 unless (ref $name) 1505 { 1506 return ( 1507 $self->getNodeByXPath 1508 ("//text:bookmark\[\@text:name=\"$name\"\]", @_) 1509 || 1510 $self->getNodeByXPath 1511 ("//text:bookmark-start\[\@text:name=\"$name\"\]", @_) 1512 ); 1513 } 1514 else 1515 { 1516 my $tag = $name->getName; 1517 return ($tag =~ /^text:bookmark/) ? $name : undef; 1518 } 1519 } 1520 1521#----------------------------------------------------------------------------- 1522# retrieve the element where is a given bookmark 1523 1524sub selectElementByBookmark 1525 { 1526 my $self = shift; 1527 1528 my $bookmark = $self->getBookmark(@_); 1529 return $bookmark ? $bookmark->parent : undef; 1530 } 1531 1532#----------------------------------------------------------------------------- 1533 1534sub setRangeBookmark 1535 { 1536 my $self = shift; 1537 return $self->setRangeMark('text:bookmark', @_); 1538 } 1539 1540#----------------------------------------------------------------------------- 1541# set a position or range bookmark 1542 1543sub setBookmark 1544 { 1545 my $self = shift; 1546 my $context = undef; 1547 my $name = undef; 1548 my $arg1 = shift or return undef; 1549 if (ref $arg1) 1550 { 1551 $context = $arg1; 1552 $name = shift or return undef; 1553 } 1554 else 1555 { 1556 $name = $arg1; 1557 } 1558 my %opt = @_; 1559 delete $opt{'text'}; # no text content for bookmarks 1560 if (defined $context) # one target element => position bookmark 1561 { 1562 delete $opt{'context'}; 1563 $opt{'attributes'}{'text:name'} = $name; 1564 $opt{'no_text'} = 'true'; 1565 return $self->setChildElement($context, 'text:bookmark', %opt); 1566 } 1567 else # else => range bookmark 1568 { 1569 return $self->setRangeBookmark($name, %opt); 1570 } 1571 } 1572 1573#----------------------------------------------------------------------------- 1574# check the existence and consistency of a range bookmark 1575 1576sub checkRangeBookmark 1577 { 1578 my $self = shift; 1579 my $name = shift; 1580 1581 return $self->checkRangeMark($name, 'bookmark', @_); 1582 } 1583 1584#----------------------------------------------------------------------------- 1585# delete a bookmark 1586 1587sub deleteBookmark 1588 { 1589 my $self = shift; 1590 my $name = shift; 1591 1592 return $self->deleteMark($name, 'text:bookmark', 'text:name', @_); 1593 } 1594 1595#----------------------------------------------------------------------------- 1596# delete all the bookmarks in the context 1597 1598sub deleteBookmarks 1599 { 1600 my $self = shift; 1601 1602 return $self->deleteMarks('text:bookmark', @_); 1603 } 1604 1605#----------------------------------------------------------------------------- 1606# creates an alphabetical index or TOC mark 1607 1608sub setIndexMark 1609 { 1610 my $self = shift; 1611 my $path = shift; 1612 my $pos = ref $path ? undef : shift; 1613 my $element = $self->getElement($path, $pos) or return undef; 1614 my $id = shift or return undef; 1615 my %opt = @_; 1616 1617 my $type = $opt{'type'} || 'alphabetical-index'; 1618 delete $opt{'type'}; 1619 $opt{'context'} = $element; 1620 my $tag = 'text:' . $type . '-mark'; 1621 return $self->setRangeMark($tag, $id, %opt); 1622 } 1623 1624#----------------------------------------------------------------------------- 1625# check the existence and consistency of a range bookmark 1626 1627sub checkIndexMark 1628 { 1629 my $self = shift; 1630 my $id = shift; 1631 my $type = shift; 1632 1633 $type = $type . '-mark'; 1634 return $self->checkRangeMark($id, $type, @_); 1635 } 1636 1637#----------------------------------------------------------------------------- 1638# delete an index mark 1639 1640sub deleteIndexMark 1641 { 1642 my $self = shift; 1643 my $id = shift; 1644 my $type = shift; 1645 1646 $type = $type . '-mark'; 1647 return $self->deleteMark($id, $type, 'text:id', @_); 1648 } 1649 1650#----------------------------------------------------------------------------- 1651# delete all the index marks of a given type in the context 1652 1653sub deleteIndexMarks 1654 { 1655 my $self = shift; 1656 my $type = shift; 1657 1658 if ($type) 1659 { 1660 $type = $type . '-mark'; 1661 return $self->deleteMarks($type, @_); 1662 } 1663 else 1664 { 1665 return $self->deleteMarks('text:toc-mark', @_) 1666 + 1667 $self->deleteMarks('text:alphabetical-index-mark', @_); 1668 } 1669 } 1670 1671#----------------------------------------------------------------------------- 1672# get the footnote bodies in the document 1673 1674sub getFootnoteList 1675 { 1676 my $self = shift; 1677 1678 my $xpath = $self->{'opendocument'} ? 1679 '//text:note[@text:note-class="footnote"]/text:note-body' : 1680 '//text:footnote-body'; 1681 return $self->getElementList($xpath, @_); 1682 } 1683 1684#----------------------------------------------------------------------------- 1685# get the footnote citations in the document 1686 1687sub getFootnoteCitationList 1688 { 1689 my $self = shift; 1690 1691 my $xpath = $self->{'opendocument'} ? 1692 '//text:note[@text:note-class="footnote"]/text:note-citation' : 1693 '//text:footnote-citation'; 1694 return $self->getElementList($xpath, @_); 1695 } 1696 1697#----------------------------------------------------------------------------- 1698# get the endnote bodies in the document 1699 1700sub getEndnoteList 1701 { 1702 my $self = shift; 1703 1704 my $xpath = $self->{'opendocument'} ? 1705 '//text:note[@text:note-class="endnote"]/text:note-body' : 1706 '//text:endnote-body'; 1707 return $self->getElementList($xpath, @_); 1708 } 1709 1710#----------------------------------------------------------------------------- 1711# get the endnote citations in the document 1712 1713sub getEndnoteCitationList 1714 { 1715 my $self = shift; 1716 1717 my $xpath = $self->{'opendocument'} ? 1718 '//text:note[@text:note-class="endnote"]/text:note-citation' : 1719 '//text:endnote-citation'; 1720 return $self->getElementList($xpath, @_); 1721 } 1722 1723#----------------------------------------------------------------------------- 1724# get the note citations in the document (ODF only) 1725 1726sub getNoteCitationList 1727 { 1728 my $self = shift; 1729 return $self->getDescendants('text:note-citation', @_); 1730 } 1731 1732#----------------------------------------------------------------------------- 1733 1734sub getNoteElementList 1735 { 1736 my $self = shift; 1737 my $class = shift; 1738 1739 unless ($class) 1740 { 1741 if ($self->{'opendocument'}) 1742 { 1743 return $self->getElementList('//text:note'); 1744 } 1745 else 1746 { 1747 return ( 1748 $self->getElementList('//text:footnote'), 1749 $self->getElementList('//text:endnote') 1750 ); 1751 } 1752 } 1753 elsif (($class eq 'footnote') or ($class eq 'endnote')) 1754 { 1755 if ($self->{'opendocument'}) 1756 { 1757 return $self->getElementList 1758 ("//text:note\[\@text:note-class=\"$class\"\]"); 1759 } 1760 else 1761 { 1762 return $self->getElementList("//text:$class"); 1763 } 1764 } 1765 else 1766 { 1767 warn "[" . __PACKAGE__ . "::getNoteElementList] " . 1768 "Unknown note class $class\n"; 1769 return undef; 1770 } 1771 } 1772 1773#----------------------------------------------------------------------------- 1774# retrieve a note element using its identifier (ODF only) 1775 1776sub getNoteElement 1777 { 1778 my $self = shift; 1779 my $p1 = shift; 1780 if (ref $p1) 1781 { 1782 return $p1->isNote ? $p1 : undef; 1783 } 1784 else 1785 { 1786 unshift @_, $p1; 1787 } 1788 my %opt = @_; 1789 1790 my $xpath = undef; 1791 my $id = $opt{id}; 1792 my $class = $opt{class}; 1793 my $citation = $opt{citation}; 1794 1795 if ($id) 1796 { 1797 unless ($self->{'opendocument'}) 1798 { 1799 return $self->getElement 1800 ("//text:$class\[\@text:id=\"$id\"\]") 1801 if $class; 1802 return $self->getElement 1803 ("//text:footnote\[\@text:id=\"$id\"\]") 1804 || 1805 $self->getElement 1806 ("//text:endnote\[\@text:id=\"$id\"\]"); 1807 } 1808 else 1809 { 1810 my $xpath = $class ? 1811 "//text:note\[\@text:note-class=\"$class\"" . 1812 " and \@text:id=\"$id\"\]" : 1813 "//text:note\[\@text:id=\"$id\"\]"; 1814 return $self->getElement($xpath); 1815 } 1816 } 1817 elsif ($class && defined $citation) 1818 { 1819 my @list = $self->getNoteElementList($class); 1820 my $tagname = $self->{'opendocument'} ? 1821 "text:note-citation" : "text:$class-citation"; 1822 foreach my $elt (@list) 1823 { 1824 next unless $elt; 1825 my $text = $self->getFlatText 1826 ($elt->first_child($tagname)); 1827 return $elt if $text eq $citation; 1828 } 1829 return undef; 1830 } 1831 else 1832 { 1833 warn "[" . __PACKAGE__ . "::getNoteElement] " . 1834 "Requires (Id) OR (class AND citation)\n"; 1835 return undef; 1836 } 1837 } 1838 1839#----------------------------------------------------------------------------- 1840 1841sub getNoteClass 1842 { 1843 my $self = shift; 1844 my $element = shift or return undef; 1845 unless (ref $element) 1846 { 1847 unshift @_, $element; 1848 $element = $self->getNoteElement(@_) or return undef; 1849 } 1850 return $element->getNoteClass; 1851 } 1852 1853#----------------------------------------------------------------------------- 1854# get the list of tables in the document 1855 1856sub getTableList 1857 { 1858 my $self = shift; 1859 return $self->getElementList('//table:table', @_); 1860 } 1861 1862#----------------------------------------------------------------------------- 1863# get a heading element selected by position number and level 1864 1865sub getHeading 1866 { 1867 my $self = shift; 1868 my $pos = shift; 1869 my %opt = (@_); 1870 my $heading = undef; 1871 1872 if (ref $pos) 1873 { 1874 return undef unless $pos->isHeading; 1875 if ($opt{'level'}) 1876 { 1877 my $level = $pos->att($self->{'level_attr'}); 1878 return undef unless 1879 ($level && ($level == $opt{'level'})); 1880 } 1881 return $pos; 1882 } 1883 1884 unless ($opt{'level'}) 1885 { 1886 $heading = $self->getElement 1887 ('//text:h', $pos, $opt{'context'}); 1888 } 1889 else 1890 { 1891 my $path = '//text:h[@' . 1892 $self->{'level_attr'} . 1893 '="' . $opt{'level'} . '"]'; 1894 $heading = $self->getElement 1895 ($path, $pos, $opt{'context'}); 1896 } 1897 return undef unless $heading; 1898 } 1899 1900#----------------------------------------------------------------------------- 1901# get the text of a heading element 1902 1903sub getHeadingContent 1904 { 1905 my $self = shift; 1906 return $self->getText('//text:h', @_); 1907 } 1908 1909#----------------------------------------------------------------------------- 1910# get the level attribute (if defined) of an element 1911# the level must be defined for heading elements 1912 1913sub getLevel 1914 { 1915 my $self = shift; 1916 my $path = shift; 1917 my $pos = (ref $path) ? undef : shift; 1918 1919 my $element = $self->getElement($path, $pos, @_); 1920 return $element->getAttribute($self->{'level_attr'}) || ""; 1921 } 1922 1923#----------------------------------------------------------------------------- 1924 1925sub setLevel 1926 { 1927 my $self = shift; 1928 my $path = shift; 1929 my $pos = (ref $path) ? undef : shift; 1930 my $level = shift; 1931 1932 my $element = $self->getElement($path, $pos, @_) or return undef; 1933 return $element->setAttribute($self->{'level_attr'} => $level); 1934 } 1935 1936#----------------------------------------------------------------------------- 1937 1938sub makeHeading 1939 { 1940 my $self = shift; 1941 my %opt = @_; 1942 my $element = $opt{'element'}; 1943 if ($element) 1944 { 1945 $element->set_name('text:h'); 1946 } 1947 else 1948 { 1949 $element = $self->createElement('text:h'); 1950 } 1951 if ($opt{'level'}) 1952 { 1953 $element->set_att($self->{'level_attr'}, $opt{'level'}); 1954 } 1955 my $style = $opt{'style'} ? $opt{'style'} : $self->{'heading_style'}; 1956 $self->setAttribute($element, 'text:style-name', $style); 1957 if (defined $opt{'text'}) 1958 { 1959 $self->setText($element, $opt{'text'}); 1960 } 1961 return $element; 1962 } 1963 1964#----------------------------------------------------------------------------- 1965 1966sub getSection 1967 { 1968 my $self = shift; 1969 my $name = shift; 1970 return undef unless defined $name; 1971 1972 if (ref $name) 1973 { 1974 return ($name->isSection) ? $name : undef; 1975 } 1976 if (($name =~ /^\d*$/) || ($name =~ /^[\d+-]\d+$/)) 1977 { 1978 return $self->getElement('//text:section', $name, @_); 1979 } 1980 1981 my $n = $self->inputTextConversion($name); 1982 return $self->selectElementByAttribute 1983 ('text:section', 'text:name', $n, @_); 1984 } 1985 1986#----------------------------------------------------------------------------- 1987 1988sub getSectionList 1989 { 1990 my $self = shift; 1991 return $self->getDescendants('text:section', @_); 1992 } 1993 1994#----------------------------------------------------------------------------- 1995 1996sub sectionStyle 1997 { 1998 my $self = shift; 1999 my $section = $self->getSection(shift) or return undef; 2000 my $new_style = shift; 2001 return $new_style ? 2002 $self->setAttribute($section, 'text:style-name', $new_style) : 2003 $self->getAttribute($section, 'text:style-name'); 2004 } 2005 2006#----------------------------------------------------------------------------- 2007 2008sub renameSection 2009 { 2010 my $self = shift; 2011 my $section = $self->getSection(shift) or return undef; 2012 my $newname = shift or return undef; 2013 2014 if ($self->getSection($newname)) 2015 { 2016 warn "[" . __PACKAGE__ . "::renameSection] " . 2017 "Section name $newname already in use\n"; 2018 return undef; 2019 } 2020 return $self->setAttribute($section, 'text:name' => $newname); 2021 } 2022 2023#----------------------------------------------------------------------------- 2024 2025sub sectionName 2026 { 2027 my $self = shift; 2028 my $section = $self->getSection(shift) or return undef; 2029 my $newname = shift; 2030 return $newname ? 2031 $self->renameSection($section, $newname) : 2032 $self->getAttribute($section, 'text:name'); 2033 } 2034 2035#----------------------------------------------------------------------------- 2036 2037sub appendSection 2038 { 2039 my $self = shift; 2040 my $name = shift; 2041 my %opt = 2042 ( 2043 'attachment' => $self->{'body'}, 2044 'style' => $name, 2045 'protected' => 'false', 2046 @_ 2047 ); 2048 2049 if ($self->getSection($name, $self->{'xpath'})) 2050 { 2051 warn "[" . __PACKAGE__ . "::appendSection] " . 2052 "Section $name exists\n"; 2053 return undef; 2054 } 2055 2056 my $link = undef; 2057 if ($opt{"link"}) 2058 { 2059 $link = $opt{'link'}; delete $opt{'link'} 2060 } 2061 2062 my $section = $self->appendElement 2063 ( 2064 $opt{'attachment'}, 'text:section', 2065 attribute => 2066 { 2067 'text:name' => $name, 2068 'text:style-name' => $opt{'style'} 2069 }, 2070 %opt 2071 ) 2072 or return undef; 2073 2074 $self->insertSubdocument 2075 ($section, $link, $opt{'filter'}) if $link; 2076 $section->set_att('text:protected', $opt{'protected'}) 2077 if $opt{'protected'}; 2078 $section->set_att('text:protection-key', $opt{'key'}) 2079 if $opt{'key'}; 2080 2081 return $section; 2082 } 2083 2084#----------------------------------------------------------------------------- 2085 2086sub lockSection 2087 { 2088 my $self = shift; 2089 my $section = $self->getSection(shift) or return undef; 2090 $section->set_att('text:protected', 'true'); 2091 my $key = shift; 2092 $section->set_att('text:protection-key', $key) if $key; 2093 } 2094 2095sub unlockSection 2096 { 2097 my $self = shift; 2098 my $section = $self->getSection(shift) or return undef; 2099 $section->del_att('text:protected'); 2100 my $key = $section->att('text:protection-key'); 2101 $section->del_att('text:protection-key'); 2102 return $key; 2103 } 2104 2105sub unlockSections 2106 { 2107 my $self = shift; 2108 foreach my $section ($self->getSectionList(@_)) 2109 { 2110 $self->unlockSection($section); 2111 } 2112 } 2113 2114sub sectionProtectionKey 2115 { 2116 my $self = shift; 2117 my $section = $self->getSection(shift) or return undef; 2118 return $section->att('text:protection-key'); 2119 } 2120 2121#----------------------------------------------------------------------------- 2122 2123sub insertSection 2124 { 2125 my $self = shift; 2126 my $path = shift; 2127 my $pos = ref $path ? undef : shift; 2128 my $name = shift; 2129 my %opt = 2130 ( 2131 'style' => $name, 2132 'protected' => 'false', 2133 @_ 2134 ); 2135 my $posnode = $self->getElement($path, $pos, $opt{'context'}) 2136 or return undef; 2137 2138 if ($self->getSection($name, $self->{'xpath'})) 2139 { 2140 warn "[" . __PACKAGE__ . "::insertSection] " . 2141 "Section $name exists\n"; 2142 return undef; 2143 } 2144 2145 my $link = undef; 2146 if ($opt{"link"}) 2147 { 2148 $link = $opt{'link'}; delete $opt{'link'} 2149 } 2150 2151 my $section = $self->insertElement 2152 ( 2153 $posnode, 'text:section', 2154 attribute => 2155 { 2156 'text:name' => $name, 2157 'text:style-name' => $opt{'style'} 2158 }, 2159 %opt 2160 ) 2161 or return undef; 2162 2163 $self->insertSubdocument 2164 ($section, $link, $opt{'filter'}) if $link; 2165 $section->set_att('text:protected', $opt{'protected'}) 2166 if $opt{'protected'}; 2167 $section->set_att('text:protection-key', $opt{'key'}) 2168 if $opt{'key'}; 2169 2170 return $section; 2171 } 2172 2173#----------------------------------------------------------------------------- 2174# link a section to a subdocument 2175 2176our $section_source_tag = "text:section-source"; 2177 2178sub insertSubdocument 2179 { 2180 my $self = shift; 2181 my $section_id = shift; 2182 my $url = shift; 2183 my %attr = (); 2184 2185 my $section = $self->getSection($section_id); 2186 unless ($section) 2187 { 2188 warn "[" . __PACKAGE__ . "::insertSubdocument] " . 2189 "Non existing target section\n"; 2190 return undef; 2191 } 2192 my $doclink = 2193 $section->first_child($section_source_tag) 2194 || 2195 $self->appendElement($section, $section_source_tag); 2196 2197 if ($attr{'filter'}) 2198 { 2199 $attr{'text:filter-name'} = $attr{'filter'}; 2200 delete $attr{'filter'}; 2201 } 2202 $self->setAttributes($doclink, "xlink:href" => $url, %attr); 2203 2204 return $doclink; 2205 } 2206 2207#----------------------------------------------------------------------------- 2208# get the content depending on a given heading element 2209 2210sub getChapterContent 2211 { 2212 my $self = shift; 2213 my $h = shift || 0; 2214 my $heading = ref $h ? $h : $self->getHeading($h, @_); 2215 return undef unless $heading; 2216 my @list = (); 2217 my $level = $self->getLevel($heading) or return @list; 2218 2219 my $next_element = $heading->next_sibling; 2220 while ($next_element) 2221 { 2222 my $l = $self->getLevel($next_element); 2223 last if ($l && $l <= $level); 2224 push @list, $next_element; 2225 $next_element = $next_element->next_sibling; 2226 } 2227 2228 return @list; 2229 } 2230 2231#----------------------------------------------------------------------------- 2232 2233sub moveElementsToSection 2234 { 2235 my $self = shift; 2236 my $section = $self->getSection(shift) or return undef; 2237 $section->pickUpChildren(@_); 2238 return $section; 2239 } 2240 2241#----------------------------------------------------------------------------- 2242# get a paragraph element selected by number 2243 2244sub getParagraph 2245 { 2246 my $self = shift; 2247 return $self->getElement('//text:p', @_); 2248 } 2249 2250#----------------------------------------------------------------------------- 2251# same as getParagraph() but only among the 1st level paragraphs 2252# and only in text documents 2253 2254sub getTopParagraph 2255 { 2256 my $self = shift; 2257 my $path = $self->{'opendocument'} ? 2258 '//office:body/office:text/text:p' : 2259 '//office:body/text:p'; 2260 return $self->getElement($path, @_); 2261 } 2262 2263#----------------------------------------------------------------------------- 2264# select paragraphs by stylename 2265 2266sub selectParagraphsByStyle 2267 { 2268 my $self = shift; 2269 return $self->selectElementsByAttribute 2270 ('//text:p', 'text:style-name', @_); 2271 } 2272 2273#----------------------------------------------------------------------------- 2274# select a single paragraph by stylename 2275 2276sub selectParagraphByStyle 2277 { 2278 my $self = shift; 2279 return $self->selectElementByAttribute 2280 ('//text:p', 'text:style-name', @_); 2281 } 2282 2283#----------------------------------------------------------------------------- 2284# get text content of a paragraph 2285 2286sub getParagraphText 2287 { 2288 my $self = shift; 2289 return $self->getText('//text:p', @_); 2290 } 2291 2292#----------------------------------------------------------------------------- 2293# select a draw page by name 2294 2295sub selectDrawPageByName 2296 { 2297 my $self = shift; 2298 my $text = $self->inputTextConversion(shift); 2299 return $self->selectNodeByXPath 2300 ("//draw:page\[\@draw:name=\"$text\"\]", @_); 2301 } 2302#----------------------------------------------------------------------------- 2303# get a draw page by position or name 2304 2305sub getDrawPage 2306 { 2307 my $self = shift; 2308 my $p = shift; 2309 return undef unless defined $p; 2310 if (ref $p) { return ($p->isDrawPage) ? $p : undef; } 2311 if ($p =~ /^[\-0-9]*$/) 2312 { 2313 return $self->getElement('//draw:page', $p, @_); 2314 } 2315 else 2316 { 2317 return $self->selectDrawPageByName($p, @_); 2318 } 2319 } 2320 2321#----------------------------------------------------------------------------- 2322 2323sub getDrawPages 2324 { 2325 my $self = shift; 2326 return $self->getDescendants('draw:page', @_); 2327 } 2328 2329#----------------------------------------------------------------------------- 2330# create a draw page (to be inserted later) 2331 2332sub createDrawPage 2333 { 2334 my $self = shift; 2335 my $class = $self->contentClass; 2336 unless ($class eq 'presentation' || $class eq 'drawing') 2337 { 2338 warn "[" . __PACKAGE__ . "::createDrawPage] " . 2339 "Unsupported operation for this document\n"; 2340 return undef; 2341 } 2342 my %opt = @_; 2343 my $body = $self->getBody; 2344 2345 my $p = $self->createElement('draw:page'); 2346 $self->setAttribute($p, 'draw:name' => $opt{'name'}) 2347 if $opt{'name'}; 2348 $self->setAttribute($p, 'draw:id' => $opt{'id'}) 2349 if $opt{'id'}; 2350 $self->setAttribute($p, 'draw:style-name' => $opt{'style'}) 2351 if $opt{'style'}; 2352 $self->setAttribute($p, 'draw:master-page-name' => $opt{'master'}) 2353 if $opt{'master'}; 2354 return $p; 2355 } 2356 2357#----------------------------------------------------------------------------- 2358# append a new draw page to the document 2359 2360sub appendDrawPage 2361 { 2362 my $self = shift; 2363 my $page = $self->createDrawPage(@_) or return undef; 2364 my $body = $self->getBody; 2365 $self->appendElement($body, $page); 2366 return $page; 2367 } 2368 2369#----------------------------------------------------------------------------- 2370# insert a new draw page before or after an existing one 2371 2372sub insertDrawPage 2373 { 2374 my $self = shift; 2375 my $pos = shift or return undef; 2376 my $pos_page = $self->getDrawPage($pos); 2377 unless ($pos_page) 2378 { 2379 warn "[" . __PACKAGE__ . "::insertDrawPage] " . 2380 "Unknown position\n"; 2381 return undef; 2382 } 2383 my %opt = @_; 2384 my $page = $self->createDrawPage(%opt) or return undef; 2385 $self->insertElement($pos_page, $page, position => $opt{'position'}); 2386 2387 return $page; 2388 } 2389 2390#----------------------------------------------------------------------------- 2391 2392sub drawPageAttribute 2393 { 2394 my $self = shift; 2395 my $att = shift; 2396 my $pos = shift; 2397 my $page = $self->getDrawPage($pos) or return undef; 2398 my $value = shift; 2399 2400 return $value ? 2401 $self->setAttribute($page, $att, $value) : 2402 $self->getAttribute($page, $att); 2403 } 2404 2405#----------------------------------------------------------------------------- 2406 2407sub drawPageName 2408 { 2409 my $self = shift; 2410 return $self->drawPageAttribute('draw:name', @_); 2411 } 2412 2413#----------------------------------------------------------------------------- 2414 2415sub drawPageStyle 2416 { 2417 my $self = shift; 2418 return $self->drawPageAttribute('draw:style-name', @_); 2419 } 2420 2421#----------------------------------------------------------------------------- 2422 2423sub drawPageId 2424 { 2425 my $self = shift; 2426 return $self->drawPageAttribute('draw:id', @_); 2427 } 2428 2429#----------------------------------------------------------------------------- 2430 2431sub drawMasterPage 2432 { 2433 my $self = shift; 2434 return $self->drawPageAttribute('draw:master-page-name', @_); 2435 } 2436 2437#----------------------------------------------------------------------------- 2438 2439sub createTextBoxElement 2440 { 2441 my $self = shift; 2442 my %opt = @_; 2443 my $frame = undef; 2444 my $text_box = undef; 2445 if ($self->{'opendocument'}) 2446 { 2447 $frame = $self->createFrame(tag => 'draw:frame', %opt); 2448 $text_box = $self->appendElement($frame, 'draw:text-box'); 2449 } 2450 else 2451 { 2452 $text_box = $self->createFrame(tag => 'draw:text-box', %opt); 2453 $frame = $text_box; 2454 } 2455 if ($opt{'content'}) 2456 { 2457 if (ref $opt{'content'}) 2458 { 2459 $opt{'content'}->paste_last_child($text_box); 2460 } 2461 else 2462 { 2463 $self->appendParagraph 2464 ( 2465 attachment => $text_box, 2466 text => $opt{'content'} 2467 ); 2468 } 2469 } 2470 return wantarray ? ($frame, $text_box) : $text_box; 2471 } 2472 2473#----------------------------------------------------------------------------- 2474 2475sub getTextBoxElement 2476 { 2477 my $self = shift; 2478 my $tb = shift; 2479 return undef unless defined $tb; 2480 2481 if (ref $tb) 2482 { 2483 my $name = $tb->getName; 2484 if ($name eq 'draw:frame') 2485 { 2486 return $tb->first_child('draw:text-box') ? 2487 $tb : undef; 2488 } 2489 elsif ($name eq 'draw:text-box') 2490 { 2491 return $tb unless $self->{'opendocument'}; 2492 my $frame = $tb->parent; 2493 return $frame->isFrame ? $frame : undef; 2494 } 2495 else 2496 { 2497 return undef; 2498 } 2499 } 2500 else 2501 { 2502 if ($tb =~ /^[\-0-9]*$/) 2503 { 2504 my $e = $self->getElement('//draw:text-box', $tb, @_); 2505 return $self->{'opendocument'} ? 2506 $e->parent() : $e; 2507 } 2508 else 2509 { 2510 return $self->selectTextBoxElementByName($tb, @_); 2511 } 2512 } 2513 } 2514 2515#----------------------------------------------------------------------------- 2516 2517sub setTextBoxContent 2518 { 2519 my $self = shift; 2520 my $frame = $self->getTextBoxElement(shift) or return undef; 2521 2522 if ($frame->isFrame) 2523 { 2524 $frame = $frame->first_child('draw:text-box') 2525 or return undef; 2526 } 2527 2528 $frame->cut_children; 2529 my $content = shift; 2530 if (ref $content) 2531 { 2532 $content->paste_last_child($frame); 2533 return $content; 2534 } 2535 else 2536 { 2537 return $self->appendParagraph 2538 ( 2539 attachment => $frame, 2540 text => $content 2541 ); 2542 } 2543 } 2544 2545#----------------------------------------------------------------------------- 2546# text box attributes accessors 2547 2548sub textBoxCoordinates 2549 { 2550 my $self = shift; 2551 my $tb = $self->getTextBoxElement(shift) or return undef; 2552 my $coord = shift; 2553 return (defined $coord) ? 2554 $self->setObjectCoordinates($tb, $coord) : 2555 $self->getObjectCoordinates($tb); 2556 } 2557 2558sub textBoxSize 2559 { 2560 my $self = shift; 2561 my $tb = $self->getTextBoxElement(shift) or return undef; 2562 my $size = shift; 2563 return (defined $size) ? 2564 $self->setObjectSize($tb, $size) : 2565 $self->getObjectSize($tb); 2566 } 2567 2568sub textBoxDescription 2569 { 2570 my $self = shift; 2571 my $tb = $self->getTextBoxElement(shift) or return undef; 2572 my $description = shift; 2573 return (defined $description) ? 2574 $self->setObjectDescription($tb, $description) : 2575 $self->getObjectDescription($tb); 2576 } 2577 2578sub textBoxName 2579 { 2580 my $self = shift; 2581 my $tb = $self->getTextBoxElement(shift) or return undef; 2582 return $self->objectName($tb, shift); 2583 } 2584 2585#----------------------------------------------------------------------------- 2586 2587sub selectTextBoxElementByName 2588 { 2589 my $self = shift; 2590 my $tag = $self->{'opendocument'} ? 'draw:frame' : 'draw:text-box'; 2591 my $frame = $self->getFrameElement(shift, $tag); 2592 if ($self->{'opendocument'}) 2593 { 2594 return undef unless ($frame->first_child('draw:text-box')); 2595 } 2596 return $frame; 2597 } 2598 2599#----------------------------------------------------------------------------- 2600 2601sub getTextElementist 2602 { 2603 my $self = shift; 2604 my $context = shift; 2605 my @tblist = $self->getDescendants('draw:text-box', $context); 2606 return @tblist unless $self->{'opendocumpent'}; 2607 my @frlist = (); 2608 foreach my $tb (@tblist) 2609 { 2610 push @frlist, $tb->parent; 2611 } 2612 return @frlist; 2613 } 2614 2615#----------------------------------------------------------------------------- 2616# get list element 2617 2618sub getItemList 2619 { 2620 my $self = shift; 2621 my $pos = shift; 2622 if (ref $pos) 2623 { 2624 return $pos->isItemList ? $pos : undef; 2625 } 2626 return $self->getElement('//text:list', $pos, @_); 2627 } 2628 2629#----------------------------------------------------------------------------- 2630# return the text content of an item list (in array or string) 2631 2632sub getItemListText 2633 { 2634 my $self = shift; 2635 my $list = $self->getItemList(@_) or return undef; 2636 my @items = $list->children('text:list-item'); 2637 if (wantarray) 2638 { 2639 my @result = (); 2640 foreach my $item (@items) 2641 { 2642 push @result, $self->getItemText($item); 2643 } 2644 return @result; 2645 } 2646 else 2647 { 2648 my $tagname = $list->getName; 2649 my $line_break = 2650 $self->{'line_separator'} || ''; 2651 my $item_begin = 2652 $self->{'delimiters'}{'text:p'}{'begin'} || ''; 2653 my $item_end = 2654 $self->{'delimiters'}{'text:p'}{'end'} || ''; 2655 my $result = 2656 $self->{'delimiters'}{$tagname}{'begin'} || ''; 2657 my $end_list = 2658 $self->{'delimiters'}{$tagname}{'end'} || ''; 2659 my $count = 0; 2660 foreach my $item (@items) 2661 { 2662 $result .= $line_break if $count > 0; 2663 $result .= $item_begin; 2664 $result .= ($self->getItemText($item) || ""); 2665 $result .= $item_end; 2666 $count++; 2667 } 2668 $result .= $end_list; 2669 return $result; 2670 } 2671 } 2672 2673#----------------------------------------------------------------------------- 2674# get ordered list root element 2675 2676sub getOrderedList 2677 { 2678 my $self = shift; 2679 my $pos = shift; 2680 if (ref $pos) 2681 { 2682 return $pos->isOrderedList ? $pos : undef; 2683 } 2684 return $self->getElement('//text:ordered-list', $pos, @_); 2685 } 2686 2687#----------------------------------------------------------------------------- 2688# get unordered list root element 2689 2690sub getUnorderedList 2691 { 2692 my $self = shift; 2693 my $pos = shift; 2694 if (ref $pos) 2695 { 2696 return $pos->isUnorderedList ? $pos : undef; 2697 } 2698 return $self->getElement('//text:unordered-list', $pos, @_); 2699 } 2700 2701#----------------------------------------------------------------------------- 2702# get item elements list 2703 2704sub getItemElementList 2705 { 2706 my $self = shift; 2707 my $list = shift; 2708 return $list->children('text:list-item'); 2709 } 2710 2711#----------------------------------------------------------------------------- 2712 2713sub getListItem 2714 { 2715 my $self = shift; 2716 my $list = $self->getItemList(shift) or return undef; 2717 return $list->child(shift, 'text:list-item'); 2718 } 2719 2720#----------------------------------------------------------------------------- 2721# get item element text 2722 2723sub getItemText 2724 { 2725 my $self = shift; 2726 my $item = shift; 2727 2728 return undef unless $item; 2729 my $para = $item->selectChildElement('text:(p|h)'); 2730 return $para ? $self->getText($para) : undef; 2731 } 2732 2733#----------------------------------------------------------------------------- 2734# set item element text 2735 2736sub setItemText 2737 { 2738 my $self = shift; 2739 my $item = shift; 2740 return undef unless $item; 2741 my $text = shift; 2742 return undef unless (defined $text); 2743 2744 my $para = $item->selectChildElement('text:(p|h)') 2745 || 2746 $self->appendElement($item, 'text:p'); 2747 return $self->setText($para, $text); 2748 } 2749 2750#----------------------------------------------------------------------------- 2751# get item element style 2752 2753sub getItemStyle 2754 { 2755 my $self = shift; 2756 my $item = shift; 2757 return undef unless $item; 2758 2759 my $para = $item->selectChildElement('text:(p|h)'); 2760 return $self->textStyle($para); 2761 } 2762 2763#----------------------------------------------------------------------------- 2764# set item element style 2765 2766sub setItemStyle 2767 { 2768 my $self = shift; 2769 my $item = shift; 2770 return undef unless $item; 2771 my $style = shift; 2772 2773 my $para = $item->selectChildElement('text:(p|h)'); 2774 return $self->textStyle($para, $style); 2775 } 2776 2777#----------------------------------------------------------------------------- 2778# append a new item in a list 2779 2780sub appendListItem 2781 { 2782 my $self = shift; 2783 my $list = shift; 2784 return undef unless $list; 2785 my %opt = 2786 ( 2787 type => 'text:p', 2788 @_ 2789 ); 2790 2791 my $type = $opt{'type'}; 2792 2793 my $item = $self->appendElement($list, 'text:list-item'); 2794 return $item unless $type; 2795 2796 my $text = $opt{'text'}; 2797 my $style = $opt{'style'}; 2798 $style = $opt{'attribute'}{'text:style-name'} unless $style; 2799 2800 unless ($style) 2801 { 2802 my $first_item = $list->selectChildElement('text:list-item'); 2803 if ($first_item) 2804 { 2805 my $p = $first_item->selectChildElement 2806 ('text:(p|h)'); 2807 $style = $self->textStyle($p) if ($p); 2808 } 2809 } 2810 2811 if ($type eq 'paragraph') { $type = 'text:p'; } 2812 elsif ($type eq 'heading') { $type = 'text:h'; } 2813 2814 my $para = $self->appendElement 2815 ( 2816 $item, $type, 2817 text => $text 2818 ); 2819 $style = $self->{'paragraph_style'} unless $style; 2820 $opt{'attribute'}{'text:style-name'} = $style; 2821 $self->setAttributes($para, %{$opt{'attribute'}}); 2822 2823 return $item; 2824 } 2825 2826sub appendItem 2827 { 2828 my $self = shift; 2829 return $self->appendListItem(@_); 2830 } 2831 2832#----------------------------------------------------------------------------- 2833# append a new item list 2834 2835sub appendItemList 2836 { 2837 my $self = shift; 2838 my %opt = @_; 2839 my $name = 'text:unordered-list'; 2840 $opt{'attribute'}{'text:style-name'} = $opt{'style'} if $opt{'style'}; 2841 $opt{'attribute'}{'text:style-name'} = $self->{'paragraph_style'} 2842 unless $opt{'attribute'}{'text:style-name'}; 2843 $opt{'attribute'}{'text:continue-numbering'} = 2844 $opt{'continue-numbering'} if $opt{'continue-numbering'}; 2845 2846 if ($self->{'opendocument'}) 2847 { 2848 $name = 'text:list'; 2849 } 2850 else 2851 { 2852 if (defined $opt{'type'} && ($opt{'type'} eq 'ordered')) 2853 { $name = 'text:ordered-list' ; } 2854 } 2855 2856 my $attachment = $opt{'attachment'} || $self->{'body'}; 2857 return $self->appendElement($attachment, $name, %opt); 2858 } 2859 2860#----------------------------------------------------------------------------- 2861# insert a new item list 2862 2863sub insertItemList 2864 { 2865 my $self = shift; 2866 my $path = shift; 2867 my $posnode = (ref $path) ? 2868 $path : 2869 $self->getElement($path, shift); 2870 my %opt = @_; 2871 my $name = 'text:unordered-list'; 2872 $opt{'attribute'}{'text:style-name'} = $opt{'style'} if $opt{'style'}; 2873 $opt{'attribute'}{'text:style-name'} = $self->{'paragraph_style'} 2874 unless $opt{'attribute'}{'text:style-name'}; 2875 $opt{'attribute'}{'text:continue-numbering'} = 2876 $opt{'continue-numbering'} if $opt{'continue-numbering'}; 2877 2878 if ($self->{'opendocument'}) 2879 { 2880 $name = 'text:list'; 2881 } 2882 else 2883 { 2884 if (defined $opt{'type'} && ($opt{'type'} eq 'ordered')) 2885 { $name = 'text:ordered-list' ; } 2886 } 2887 2888 return $self->insertElement($posnode, $name, %opt); 2889 } 2890 2891#----------------------------------------------------------------------------- 2892# row expansion utility for _expand_table 2893 2894sub _expand_row 2895 { 2896 my $self = shift; 2897 my $row = shift; 2898 unless ($row) 2899 { 2900 warn "[" . __PACKAGE__ . "::_expand_row] " . 2901 "Unknown table row\n"; 2902 return undef; 2903 } 2904 my $width = shift; 2905 2906 my @cells = $row->selectChildElements 2907 ('table:(covered-|)table-cell'); 2908 2909 my $cell = undef; 2910 my $last_cell = undef; 2911 my $rep = 0; 2912 my $cellnum = 0; 2913 while (@cells) 2914 { 2915 last if (defined $width and ($cellnum >= $width)); 2916 $cell = shift @cells; 2917 $last_cell = $cell; 2918 $rep = $cell ? 2919 $cell->getAttribute($COL_REPEAT_ATTRIBUTE) : 2920 0; 2921 if ($rep) 2922 { 2923 $cell->removeAttribute($COL_REPEAT_ATTRIBUTE); 2924 while ($rep > 1) 2925 { 2926 last if 2927 (defined $width and ($cellnum >= $width)); 2928 $last_cell = $last_cell->replicateNode; 2929 $rep--; $cellnum++; 2930 } 2931 } 2932 $cellnum++ if $cell; 2933 } 2934 2935 $last_cell->setAttribute($COL_REPEAT_ATTRIBUTE, $rep) 2936 if ($rep && ($rep > 1)); 2937 2938 return $cellnum; 2939 } 2940 2941#----------------------------------------------------------------------------- 2942# column expansion utility for _expand_table 2943 2944sub _expand_columns 2945 { 2946 my $self = shift; 2947 my $table = shift; 2948 return undef unless ($table && ref $table); 2949 my $width = shift; 2950 2951 my @cols = $table->children('table:table-column'); 2952 2953 my $col = undef; 2954 my $last_col = undef; 2955 my $rep = 0; 2956 my $colnum = 0; 2957 while (@cols) 2958 { 2959 last if (defined $width and ($colnum >= $width)); 2960 $col = shift @cols; $last_col = $col; 2961 $rep = $col ? 2962 $col->getAttribute($COL_REPEAT_ATTRIBUTE) : 2963 0; 2964 if ($rep) 2965 { 2966 $col->removeAttribute($COL_REPEAT_ATTRIBUTE); 2967 while ($rep > 1) 2968 { 2969 last if 2970 (defined $width and ($colnum >= $width)); 2971 $last_col = $last_col->replicateNode; 2972 $rep--; $colnum++; 2973 } 2974 } 2975 $colnum++ if $col; 2976 } 2977 2978 $last_col->setAttribute($COL_REPEAT_ATTRIBUTE, $rep) 2979 if ($rep && ($rep > 1)); 2980 return $colnum; 2981 } 2982 2983#----------------------------------------------------------------------------- 2984# expands repeated table elements in order to address them in spreadsheets 2985# in the same way as in text documents 2986 2987sub _expand_table 2988 { 2989 my $self = shift; 2990 my $table = shift; 2991 my $length = shift || $self->{'max_rows'}; 2992 my $width = shift || $self->{'max_cols'}; 2993 return undef unless ($table && ref $table); 2994 if ($length && ($length eq 'full')) 2995 { 2996 $length = undef; $width = undef; 2997 } 2998 2999 my $new_width = $self->_expand_columns($table, $width); 3000 3001 my @rows = (); 3002 my $header = $table->first_child('table:table-header-rows'); 3003 @rows = $header->children('table:table-row') if $header; 3004 push @rows, $table->children('table:table-row'); 3005 3006 my $row = undef; 3007 my $last_row = undef; 3008 my $rep = 0; 3009 my $rownum = 0; 3010 while (@rows) 3011 { 3012 last if (defined $length and ($rownum >= $length)); 3013 $row = shift @rows; $last_row = $row; 3014 my $last_width = $self->_expand_row($row, $width); 3015 $new_width = $last_width if $last_width > $new_width; 3016 $rep = $row ? 3017 $row->getAttribute($ROW_REPEAT_ATTRIBUTE) : 3018 0; 3019 if ($rep) 3020 { 3021 $row->removeAttribute($ROW_REPEAT_ATTRIBUTE); 3022 while ($rep > 1) 3023 { 3024 last if 3025 (defined $length and ($rownum >= $length)); 3026 $last_row = $last_row->replicateNode; 3027 $rep--; $rownum++; 3028 } 3029 } 3030 $rownum++ if $row; 3031 } 3032 3033 $last_row->setAttribute($ROW_REPEAT_ATTRIBUTE, $rep) 3034 if ($rep && ($rep > 1)); 3035 3036 return wantarray ? ($rownum, $new_width) : $table; 3037 } 3038 3039#----------------------------------------------------------------------------- 3040# get a table size in ($lines, $columns) form 3041 3042sub getTableSize 3043 { 3044 my $self = shift; 3045 my $table = $self->getTable(@_) or return undef; 3046 my $height = 0; 3047 my $width = 0; 3048 3049 my @rows = (); 3050 my $header = $table->first_child('table:table-header-rows'); 3051 @rows = $header->children('table:table-row') if $header; 3052 push @rows, $table->children('table:table-row'); 3053 foreach my $row (@rows) 3054 { 3055 my $rep = $row->getAttribute($ROW_REPEAT_ATTRIBUTE) || 1; 3056 $height += $rep; 3057 my @cells = $row->selectChildElements 3058 ('table:(covered-|)table-cell'); 3059 my $row_width = 0; 3060 foreach my $cell (@cells) 3061 { 3062 my $rep = $cell->getAttribute($COL_REPEAT_ATTRIBUTE); 3063 $row_width += $rep ? $rep : 1; 3064 } 3065 $width = $row_width if $row_width > $width; 3066 } 3067 return ($height, $width); 3068 } 3069 3070#----------------------------------------------------------------------------- 3071# increases the size of an existing table 3072# improved by Barry Slaymaker [rt.cpan.org #41975] 3073 3074sub expandTable 3075 { 3076 my $self = shift; 3077 my $table = shift; 3078 my $length = shift || 0; 3079 my $width = shift || 0; 3080 my $context = shift; 3081 3082 my ($old_length, $old_width) = $self->getTableSize($table); 3083 $table = $self->normalizeSheet($table, 'full'); 3084 unless ($table) 3085 { 3086 warn "[" . __PACKAGE__ . "::expandTable] " . 3087 "Unknown or badly formed table\n"; 3088 return undef; 3089 } 3090 my $last_col = $self->getTableColumn($table, -1); 3091 my $last_row = $self->getRow($table, -1); 3092 my $i = 0; 3093 my $j = 0; 3094 3095 # expand column declarations 3096 for ($i = $old_width ; $i < $width ; $i++) 3097 { 3098 $last_col = $last_col->replicateNode; 3099 } 3100 3101 # expand existing rows 3102 for ($i = 0 ; $i < $old_length ; $i++) 3103 { 3104 my $row = $self->getTableRow($table, $i); 3105 my $last_cell = $self->getTableCell($row, -1); 3106 for ($j = $old_width ; $j < $width ; $j++) 3107 { 3108 $last_cell = $last_cell->replicateNode; 3109 } 3110 } 3111 3112 # append new rows 3113 for ($i = $old_length; $i < $length; $i++) 3114 { 3115 $last_row = $last_row->replicateNode; 3116 } 3117 return wantarray ? $self->getTableSize($table) : $table; 3118 } 3119 3120#----------------------------------------------------------------------------- 3121# get a table column descriptor element 3122 3123sub getTableColumn 3124 { 3125 my $self = shift; 3126 my $p1 = shift; 3127 return $p1 if (ref $p1 && $p1->isTableColumn); 3128 my $col = shift || 0; 3129 my $table = $self->getTable($p1, @_) or return undef; 3130 3131 return $table->child($col, 'table:table-column'); 3132 } 3133 3134#----------------------------------------------------------------------------- 3135# get/set a column style 3136 3137sub columnStyle 3138 { 3139 my $self = shift; 3140 my $p1 = shift; 3141 my $column = undef; 3142 if (ref $p1 && $p1->isTableColumn) 3143 { 3144 $column = $p1; 3145 } 3146 else 3147 { 3148 $column = $self->getTableColumn($p1, shift) or return undef; 3149 } 3150 my $newstyle = shift; 3151 3152 return defined $newstyle ? 3153 $self->setAttribute($column, 'table:style-name' => $newstyle) 3154 : 3155 $self->getAttribute($column, 'table:style-name'); 3156 } 3157 3158#----------------------------------------------------------------------------- 3159# get/set a row style 3160 3161sub rowStyle 3162 { 3163 my $self = shift; 3164 my $p1 = shift; 3165 my $row = undef; 3166 if (ref $p1 && $p1->isTableRow) 3167 { 3168 $row = $p1; 3169 } 3170 else 3171 { 3172 $row = $self->getTableRow($p1, shift) or return undef; 3173 } 3174 my $newstyle = shift; 3175 3176 return defined $newstyle ? 3177 $self->setAttribute($row, 'table:style-name' => $newstyle) 3178 : 3179 $self->getAttribute($row, 'table:style-name'); 3180 } 3181 3182#----------------------------------------------------------------------------- 3183# get a row element from table id and row num, 3184# or the row cells if wantarray 3185 3186sub getTableRow 3187 { 3188 my $self = shift; 3189 my $p1 = shift; 3190 return $p1 if (ref $p1 && $p1->isTableRow); 3191 my $line = shift || 0; 3192 my $table = $self->getTable($p1, @_) or return undef; 3193 3194 return $table->child($line, 'table:table-row'); 3195 } 3196 3197#----------------------------------------------------------------------------- 3198# get a table header container 3199 3200sub getTableHeader 3201 { 3202 my $self = shift; 3203 my $table = $self->getTable(@_) or return undef; 3204 return $table->first_child('table:table-header-rows'); 3205 } 3206 3207#----------------------------------------------------------------------------- 3208# get a header row in a table 3209 3210sub getTableHeaderRow 3211 { 3212 my $self = shift; 3213 my $p1 = shift; 3214 if (ref $p1) 3215 { 3216 if ($p1->isTableRow) 3217 { 3218 if ($p1->parent->hasTag('table:table-header-rows')) 3219 { return $p1; } 3220 else 3221 { return undef; } 3222 } 3223 } 3224 my $line = shift || 0; 3225 my $table = $self->getTable($p1, @_) 3226 or return undef; 3227 my $header = $table->first_child('table:table-header-rows') 3228 or return undef; 3229 return $header->child($line, 'table:table-row'); 3230 } 3231 3232#----------------------------------------------------------------------------- 3233# insert a table header container 3234 3235sub copyRowToHeader 3236 { 3237 my $self = shift; 3238 my $row = $self->getTableRow(@_) or return undef; 3239 my $table = $row->parent; 3240 my $header = $table->first_child('table:table-header-rows'); 3241 unless ($header) 3242 { 3243 my $first_row = $self->getTableRow($table, 0); 3244 unless ($first_row) 3245 { 3246 warn "[" . __PACKAGE__ . "::createTableHeader] " . 3247 "Not allowed with an empty table\n"; 3248 return undef; 3249 } 3250 $header = $self->createElement('table:table-header-rows'); 3251 $header->paste_before($first_row); 3252 } 3253 my $header_row = $row->copy; 3254 $header_row->paste_last_child($header); 3255 return $header_row; 3256 } 3257 3258#----------------------------------------------------------------------------- 3259# get all the rows in a table 3260 3261sub getTableRows 3262 { 3263 my $self = shift; 3264 my $table = $self->getTable(@_) or return undef; 3265 3266 return $table->children('table:table-row'); 3267 } 3268 3269#----------------------------------------------------------------------------- 3270# spreadsheet coordinates conversion utility 3271 3272sub _coord_conversion 3273 { 3274 my $arg = shift; return ($arg, @_) unless $arg; 3275 my $coord = uc $arg; 3276 return ($arg, @_) unless $coord =~ /[A-Z]/; 3277 3278 $coord =~ s/\s*//g; 3279 $coord =~ /(^[A-Z]*)(\d*)/; 3280 my $c = $1; 3281 my $r = $2; 3282 return ($arg, @_) unless ($c && $r); 3283 3284 my $rownum = $r - 1; 3285 my @csplit = split '', $c; 3286 my $colnum = 0; 3287 foreach my $p (@csplit) 3288 { 3289 $colnum *= 26; 3290 $colnum += ((ord($p) - ord('A')) + 1); 3291 } 3292 $colnum--; 3293 3294 return ($rownum, $colnum, @_); 3295 } 3296 3297#----------------------------------------------------------------------------- 3298# get cell element by 3D coordinates ($tablenum, $line, $column) 3299# or by ($tablename/$tableref, $line, $column) 3300 3301sub getTableCell 3302 { 3303 my $self = shift; 3304 my $p1 = shift; 3305 return undef unless defined $p1; 3306 my $table = undef; 3307 my $row = undef; 3308 my $cell = undef; 3309 3310 if (! ref $p1 || ($p1->isTable)) 3311 { 3312 @_ = OpenOffice::OODoc::Text::_coord_conversion(@_); 3313 my $r = shift || 0; 3314 my $c = shift || 0; 3315 if (ref $p1) 3316 { 3317 $table = $p1; 3318 } 3319 else 3320 { 3321 my $context = shift; 3322 unless (ref $context) 3323 { 3324 unshift @_, $context; $context = undef; 3325 } 3326 $table = $self->getTable($p1, $context) 3327 or return undef; 3328 } 3329 $row = $table->child($r, 'table:table-row') 3330 or return undef; 3331 $cell = ( 3332 $row->selectChildElements 3333 ('table:(covered-|)table-cell') 3334 )[$c]; 3335 } 3336 elsif ($p1->isTableCell) 3337 { 3338 $cell = $p1; 3339 } 3340 else # assume $p1 is a table row 3341 { 3342 $cell = $p1->selectChildElement 3343 ( 3344 'table:(covered-|)table-cell', 3345 shift 3346 ); 3347 } 3348 3349 return undef unless ($cell && ! $cell->isCovered); 3350 return wantarray ? ($cell, @_) : $cell; 3351 } 3352 3353#----------------------------------------------------------------------------- 3354# adapted from a suggestion by dhoworth 3355 3356sub getCellPosition 3357 { 3358 my $self = shift; 3359 my $cell = $self->getTableCell(@_); 3360 unless ($cell && $cell->isTableCell) 3361 { 3362 warn "[" . __PACKAGE__ . "::cellPosition] " . 3363 "Non-cell argument\n"; 3364 return undef; 3365 } 3366 my $cp = $cell->pos() - 1; 3367 my $row = $cell->parent; 3368 my $rp = $row->pos('table:table-row') - 1; 3369 my $table = $row->parent; 3370 my $tp = $table->pos('table:table') - 1; 3371 return wantarray ? ($tp, $rp, $cp) : $tp; 3372 } 3373 3374#----------------------------------------------------------------------------- 3375# get all the cells in a row 3376 3377sub getRowCells 3378 { 3379 my $self = shift; 3380 my $row = $self->getTableRow(@_) or return undef; 3381 3382 return $row->children('table:table-cell'); 3383 } 3384 3385#----------------------------------------------------------------------------- 3386 3387sub getCellParagraph 3388 { 3389 my $self = shift; 3390 my $cell = $self->getTableCell(@_) or return undef; 3391 return $cell->first_child('text:p'); 3392 } 3393 3394#----------------------------------------------------------------------------- 3395 3396sub getCellParagraphs 3397 { 3398 my $self = shift; 3399 my $cell = $self->getTableCell(@_) or return undef; 3400 return $cell->children('text:p'); 3401 } 3402 3403#----------------------------------------------------------------------------- 3404# get table cell value 3405 3406sub getCellValue 3407 { 3408 my $self = shift; 3409 my $cell = $self->getTableCell(@_) or return undef; 3410 3411 my $prefix = $self->{'opendocument'} ? 'office' : 'table'; 3412 my $cell_type = $self->cellType($cell); 3413 if ((! $cell_type) || ($cell_type eq 'string')) # text value 3414 { 3415 return $self->getText($cell); 3416 } 3417 else 3418 { 3419 my $attribute = $self->cellValueAttributeName($cell); 3420 return $cell->att($attribute); 3421 } 3422 } 3423 3424#----------------------------------------------------------------------------- 3425# get/set a cell value type 3426 3427sub cellValueType 3428 { 3429 my $self = shift; 3430 @_ = $self->getTableCell(@_); 3431 my $cell = shift or return undef; 3432 3433 return $self->cellType($cell, @_); 3434 } 3435 3436#----------------------------------------------------------------------------- 3437# get/set a cell currency 3438 3439sub fieldCurrency 3440 { 3441 my $self = shift; 3442 @_ = $self->getTableCell(@_); 3443 my $cell = shift or return undef; 3444 3445 my $newcurrency = shift; 3446 my $prefix = $self->{'opendocument'} ? 'office' : 'table'; 3447 unless ($newcurrency) 3448 { 3449 return $cell->att($prefix . ':currency'); 3450 } 3451 else 3452 { 3453 $cell->set_att($prefix . ':value-type', 'currency'); 3454 return $cell->set_att($prefix . ':currency', $newcurrency); 3455 } 3456 } 3457 3458#----------------------------------------------------------------------------- 3459# get/set accessor for the formula of a table cell 3460 3461sub cellFormula 3462 { 3463 my $self = shift; 3464 @_ = $self->getTableCell(@_); 3465 my $cell = shift or return undef; 3466 3467 my $formula = shift; 3468 if (defined $formula) 3469 { 3470 if ($formula gt ' ') 3471 { 3472 $self->setAttribute($cell, 'table:formula', $formula); 3473 } 3474 else 3475 { 3476 $self->removeAttribute($cell, 'table:formula'); 3477 } 3478 } 3479 return $self->getAttribute($cell, 'table:formula'); 3480 } 3481 3482#----------------------------------------------------------------------------- 3483# set value of an existing cell 3484 3485sub updateCell 3486 { 3487 my $self = shift; 3488 @_ = $self->getTableCell(@_); 3489 my $cell = shift or return undef; 3490 3491 my $value = shift; 3492 my $text = shift; 3493 3494 $text = $value unless defined $text; 3495 my $cell_type = $self->cellType($cell); 3496 unless ($cell_type) 3497 { 3498 $cell_type = 'string'; 3499 $self->cellType($cell, $cell_type); 3500 } 3501 3502 my $p = $cell->first_child('text:p'); 3503 unless ($p) 3504 { 3505 $p = $self->createParagraph($text); 3506 $p->paste_last_child($cell); 3507 } 3508 else 3509 { 3510 $self->SUPER::setText($p, $text); 3511 } 3512 3513 unless ($cell_type eq 'string') 3514 { 3515 my $attribute = $self->cellValueAttributeName($cell); 3516 $cell->setAttribute($attribute, $value); 3517 } 3518 return $cell; 3519 } 3520 3521#----------------------------------------------------------------------------- 3522# get/set a cell value 3523 3524sub cellValue 3525 { 3526 my $self = shift; 3527 @_ = $self->getTableCell(@_); 3528 my $cell = shift or return undef; 3529 my $newvalue = shift; 3530 if (defined $newvalue) 3531 { 3532 $self->updateCell($cell, $newvalue, @_); 3533 } 3534 return $self->getCellValue($cell); 3535 } 3536 3537#----------------------------------------------------------------------------- 3538# get/set a cell style 3539 3540sub cellStyle 3541 { 3542 my $self = shift; 3543 @_ = $self->getTableCell(@_); 3544 my $cell = shift or return undef; 3545 3546 my $newstyle = shift; 3547 3548 return defined $newstyle ? 3549 $self->setAttribute($cell, 'table:style-name' => $newstyle) : 3550 $self->getAttribute($cell, 'table:style-name'); 3551 } 3552 3553#----------------------------------------------------------------------------- 3554# get/set cell spanning (from a contribution by Don_Reid[at]Agilent.com) 3555 3556sub removeCellSpan 3557 { 3558 my $self = shift; 3559 my $cell = $self->getTableCell(@_) or return undef; 3560 my $hspan = $cell->getAttribute('table:number-columns-spanned') || 1; 3561 $cell->removeAttribute('table:number-columns-spanned'); 3562 my $vspan = $cell->getAttribute('table:number-rows-spanned') || 1; 3563 $cell->removeAttribute('table:number-rows-spanned'); 3564 my $row = $cell->parent('table:table-row'); 3565 my $table = $row->parent('table:table'); 3566 my $vpos = $row->getLocalPosition; 3567 my $hpos = $cell->getLocalPosition(qr'table:(covered-|)table-cell'); 3568 my $vend = $vpos + $vspan - 1; 3569 my $hend = $hpos + $hspan - 1; 3570 my $cell_paragraph = $cell->first_child('text:p'); 3571 ROW: for (my $i = $vpos ; $i <= $vend ; $i++) 3572 { 3573 my $cr = $self->getRow($table, $i) or last ROW; 3574 CELL: for (my $j = $hpos ; $j <= $hend ; $j++) 3575 { 3576 my $covered = $cr->selectChildElement 3577 (qr 'table:(covered-|)table-cell', $j) 3578 or last CELL; 3579 next CELL if $covered == $cell; 3580 $covered->set_name('table:table-cell'); 3581 $covered->set_atts($cell->atts); 3582 $covered->removeAttribute('table:value'); 3583 if ($cell_paragraph) 3584 { 3585 my $p = $cell_paragraph->copy; 3586 $p->set_text(""); 3587 $p->paste_first_child($covered); 3588 } 3589 } 3590 } 3591 } 3592 3593sub cellSpan 3594 { 3595 my $self = shift; 3596 @_ = $self->getTableCell(@_); 3597 my $cell = shift or return undef; 3598 3599 my $rnum = undef; 3600 my $cnum = undef; 3601 my $table = undef; 3602 3603 my $old_hspan = $cell->att('table:number-columns-spanned') || 1; 3604 my $old_vspan = $cell->att('table:number-rows-spanned') || 1; 3605 my $hspan = shift; 3606 my $vspan = shift; 3607 unless ($hspan || $vspan) 3608 { 3609 return wantarray ? ($old_hspan, $old_vspan) : $old_hspan; 3610 } 3611 $hspan = $old_hspan unless $hspan; 3612 $vspan = $old_vspan unless $vspan; 3613 3614 $self->removeCellSpan($cell); 3615 my $row = $cell->parent('table:table-row'); 3616 $table = $row->parent('table:table') unless $table; 3617 my $vpos = $row->getLocalPosition; 3618 my $hpos = $cell->getLocalPosition(qr'table:(covered-|)table-cell'); 3619 my $hend = $hpos + $hspan - 1; 3620 my $vend = $vpos + $vspan - 1; 3621 $cell->setAttribute('table:number-columns-spanned', $hspan); 3622 $cell->setAttribute('table:number-rows-spanned', $vspan); 3623 3624 ROW: for (my $i = $vpos ; $i <= $vend ; $i++) 3625 { 3626 my $cr = $self->getRow($table, $i) or last ROW; 3627 CELL: for (my $j = $hpos ; $j <= $hend ; $j++) 3628 { 3629 my $covered = $self->getCell($cr, $j) 3630 or last CELL; 3631 next CELL if $covered == $cell; 3632 3633 my @paras = $covered->children('text:p'); 3634 while (@paras) 3635 { 3636 my $p = shift @paras; 3637 $p->paste_last_child($cell) if 3638 (defined $p->text && $p->text ge ' '); 3639 } 3640 $self->removeCellSpan($covered); 3641 $covered->set_name('table:covered-table-cell'); 3642 } 3643 } 3644 return wantarray ? ($hspan, $vspan) : $hspan; 3645 } 3646 3647#----------------------------------------------------------------------------- 3648# get the content of a table element in a 2D array 3649 3650sub _get_row_content 3651 { 3652 my $self = shift; 3653 my $row = shift; 3654 3655 my @row_content = (); 3656 foreach my $cell ($row->children('table:table-cell')) 3657 { 3658 push @row_content, $self->getText($cell); 3659 } 3660 return @row_content; 3661 } 3662 3663sub getTableText 3664 { 3665 my $self = shift; 3666 my $table = $self->getTable(shift); 3667 3668 return undef unless $table; 3669 3670 my @table_content = (); 3671 my $headers = $table->getFirstChild('table:table-header-rows'); 3672 if ($headers) 3673 { 3674 push @table_content, [ $self->_get_row_content($_) ] 3675 for ($headers->children('table:table-row')); 3676 } 3677 push @table_content, [ $self->_get_row_content($_) ] 3678 for ($table->children('table:table-row')); 3679 3680 if (wantarray) 3681 { 3682 return @table_content; 3683 } 3684 else 3685 { 3686 my $delimiter = $self->{'field_separator'} || ''; 3687 my $line_break = $self->{'line_separator'} || ''; 3688 my @list = (); 3689 foreach my $row (@table_content) 3690 { 3691 push @list, join($delimiter, @{$row}); 3692 } 3693 return join $line_break, @list; 3694 } 3695 } 3696 3697#----------------------------------------------------------------------------- 3698# get table element selected by number 3699 3700sub getTable 3701 { 3702 my $self = shift; 3703 my $table = shift; 3704 my $length = shift; 3705 my $width = shift; 3706 my $context = shift; 3707 3708 if (ref $length) 3709 { 3710 $context = $length; 3711 $length = undef; 3712 $width = undef; 3713 } 3714 elsif (ref $width) 3715 { 3716 $context = $width; 3717 $width = undef; 3718 $length = undef; 3719 } 3720 3721 return undef unless defined $table; 3722 3723 my $t = undef; 3724 if (ref $table) 3725 { 3726 if ($table->isTable) 3727 { 3728 $t = $table; 3729 } 3730 else 3731 { 3732 warn "[" . __PACKAGE__ . "::getTable] " . 3733 "Non table object\n"; 3734 return undef; 3735 } 3736 } 3737 else # retrieve table by number or name 3738 { 3739 if (($table =~ /^\d*$/) || ($table =~ /^[\d+-]\d+$/)) 3740 { 3741 $t = $self->getElement 3742 ('//table:table', $table, $context); 3743 } 3744 unless ($t) 3745 { 3746 my $n = $self->inputTextConversion($table); 3747 $t = $self->getNodeByXPath 3748 ( 3749 "//table:table[\@table:name=\"$n\"]" 3750 ); 3751 } 3752 } 3753 return undef unless $t; 3754 if ( 3755 $length || 3756 ( 3757 $self->{'expand_tables'} && 3758 ($self->{'expand_tables'} eq 'on') 3759 ) 3760 ) 3761 { 3762 $length = 'full' if ($length && ($length eq 'normalize')); 3763 return $self->_expand_table($t, $length, $width); 3764 } 3765 return wantarray ? $self->getTableSize($t) : $t; 3766 } 3767 3768#----------------------------------------------------------------------------- 3769 3770sub getTableByName 3771 { 3772 my $self = shift; 3773 my $name = $self->inputTextConversion(shift); 3774 my $table = $self->getNodeByXPath 3775 ("//table:table[\@table:name=\"$name\"]"); 3776 return $self->getTable($table, @_); 3777 } 3778 3779#----------------------------------------------------------------------------- 3780# user-controlled spreadsheet expansion 3781 3782sub normalizeSheet 3783 { 3784 my $self = shift; 3785 my $table = shift; 3786 my $length = shift; 3787 my $width = shift; 3788 my $context = shift; 3789 unless (ref $table) 3790 { 3791 if ($table =~ /^\d*$/) 3792 { 3793 $table = $self->getElement 3794 ('//table:table', $table, $context); 3795 } 3796 else 3797 { 3798 my $n = $self->inputTextConversion($table); 3799 $table = $self->getNodeByXPath 3800 ( 3801 "//table:table[\@table:name=\"$n\"]", 3802 $context 3803 ); 3804 } 3805 } 3806 3807 unless ((ref $table) && $table->isTable) 3808 { 3809 warn "[" . __PACKAGE__ . "::normalizeSheet] " . 3810 "Missing sheet\n"; 3811 return undef; 3812 } 3813 return $self->_expand_table($table, $length, $width, @_); 3814 } 3815 3816sub normalizeSheets 3817 { 3818 my $self = shift; 3819 my $length = shift; 3820 my $width = shift; 3821 my @sheets = $self->getTableList; 3822 my $count = 0; 3823 foreach my $sheet (@sheets) 3824 { 3825 $self->normalizeSheet($sheet, $length, $width, @_); 3826 $count++; 3827 } 3828 return $count; 3829 } 3830 3831#----------------------------------------------------------------------------- 3832# activate/deactivate and parametrize automatic spreadsheet expansion 3833 3834sub autoSheetNormalizationOn 3835 { 3836 my $self = shift; 3837 my $length = shift || $self->{'max_rows'}; 3838 my $width = shift || $self->{'max_cols'}; 3839 3840 $self->{'expand_tables'} = 'on'; 3841 $self->{'max_rows'} = $length; 3842 $self->{'max_cols'} = $width; 3843 3844 return 'on'; 3845 } 3846 3847sub autoSheetNormalizationOff 3848 { 3849 my $self = shift; 3850 my $length = shift || $self->{'max_rows'}; 3851 my $width = shift || $self->{'max_cols'}; 3852 3853 $self->{'expand_tables'} = 'no'; 3854 $self->{'max_rows'} = $length; 3855 $self->{'max_cols'} = $width; 3856 3857 return 'no'; 3858 } 3859 3860#----------------------------------------------------------------------------- 3861# common code for insertTable and appendTable 3862 3863sub _build_table 3864 { 3865 my $self = shift; 3866 my $table = shift; 3867 my $rows = shift || $self->{'max_rows'} || 1; 3868 my $cols = shift || $self->{'max_cols'} || 1; 3869 my %opt = 3870 ( 3871 'cell-type' => 'string', 3872 'text-style' => 'Table Contents', 3873 @_ 3874 ); 3875 3876 $rows = $self->{'max_rows'} unless $rows; 3877 $cols = $self->{'max_cols'} unless $cols; 3878 3879 my $col_proto = $self->createElement('table:table-column'); 3880 $self->setAttribute 3881 ($col_proto, 'table:style-name', $opt{'column-style'}) 3882 if $opt{'column-style'}; 3883 $col_proto->paste_first_child($table); 3884 $col_proto->replicateNode($cols - 1, 'after'); 3885 3886 my $row_proto = $self->createElement('table:table-row'); 3887 my $cell_proto = $self->createElement('table:table-cell'); 3888 $self->cellValueType($cell_proto, $opt{'cell-type'}); 3889 $self->cellStyle($cell_proto, $opt{'cell-style'}); 3890 3891 if ($opt{'paragraphs'}) 3892 { 3893 my $para_proto = $self->createElement('text:p'); 3894 $self->setAttribute 3895 ($para_proto, 'text:style-name', $opt{'text-style'}) 3896 if $opt{'text-style'}; 3897 $para_proto->paste_last_child($cell_proto); 3898 } 3899 3900 $cell_proto->paste_first_child($row_proto); 3901 $cell_proto->replicateNode($cols - 1, 'after'); 3902 3903 $row_proto->paste_last_child($table); 3904 $row_proto->replicateNode($rows - 1, 'after'); 3905 3906 return $table; 3907 } 3908 3909#----------------------------------------------------------------------------- 3910# create a new table and append it to the end of the document body (default), 3911# or attach it as a new child of a given element 3912 3913sub appendTable 3914 { 3915 my $self = shift; 3916 my $name = shift; 3917 my $rows = shift || $self->{'max_rows'} || 1; 3918 my $cols = shift || $self->{'max_cols'} || 1; 3919 my %opt = 3920 ( 3921 'attachment' => $self->{'body'}, 3922 'table-style' => $name, 3923 @_ 3924 ); 3925 3926 if ($self->getTable($name, $self->{'xpath'})) 3927 { 3928 warn "[" . __PACKAGE__ . "::appendTable] " . 3929 "Table $name exists\n"; 3930 return undef; 3931 } 3932 3933 my $table = $self->appendElement 3934 ( 3935 $opt{'attachment'}, 'table:table', 3936 attribute => 3937 { 3938 'table:name' => 3939 $name, 3940 'table:style-name' => 3941 $opt{'table-style'} 3942 } 3943 ) 3944 or return undef; 3945 3946 return $self->_build_table($table, $rows, $cols, %opt); 3947 } 3948 3949#----------------------------------------------------------------------------- 3950 3951sub insertTable 3952 { 3953 my $self = shift; 3954 my $path = shift; 3955 my $pos = ref $path ? undef : shift; 3956 my $name = shift; 3957 my $rows = shift || $self->{'max_rows'} || 1; 3958 my $cols = shift || $self->{'max_cols'} || 1; 3959 my %opt = 3960 ( 3961 'table-style' => $name, 3962 @_ 3963 ); 3964 my $posnode = $self->getElement($path, $pos, $opt{'context'}) 3965 or return undef; 3966 3967 if ($self->getTable($name, $self->{'xpath'})) 3968 { 3969 warn "[" . __PACKAGE__ . "::insertTable] " . 3970 "Table $name exists\n"; 3971 return undef; 3972 } 3973 3974 my $table = $self->insertElement 3975 ( 3976 $posnode, 'table:table', 3977 attribute => 3978 { 3979 'table:name' => 3980 $name, 3981 'table:style-name' => 3982 $opt{'table-style'} 3983 }, 3984 %opt 3985 ) 3986 or return undef; 3987 3988 return $self->_build_table($table, $rows, $cols, %opt); 3989 } 3990 3991#----------------------------------------------------------------------------- 3992 3993sub renameTable 3994 { 3995 my $self = shift; 3996 my $table = $self->getTable(shift) or return undef; 3997 my $newname = shift; 3998 3999 if ($self->getTable($newname, $self->{'xpath'})) 4000 { 4001 warn "[" . __PACKAGE__ . "::renameTable] " . 4002 "Table name $newname already in use\n"; 4003 return undef; 4004 } 4005 return $self->setAttribute($table, 'table:name' => $newname); 4006 } 4007 4008#----------------------------------------------------------------------------- 4009 4010sub tableName 4011 { 4012 my $self = shift; 4013 my $table = $self->getTable(shift) or return undef; 4014 my $newname = shift; 4015 if (ref $newname) 4016 { 4017 unshift @_, $newname; $newname = undef; 4018 } 4019 $self->renameTable($table, $newname, @_) if $newname; 4020 return $self->getAttribute($table, 'table:name', @_); 4021 } 4022 4023#----------------------------------------------------------------------------- 4024 4025sub tableStyle 4026 { 4027 my $self = shift; 4028 my $table = $self->getTable(shift) or return undef; 4029 my $newstyle = shift; 4030 if (ref $newstyle) 4031 { 4032 unshift @_, $newstyle; $newstyle = undef; 4033 } 4034 4035 return defined $newstyle ? 4036 $self->setAttribute 4037 ($table, 'table:style-name' => $newstyle, @_) : 4038 $self->getAttribute 4039 ($table, 'table:style-name', @_); 4040 } 4041 4042#----------------------------------------------------------------------------- 4043# replicates a column in a normalized table 4044 4045sub insertTableColumn 4046 { 4047 my $self = shift; 4048 my $table = shift; 4049 my $col_num = shift; 4050 my %options = 4051 ( 4052 position => 'before', 4053 @_ 4054 ); 4055 $table = $self->getTable($table, $options{'context'}) 4056 or return undef; 4057 my ($height, $width) = $self->getTableSize($table); 4058 unless ($col_num < $width) 4059 { 4060 warn "[" . __PACKAGE__ . "::replicateTableColumn] " . 4061 "Column number out of range\n"; 4062 return undef; 4063 } 4064 $self->_expand_columns($table, $width); 4065 my $column = $table->child($col_num, 'table:table-column'); 4066 my $new_cell = undef; 4067 if ($column) 4068 { 4069 my $new_column = $column->copy; 4070 $new_column->paste($options{position}, $column); 4071 } 4072 my @rows = (); 4073 my $header = $table->first_child('table:table-header-rows'); 4074 @rows = $header->children('table:table-row') if $header; 4075 push @rows, $self->getTableRows($table); 4076 foreach my $row (@rows) 4077 { 4078 my $cell = $row->selectChildElement 4079 ('table:(covered-|)table-cell', $col_num) 4080 or next; 4081 $new_cell = $cell->copy; 4082 $new_cell->paste($options{'position'}, $cell); 4083 } 4084 return $column || $new_cell; 4085 } 4086 4087#----------------------------------------------------------------------------- 4088# delete a column in a table 4089 4090sub deleteTableColumn 4091 { 4092 my $self = shift; 4093 my $p1 = shift; 4094 my $col_num = shift; 4095 my $table = undef; 4096 if (ref $p1 && $p1->isTableColumn) 4097 { 4098 $table = $p1->parent; 4099 $col_num = $p1->getLocalPosition; 4100 } 4101 else 4102 { 4103 $table = $p1; 4104 } 4105 $table = $self->getTable($table); 4106 unless ($table) 4107 { 4108 warn "[" . __PACKAGE__ . "::deleteTableColumn] " . 4109 "Unknown table\n"; 4110 return undef; 4111 } 4112 my ($height, $width) = $self->getTableSize($table); 4113 unless (defined $col_num) 4114 { 4115 warn "[" . __PACKAGE__ . "::deleteTableColumn] " . 4116 "Missing column position\n"; 4117 return undef; 4118 } 4119 $self->_expand_columns($table, $width); 4120 my $column = $table->child($col_num, 'table:table-column'); 4121 $column->delete if $column; 4122 my @rows = (); 4123 my $header = $table->first_child('table:table-header-rows'); 4124 @rows = $header->children('table:table-row') if $header; 4125 push @rows, $self->getTableRows($table); 4126 foreach my $row (@rows) 4127 { 4128 my $cell = $row->selectChildElement 4129 ('table:(covered-|)table-cell', $col_num) 4130 or next; 4131 $cell->delete; 4132 } 4133 return 1; 4134 } 4135 4136#----------------------------------------------------------------------------- 4137# replicates a row in a table 4138 4139sub replicateTableRow 4140 { 4141 my $self = shift; 4142 my $p1 = shift; 4143 my $table = undef; 4144 my $row = undef; 4145 my $line = undef; 4146 4147 if (ref $p1 && $p1->isTableRow) 4148 { 4149 $row = $p1; 4150 } 4151 else 4152 { 4153 $line = shift; 4154 } 4155 my %options = 4156 ( 4157 position => 'after', 4158 @_ 4159 ); 4160 if (defined $line) 4161 { 4162 $row = $self->getTableRow($p1, $line, $options{'context'}) 4163 or return undef; 4164 } 4165 4166 return $self->replicateElement($row, $row, %options); 4167 } 4168 4169#----------------------------------------------------------------------------- 4170# replicate a row and insert the clone before (default) or after the prototype 4171 4172sub insertTableRow 4173 { 4174 my $self = shift; 4175 my $p1 = shift; 4176 my $row = undef; 4177 my $line = undef; 4178 if (ref $p1) 4179 { 4180 if ($p1->isTableRow) 4181 { $row = $p1; } 4182 else 4183 { 4184 $line = shift; 4185 $row = $self->getTableRow($p1, $line); 4186 } 4187 } 4188 else 4189 { 4190 $row = $self->getTableRow($p1, shift); 4191 } 4192 return undef unless $row; 4193 4194 my %options = 4195 ( 4196 position => 'before', 4197 @_ 4198 ); 4199 return $self->replicateTableRow($row, %options); 4200 } 4201 4202#----------------------------------------------------------------------------- 4203# append a new row (replicating the last existing one) to a table 4204 4205sub appendTableRow 4206 { 4207 my $self = shift; 4208 my $table = shift; 4209 return $self->replicateTableRow($table, -1, position => 'after', @_); 4210 } 4211 4212#----------------------------------------------------------------------------- 4213# delete a given table row 4214 4215sub deleteTableRow 4216 { 4217 my $self = shift; 4218 my $row = $self->getTableRow(@_) or return undef; 4219 return $self->removeElement($row); 4220 } 4221 4222#----------------------------------------------------------------------------- 4223# update the user field references according to the internal value 4224 4225sub updateUserFieldReferences 4226 { 4227 my $self = shift; 4228 my $fd = shift or return undef; 4229 my $context = shift; 4230 my $field_decl = undef; 4231 my $name = undef; 4232 if (ref $fd) 4233 { 4234 $name = $self->getAttribute($fd, 'text:name'); 4235 $field_decl = $fd; 4236 } 4237 else 4238 { 4239 $field_decl= $self->getUserField($fd, $context); 4240 $name = $fd; 4241 } 4242 unless ($field_decl && $name) 4243 { 4244 warn "[" . __PACKAGE__ . "::updateUserFieldReferences] " . 4245 "Unknown or bad user field\n"; 4246 return undef; 4247 } 4248 my @fields = $self->selectNodesByXPath 4249 ("//text:user-field-get[\@text:name=\"$name\"]", $context); 4250 my $content = $self->userFieldValue($field_decl) || ""; 4251 my $count = 0; 4252 foreach my $field (@fields) 4253 { 4254 $self->setText($field, $content); 4255 $count++; 4256 } 4257 return $count; 4258 } 4259 4260#----------------------------------------------------------------------------- 4261# get user field references 4262 4263sub getUserFieldReferences 4264 { 4265 my $self = shift; 4266 my $name = $self->inputTextConversion(shift); 4267 my $xp = undef; 4268 my @list = (); 4269 4270 $xp = (defined $name && $name gt "") ? 4271 "//text:user-field-get[\@text:name=\"$name\"]" : 4272 "//text:user-field-get"; 4273 @list = $self->selectNodesByXPath($xp, @_); 4274 $xp = (defined $name && $name gt "") ? 4275 "//text:user-field-input[\@text:name=\"$name\"]" : 4276 "//text:user-field-input"; 4277 push @list, $self->selectNodesByXPath($xp, @_); 4278 4279 return @list; 4280 } 4281 4282#----------------------------------------------------------------------------- 4283 4284 4285#----------------------------------------------------------------------------- 4286# create a new paragraph 4287 4288sub createParagraph 4289 { 4290 my $self = shift; 4291 my $text = shift; 4292 my $style = shift || "Standard"; 4293 4294 my $p = OpenOffice::OODoc::XPath::new_element('text:p'); 4295 if (defined $text) 4296 { 4297 $self->SUPER::setText($p, $text); 4298 } 4299 $self->setAttribute($p, 'text:style-name' => $style); 4300 return $p; 4301 } 4302 4303#----------------------------------------------------------------------------- 4304# inserts a flat text string within a given text element 4305 4306sub insertString 4307 { 4308 my $self = shift; 4309 my $path = shift; 4310 my $pos = ref $path ? undef : shift; 4311 my $element = $self->getElement($path, $pos) or return undef; 4312 my $text = shift; 4313 my $offset = shift; 4314 return $element->insertTextChild($text, $offset); 4315 } 4316 4317#----------------------------------------------------------------------------- 4318# add a new or existing text at the end of the document 4319 4320sub appendText 4321 { 4322 my $self = shift; 4323 my $name = shift; 4324 my %opt = @_; 4325 4326 my $attachment = $opt{'attachment'} || $self->{'body'}; 4327 $opt{'attribute'} = $opt{'attributes'} unless ($opt{'attribute'}); 4328 $opt{'attribute'}{'text:style-name'} = $opt{'style'} 4329 if $opt{'style'}; 4330 unless ((ref $name) || $opt{'attribute'}{'text:style-name'}) 4331 { 4332 $opt{'attribute'}{'text:style-name'} = 4333 $self->{'paragraph_style'}; 4334 } 4335 4336 delete $opt{'attachment'}; 4337 delete $opt{'style'}; 4338 return $self->appendElement($attachment, $name, %opt); 4339 } 4340 4341#----------------------------------------------------------------------------- 4342# insert a new or existing text element before or after an given element 4343 4344sub insertText 4345 { 4346 my $self = shift; 4347 my $path = shift; 4348 my $pos = (ref $path) ? undef : shift; 4349 my $name = shift; 4350 my %opt = @_ ; 4351 4352 $opt{'attribute'}{'text:style-name'} = $opt{'style'} if $opt{'style'}; 4353 4354 return (ref $path) ? 4355 $self->insertElement($path, $name, %opt) : 4356 $self->insertElement($path, $pos, $name, %opt); 4357 } 4358 4359#----------------------------------------------------------------------------- 4360# create and add a new paragraph at the end of the document 4361 4362sub appendParagraph 4363 { 4364 my $self = shift; 4365 my %opt = 4366 ( 4367 style => $self->{'paragraph_style'}, 4368 @_ 4369 ); 4370 4371 my $paragraph = $self->createParagraph($opt{'text'}, $opt{'style'}); 4372 4373 my $attachment = $opt{'attachment'} || $self->{'body'}; 4374 $paragraph->paste_last_child($attachment); 4375 4376 return $paragraph; 4377 } 4378 4379#----------------------------------------------------------------------------- 4380# add a new heading at the end of the document 4381 4382sub appendHeading 4383 { 4384 my $self = shift; 4385 my %opt = 4386 ( 4387 style => $self->{'heading_style'}, 4388 level => '1', 4389 @_ 4390 ); 4391 4392 $opt{'attribute'}{$self->{'level_attr'}} = $opt{'level'}; 4393 4394 return $self->appendText('text:h', %opt); 4395 } 4396 4397#----------------------------------------------------------------------------- 4398# insert a new paragraph at a given position 4399 4400sub insertParagraph 4401 { 4402 my $self = shift; 4403 my $path = shift; 4404 my $pos = (ref $path) ? undef : shift; 4405 my %opt = 4406 ( 4407 style => $self->{'paragraph_style'}, 4408 @_ 4409 ); 4410 4411 return (ref $path) ? 4412 $self->insertText($path, 'text:p', %opt) : 4413 $self->insertText($path, $pos, 'text:p', %opt); 4414 } 4415 4416#----------------------------------------------------------------------------- 4417# insert a new heading at a given position 4418 4419sub insertHeading 4420 { 4421 my $self = shift; 4422 my $path = shift; 4423 my $pos = (ref $path) ? undef : shift; 4424 my %opt = 4425 ( 4426 style => $self->{'heading_style'}, 4427 level => '1', 4428 @_ 4429 ); 4430 4431 $opt{'attribute'}{$self->{'level_attr'}} = $opt{'level'}; 4432 4433 return (ref $path) ? 4434 $self->insertText($path, 'text:h', %opt) : 4435 $self->insertText($path, $pos, 'text:h', %opt); 4436 } 4437 4438#----------------------------------------------------------------------------- 4439# remove the paragraph element at a given position 4440 4441sub removeParagraph 4442 { 4443 my $self = shift; 4444 my $pos = shift; 4445 return $self->removeElement($pos) if (ref $pos); 4446 return $self->removeElement('//text:p', $pos); 4447 } 4448 4449#----------------------------------------------------------------------------- 4450# remove the heading element at a given position 4451 4452sub removeHeading 4453 { 4454 my $self = shift; 4455 my $element = $self->getHeading(@_); 4456 return $self->removeElement($element); 4457 } 4458 4459#----------------------------------------------------------------------------- 4460 4461sub textStyle 4462 { 4463 my $self = shift; 4464 my $path = shift; 4465 my $pos = (ref $path) ? undef : shift; 4466 my $element = $self->getElement($path, $pos) or return undef; 4467 my $newstyle = shift; 4468 4469 if (ref $newstyle) 4470 { 4471 $newstyle = $self->getAttribute($newstyle, 'style:name'); 4472 unless ($newstyle) 4473 { 4474 warn "[" . __PACKAGE__ . "::textStyle] " . 4475 "Bad text style\n"; 4476 return undef; 4477 } 4478 } 4479 4480 my $expression = shift; 4481 if (defined $expression) 4482 { 4483 return $self->setSpan($element, $expression, $newstyle); 4484 } 4485 4486 if ($element->isListItem) 4487 { 4488 return defined $newstyle ? 4489 $self->setItemStyle($element) : 4490 $self->getItemStyle($element); 4491 } 4492 else 4493 { 4494 return defined $newstyle ? 4495 $self->setAttribute 4496 ($element, 'text:style-name' => $newstyle) : 4497 $self->getAttribute($element, 'text:style-name'); 4498 } 4499 } 4500 4501#----------------------------------------------------------------------------- 4502package OpenOffice::OODoc::Element; 4503#----------------------------------------------------------------------------- 4504# text element type detection (add-in for OpenOffice::OODoc::Element) 4505 4506BEGIN { 4507 *headerLevel = *headingLevel; 4508 *isHeader = *isHeading; 4509 } 4510 4511sub isOrderedList 4512 { 4513 my $element = shift; 4514 return $element->hasTag('text:ordered-list'); 4515 } 4516 4517sub isUnorderedList 4518 { 4519 my $element = shift; 4520 return $element->hasTag('text:unordered-list'); 4521 } 4522 4523sub isItemList 4524 { 4525 my $element = shift; 4526 my $name = $element->getName; 4527 return ($name =~ /^text:.*list$/) ? 1 : undef; 4528 } 4529 4530sub isListItem 4531 { 4532 my $element = shift; 4533 return $element->hasTag('text:list-item'); 4534 } 4535 4536sub isParagraph 4537 { 4538 my $element = shift; 4539 return $element->hasTag('text:p'); 4540 } 4541 4542sub isHeading 4543 { 4544 my $element = shift; 4545 return $element->hasTag('text:h'); 4546 } 4547 4548sub headingLevel 4549 { 4550 my $element = shift; 4551 my $level = $element->getAttribute('text:outline-level'); 4552 return defined $level ? $level : $element->getAttribute('text:level'); 4553 } 4554 4555sub isTable 4556 { 4557 my $element = shift; 4558 return $element->hasTag('table:table'); 4559 } 4560 4561sub isTableRow 4562 { 4563 my $element = shift; 4564 return $element->hasTag('table:table-row'); 4565 } 4566 4567sub isTableColumn 4568 { 4569 my $element = shift; 4570 return $element->hasTag('table:table-column'); 4571 } 4572 4573sub isTableCell 4574 { 4575 my $element = shift; 4576 return $element->hasTag('table:table-cell'); 4577 } 4578 4579sub isCovered 4580 { 4581 my $element = shift; 4582 my $name = $element->getName; 4583 return ($name && ($name =~ /covered/)) ? 1 : undef; 4584 } 4585 4586sub isSpan 4587 { 4588 my $element = shift; 4589 return $element->hasTag('text:span'); 4590 } 4591 4592sub isHyperlink 4593 { 4594 my $element = shift; 4595 return $element->hasTag('text:a'); 4596 } 4597 4598sub checkNoteClass 4599 { 4600 my ($element, $class) = @_; 4601 my $name = $element->getName; 4602 return 1 if $name eq "text:$class"; 4603 return undef unless $name eq 'text:note'; 4604 my $elt_class = $element->att('text:note-class'); 4605 return ($elt_class && ($elt_class eq $class)); 4606 } 4607 4608sub getNoteClass 4609 { 4610 my $element = shift; 4611 return undef unless $element->isNote; 4612 my $class = $element->att('text:note-class'); 4613 return $class if $class; 4614 my $tagname = $element->getName; 4615 $tagname =~ /^text:(endnote|footnote)$/; 4616 return $1; 4617 } 4618 4619sub isEndnote 4620 { 4621 my $element = shift; 4622 return $element->checkNoteClass('endnote'); 4623 } 4624 4625sub isFootnote 4626 { 4627 my $element = shift; 4628 return $element->checkNoteClass('footnote'); 4629 } 4630 4631sub checkNoteBodyClass 4632 { 4633 my ($element, $class) = @_; 4634 my $name = $element->getName; 4635 return ($name eq "text:$class-body") ? 4636 1 : $element->parent->checkNoteClass($class); 4637 } 4638 4639sub checkNoteCitationClass 4640 { 4641 my ($element, $class) = @_; 4642 my $name = $element->getName; 4643 return ($name eq "text:$class-citation") ? 4644 1 : $element->parent->checkNoteClass($class); 4645 } 4646 4647sub isFootnoteCitation 4648 { 4649 my $element = shift; 4650 return $element->checkNoteCitationClass('footnote'); 4651 } 4652 4653sub isEndnoteCitation 4654 { 4655 my $element = shift; 4656 return $element->checkNoteCitationClass('endnote'); 4657 } 4658 4659sub isEndnoteBody 4660 { 4661 my $element = shift; 4662 return $element->checkNoteBodyClass('endnote'); 4663 } 4664 4665sub isFootnoteBody 4666 { 4667 my $element = shift; 4668 return $element->checkNoteBodyClass('footnote'); 4669 } 4670 4671sub isNoteBody 4672 { 4673 my $element = shift; 4674 my $tag = $element->name; 4675 return $tag =~ /^text:(|foot|end)note-body$/; 4676 } 4677 4678sub isNoteCitation 4679 { 4680 my $element = shift; 4681 my $tag = $element->name; 4682 return $tag =~ /^text:(|foot|end)note-citation$/; 4683 } 4684 4685sub isNote 4686 { 4687 my $element = shift; 4688 my $tag = $element->name; 4689 return $tag =~ /^text:(|foot|end)note$/; 4690 } 4691 4692sub isSequenceDeclarations 4693 { 4694 my $element = shift; 4695 return $element->hasTag('text:sequence-decls'); 4696 } 4697 4698sub isBibliographyMark 4699 { 4700 my $element = shift; 4701 return $element->hasTag('text:bibliography-mark'); 4702 } 4703 4704sub isDrawPage 4705 { 4706 my $element = shift; 4707 return $element->hasTag('draw:page'); 4708 } 4709 4710sub isSection 4711 { 4712 my $element = shift; 4713 return $element->hasTag('text:section'); 4714 } 4715 4716sub isTextBox 4717 { 4718 my $element = shift; 4719 my $name = $element->getName or return undef; 4720 if ($name eq 'draw:frame') 4721 { 4722 my $child = $element->first_child('draw:text-box'); 4723 return $child ? 1 : undef; 4724 } 4725 else 4726 { 4727 return ($name eq 'draw:text-box') ? 1 : undef; 4728 } 4729 } 4730 4731sub textId 4732 { 4733 my $element = shift; 4734 my $id = shift; 4735 my $id_attr = 'text:id'; 4736 if (defined $id) 4737 { 4738 $element->set_att($id_attr => $id); 4739 } 4740 return $element->att($id_attr); 4741 } 4742 4743#----------------------------------------------------------------------------- 47441; 4745