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