1#-----------------------------------------------------------------------------
2#
3#	$Id : XPath.pm 2.237 2010-07-12 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::XPath;
11use	5.008_000;
12use     strict;
13our	$VERSION	= '2.237';
14use	XML::Twig	3.32;
15use	Encode;
16require	Exporter;
17our	@ISA	= qw    ( Exporter );
18our	@EXPORT	= qw
19                        (
20                        TRUE FALSE is_true is_false
21                        odfLocaltime odfTimelocal
22                        );
23
24#------------------------------------------------------------------------------
25
26use constant
27        {
28        TRUE    => 1,
29        FALSE   => 0
30        };
31
32sub     is_true
33        {
34        my $arg = shift         or return FALSE;
35        $arg    = lc $arg;
36        return ($arg eq '1' || $arg eq 'true' || $arg eq 'on') ? TRUE : FALSE;
37        }
38
39sub     is_not_true
40        {
41        return is_true(shift) ? FALSE : TRUE;
42        }
43
44#------------------------------------------------------------------------------
45
46BEGIN	{
47	*dispose		= *DESTROY;
48	*update			= *save;
49	*getXMLContent		= *exportXMLContent;
50	*getContent		= *exportXMLContent;
51	*getChildElementByName	= *selectChildElementByName;
52	*getElementByIdentifier = *selectElementByIdentifier;
53	*blankSpaces		= *spaces;
54	*createSpaces		= *spaces;
55	*createTextNode         = *newTextNode;
56	*getFrame		= *getFrameElement;
57	*getUserFieldElement	= *getUserField;
58	*getVariableElement     = *getVariable;
59	*getNodeByXPath		= *selectNodeByXPath;
60	*getNodesByXPath	= *selectNodesByXPath;
61	*getElementList         = *selectNodesByXPath;
62	*isCalcDocument		= *isSpreadsheet;
63	*isDrawDocument		= *isDrawing;
64	*isImpressDocument	= *isPresentation;
65	*isWriterDocument	= *isText;
66	*odfVersion		= *openDocumentVersion;
67	}
68
69#------------------------------------------------------------------------------
70
71our %XMLNAMES	=			# OODoc root element names
72	(
73	'content'	=> 'office:document-content',
74	'styles'	=> 'office:document-styles',
75	'meta'		=> 'office:document-meta',
76	'manifest'	=> 'manifest:manifest',
77	'settings'	=> 'office:document-settings'
78	);
79
80					# characters to be escaped in XML
81our	$CHARS_TO_ESCAPE	= "\"<>'&";
82					# standard external character set
83our	$LOCAL_CHARSET		= 'utf8';
84					# standard ODF character set
85our	$OO_CHARSET		= 'utf8';
86                                        # default element identifier
87our     $ELT_ID                 = 'text:id';
88
89#------------------------------------------------------------------------------
90# basic conversion between internal & printable encodings
91
92sub	OpenOffice::OODoc::XPath::decode_text
93	{
94	return Encode::encode($LOCAL_CHARSET, shift);
95	}
96
97sub	OpenOffice::OODoc::XPath::encode_text
98	{
99	return Encode::decode($LOCAL_CHARSET, shift);
100	}
101
102#------------------------------------------------------------------------------
103# common date formatting functions
104
105sub	odfLocaltime
106	{
107	my $time = shift || time();
108	my @t = localtime($time);
109	return sprintf
110			(
111			"%04d-%02d-%02dT%02d:%02d:%02d",
112			$t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0]
113			);
114	}
115
116sub	odfTimelocal
117	{
118	require Time::Local;
119
120	my $ootime = shift;
121	return undef unless $ootime;
122	$ootime =~ /(\d*)-(\d*)-(\d*)T(\d*):(\d*):(\d*)/;
123	return Time::Local::timelocal($6, $5, $4, $3, $2 - 1, $1);
124	}
125
126#------------------------------------------------------------------------------
127# object coordinates, size, description control
128
129sub	setObjectCoordinates
130	{
131	my $self	= shift;
132	my $element	= shift	or return undef;
133	my ($x, $y)	= @_;
134	if ($x && ($x =~ /,/))	# X and Y are concatenated in a single string
135		{
136		$x =~ s/\s*//g;			# remove the spaces
137		$x =~ s/,(.*)//; $y = $1;	# split on the comma
138		}
139	$x = '0cm' unless $x; $y = '0cm' unless $y;
140	$x .= 'cm' unless $x =~ /[a-zA-Z]$/;
141	$y .= 'cm' unless $y =~ /[a-zA-Z]$/;
142	$self->setAttributes($element, 'svg:x' => $x, 'svg:y' => $y);
143	return wantarray ? ($x, $y) : ($x . ',' . $y);
144	}
145
146sub	getObjectCoordinates
147	{
148	my $self	= shift;
149	my $element	= shift	or return undef;
150	my $x		= $element->getAttribute('svg:x');
151	my $y		= $element->getAttribute('svg:y');
152	return undef unless defined $x and defined $y;
153	return wantarray ? ($x, $y) : ($x . ',' . $y);
154	}
155
156sub	setObjectSize
157	{
158	my $self	= shift;
159	my $element	= shift	or return undef;
160	my ($w, $h)	= @_;
161	if ($w && ($w =~ /,/))	# W and H are concatenated in a single string
162		{
163		$w =~ s/\s*//g;			# remove the spaces
164		$w =~ s/,(.*)//; $h = $1;	# split on the comma
165		}
166	$w = '0cm' unless $w; $h = '0cm' unless $h;
167	$w .= 'cm' unless $w =~ /[a-zA-Z]$/;
168	$h .= 'cm' unless $h =~ /[a-zA-Z]$/;
169	$self->setAttributes($element, 'svg:width' => $w, 'svg:height' => $h);
170	return wantarray ? ($w, $h) : ($w . ',' . $h);
171	}
172
173sub	getObjectSize
174	{
175	my $self	= shift;
176	my $element	= shift	or return undef;
177	my $w		= $element->getAttribute('svg:width');
178	my $h		= $element->getAttribute('svg:height');
179	return wantarray ? ($w, $h) : ($w . ',' . $h);
180	}
181
182sub	setObjectDescription
183	{
184	my $self	= shift;
185	my $element	= shift or return undef;
186	my $text	= shift;
187	my $desc	= $element->first_child('svg:desc');
188	unless ($desc)
189		{
190		$self->appendElement($element, 'svg:desc', text => $text)
191			if (defined $text);
192		}
193	else
194		{
195		if (defined $text)	{ $self->setText($desc, $text, @_);	}
196		else			{ $self->removeElement($desc, @_);	}
197		}
198	return $desc;
199	}
200
201sub	getObjectDescription
202	{
203	my $self	= shift;
204	my $element	= shift or return undef;
205	return $self->getXPathValue($element, 'svg:desc');
206	}
207
208sub     getObjectName
209        {
210	my $self	= shift;
211	my $element	= shift or return undef;
212	my $name	= shift;
213	my $attr        = $element->getPrefix() . ':name' ;
214        return $self->getAttribute($element, $attr);
215        }
216
217sub     setObjectName
218        {
219	my $self	= shift;
220	my $element	= shift or return undef;
221	my $name	= shift;
222	my $attr        = $element->getPrefix() . ':name' ;
223        return $self->setAttribute($element, $attr, @_);
224        }
225
226sub	objectName
227	{
228	my $self	= shift;
229	my $element	= shift or return undef;
230	my $name	= shift;
231	my $attr        = $element->getPrefix() . ':name' ;
232	return (defined $name) ?
233		$self->setAttribute($element, $attr => $name)	:
234		$self->getAttribute($element, $attr);
235	}
236
237#------------------------------------------------------------------------------
238# basic element creation
239
240sub	OpenOffice::OODoc::XPath::new_element
241	{
242	my $name	= shift		or return undef;
243	return undef if ref $name;
244	$name		=~ s/^\s+//;
245	$name		=~ s/\s+$//;
246	if ($name =~ /^</)	# create element from XML string
247		{
248		return OpenOffice::OODoc::Element->parse($name, @_);
249		}
250	else			# create element from name and optional data
251		{
252		return OpenOffice::OODoc::Element->new($name, @_);
253		}
254	}
255
256#------------------------------------------------------------------------------
257# text node creation
258
259sub	OpenOffice::OODoc::XPath::new_text_node
260	{
261	return OpenOffice::OODoc::XPath::new_element('#PCDATA', @_);
262	}
263
264#------------------------------------------------------------------------------
265# basic conversion between internal & printable encodings (object version)
266
267sub	inputTextConversion
268	{
269	my $self	= shift;
270	my $text	= shift;
271	return undef unless defined $text;
272	my $local_encoding = $self->{'local_encoding'} or return $text;
273	return Encode::decode($local_encoding, $text);
274	}
275
276sub	outputTextConversion
277	{
278	my $self	= shift;
279	my $text	= shift;
280	return undef unless defined $text;
281	my $local_encoding = $self->{'local_encoding'} or return $text;
282	return Encode::encode($local_encoding, $text);
283	}
284
285sub	localEncoding
286	{
287	my $self	= shift;
288	my $encoding	= shift;
289	$self->{'local_encoding'} = $encoding if $encoding;
290	return $self->{'local_encoding'} || '';
291	}
292
293sub	noLocalEncoding
294	{
295	my $self	= shift;
296	delete $self->{'local_encoding'};
297	return 1;
298	}
299
300#------------------------------------------------------------------------------
301# search/replace text processing routine
302# if $replace is a user-provided routine, it's called back with
303# the current argument stack, plus the substring found
304
305sub	_find_text
306	{
307	my $self	= shift;
308	my $text	= shift;
309	my $pattern	= $self->inputTextConversion(shift);
310	my $replace	= shift;
311
312	if (defined $pattern)
313	    {
314	    if (defined $replace)
315		{
316		if (ref $replace)
317		    {
318		    if ((ref $replace) eq 'CODE')
319		    	{
320			return undef
321			  unless
322			    (
323			    $text =~
324			    	s/($pattern)/
325				    	{
326					my $found = $1;
327					Encode::_utf8_on($found)
328						if Encode::is_utf8($text);
329					my $result = &$replace(@_, $found);
330					$result = $found
331						unless (defined $result);
332					$result;
333					}
334				/eg
335			    );
336			}
337		    else
338		    	{
339			return undef unless ($text =~ /$pattern/);
340			}
341		    }
342		else
343		    {
344		    my $r = $self->inputTextConversion($replace);
345		    return undef unless ($text =~ s/$pattern/$r/g);
346		    }
347		}
348	    else
349		{
350		return undef unless ($text =~ /$pattern/);
351		}
352	    }
353	return $text;
354	}
355
356#------------------------------------------------------------------------------
357# search/replace content in descendant nodes
358
359sub	_search_content
360	{
361	my $self	= shift;
362	my $node	= shift or return undef;
363	my $content	= undef;
364
365        if ($node->isTextNode)
366                {
367                my $text = $self->_find_text($node->text, @_);
368                if (defined $text)
369                        {
370                        $node->set_text($text);
371                        $content = $text;
372                        }
373                }
374        else
375                {
376	        foreach my $n ($node->getTextDescendants)
377		        {
378		        my $text = $self->_find_text($n->text, @_);
379		        if (defined $text)
380			        {
381			        $n->set_text($text);
382			        $content .= $text;
383			        }
384			}
385		}
386	return $content;
387	}
388
389#------------------------------------------------------------------------------
390# is this an OASIS Open Document or an OpenOffice 1.x Document ?
391
392sub	isOpenDocument
393	{
394	my $self	= shift;
395	my $root	= $self->getRootElement;
396	die __PACKAGE__ . " Missing root element\n" unless $root;
397	my $ns		= $root->att('xmlns:office');
398	return $ns && ($ns =~ /opendocument/) ? 1 : undef;
399	}
400
401sub	openDocumentVersion
402	{
403	my $self	= shift;
404	my $new_version	= shift;
405	my $root	= $self->getRootElement or return undef;
406	$root->set_att('office:version' => $new_version) if $new_version;
407	return $root->att('office:version');
408	}
409
410#------------------------------------------------------------------------------
411# document class check
412
413sub	isContent
414	{
415	my $self	= shift;
416	return ($self->contentClass()) ? 1 : undef;
417	}
418
419sub	isSpreadsheet
420	{
421	my $self	= shift;
422	return ($self->contentClass() eq 'spreadsheet') ? 1 : undef;
423	}
424sub	isPresentation
425	{
426	my $self	= shift;
427	return ($self->contentClass() eq 'presentation') ? 1 : undef;
428	}
429sub	isDrawing
430	{
431	my $self	= shift;
432	return ($self->contentClass() eq 'drawing') ? 1 : undef;
433	}
434sub	isText
435	{
436	my $self	= shift;
437	return ($self->contentClass() eq 'text') ? 1 : undef;
438	}
439
440#------------------------------------------------------------------------------
441
442sub     _get_container      # get a new OODoc::File container
443        {
444        require OpenOffice::OODoc::File;
445
446        my $doc         = shift;
447
448	return OpenOffice::OODoc::File->new
449				(
450				$doc->{'file'},
451				create		=> $doc->{'create'},
452				opendocument	=> $doc->{'opendocument'},
453				template_path	=> $doc->{'template_path'}
454				);
455        }
456
457sub     _get_flat_file          # get flat ODF content
458        {
459        my $doc         = shift;
460        my $source      = $doc->{'file'};
461	$doc->{'xpath'} = UNIVERSAL::isa($source, 'IO::File') ?
462			     $doc->{'twig'}->safe_parse($source)    :
463			     $doc->{'twig'}->safe_parsefile($source);
464        return $doc->{'path'};
465        }
466
467sub	new
468	{
469	my $caller	= shift;
470	my $class	= ref($caller) || $caller;
471	my $self	=
472		{
473		auto_style_path		=> '//office:automatic-styles',
474		master_style_path	=> '//office:master-styles',
475		named_style_path	=> '//office:styles',
476		image_container		=> 'draw:image',
477		image_xpath		=> '//draw:image',
478		image_fpath		=> '#Pictures/',
479		local_encoding		=>
480				$OpenOffice::OODoc::XPath::LOCAL_CHARSET,
481		@_
482		};
483
484	foreach my $optk (keys %$self)
485		{
486		next unless $self->{$optk};
487		my $v = lc $self->{$optk};
488		$self->{$optk} = 0 if ($v =~ /^false$|^off$/);
489		}
490
491	$self->{'container'} = $self->{'file'} if defined $self->{'file'};
492	$self->{'container'} = $self->{'archive'} if defined $self->{'archive'};
493	$self->{'part'} = $self->{'member'} if $self->{'member'};
494	$self->{'part'} = 'content' unless $self->{'part'};
495
496	unless ($self->{'element'})
497		{
498		my $m	= lc $self->{'part'};
499		if ($m =~ /(^.*)\..*/) { $m = $1; }
500		$self->{'element'} =
501		    $OpenOffice::OODoc::XPath::XMLNAMES{$m};
502		}
503					# create the XML::Twig
504	if 	(is_true($self->{'readable_XML'}))
505			{
506			$self->{'readable_XML'} = 'indented';
507			}
508	$self->{'element'} = $OpenOffice::OODoc::XPath::XMLNAMES{'content'}
509				unless $self->{'element'};
510	if ($self->{'element'})
511		{
512		$self->{'twig'} = XML::Twig->new
513			(
514			elt_class	=> "OpenOffice::OODoc::Element",
515			twig_roots	=>
516				{
517				$self->{'element'}	=> 1
518				},
519			pretty_print	=> $self->{'readable_XML'},
520			%{$self->{'twig_options'}}
521			);
522		}
523	else
524		{
525		$self->{'twig'} = XML::Twig->new
526			(
527			elt_class	=> "OpenOffice::OODoc::Element",
528			pretty_print	=> $self->{'readable_XML'},
529			%{$self->{'twig_options'}}
530			);
531		}
532
533	                                        # other OODoc::Xpath object
534	$self->{'container'} = $self->{'container'}->{'container'}
535	        if      (
536	                ref($self->{container})
537	                        &&
538	                $self->{'container'}->isa('OpenOffice::OODoc::XPath')
539                        );
540
541	if ($self->{'xml'})			# load from XML string
542		{
543		delete $self->{'container'};
544		delete $self->{'file'};
545		$self->{'xpath'} =
546			$self->{'twig'}->safe_parse($self->{'xml'});
547		delete $self->{'xml'};
548		}
549
550	elsif (defined $self->{'container'})
551		{
552		delete $self->{'file'};
553	 	                                # existing OODoc::File object
554	 	if
555	 	        (
556	 	        UNIVERSAL::isa($self->{'container'},
557	 	        'OpenOffice::OODoc::File')
558	 	        )
559	 	        {
560	 	        my $xml = $self->{'container'}->link($self);
561	 	        $self->{'xpath'} = $self->{'twig'}->safe_parse($xml);
562	 	        }
563	 	                                # source file or filehandle
564	 	else
565	 	        {
566	 	        $self->{'file'} = $self->{'container'};
567	 	        delete $self->{'container'};
568	 	        if	(
569	 	                $self->{'flat_xml'}
570					||
571			        (lc $self->{'file'}) =~ /\.xml$/
572			        )
573			        		# XML flat file
574			        {
575			        $self->{'xpath'} = _get_flat_file($self);
576			        }
577		        else
578			        {		# new OODoc::File object
579			        $self->{'container'} = _get_container($self);
580			        return undef unless $self->{'container'};
581			        delete $self->{'file'};
582			        my $xml = $self->{'container'}->link($self);
583			        $self->{'xpath'} =
584			                $self->{'twig'}->safe_parse($xml);
585			        }
586	 	        }
587		}
588
589	unless ($self->{'xpath'})
590		{
591		warn "[" . __PACKAGE__ . "::new] No ODF content\n";
592		return undef;
593		}
594						# XML content loaded & parsed
595	bless $self, $class;
596
597	$self->{'opendocument'} = $self->isOpenDocument;
598
599	if ($self->{'opendocument'})
600		{
601		$self->{'image_container'}	= 'draw:frame';
602		$self->{'image_xpath'}		= '//draw:frame';
603		$self->{'image_fpath'}		= 'Pictures/';
604		}
605
606	$self->{'member'} = $self->{'part'};		# for compatibility
607	$self->{'archive'} = $self->{'container'};	# for compatibility
608	$self->{'context'} = $self->getRoot;
609	$self->{'body'} = $self->getBody;
610
611	return $self;
612	}
613
614#------------------------------------------------------------------------------
615# destructor
616
617sub	DESTROY
618	{
619	my $self	= shift;
620
621	if ($self->{'body'})
622		{
623		$self->{'body'}->dispose();
624		}
625	delete $self->{'body'};
626	if ($self->{'context'})
627	        {
628	        $self->{'context'}->dispose();
629	        }
630	delete $self->{'context'};
631	if ($self->{'xpath'})
632		{
633		$self->{'xpath'}->dispose();
634		}
635	delete $self->{'xpath'};
636	if ($self->{'twig'})
637		{
638		$self->{'twig'}->dispose();
639		}
640	delete $self->{'twig'};
641	delete $self->{'xml'};
642	delete $self->{'content_class'};
643	delete $self->{'file'};
644	delete $self->{'container'};
645	delete $self->{'archive'};
646	delete $self->{'part'};
647	delete $self->{'twig_options'};
648	$self = {};
649	}
650
651#------------------------------------------------------------------------------
652# get a reference to the embedded XML parser for share
653
654sub	getXMLParser
655	{
656	warn	"[" . __PACKAGE__ . "::getXMLParser] No longer implemented\n";
657	return undef;
658	}
659
660#------------------------------------------------------------------------------
661# make the changes persistent in an OpenOffice.org file
662
663sub	save
664	{
665	my $self	= shift;
666	my $target	= shift;
667
668	my $filename	= ($target) ? $target : $self->{'file'};
669	my $archive	= $self->{'container'};
670	unless ($archive)
671		{
672		return undef if is_true($self->{'read_only'});
673
674		if ($filename)
675			{
676			open my $fh, ">:utf8", $filename;
677			$self->exportXMLContent($fh);
678			close $fh;
679			return $filename;
680			}
681		else
682			{
683			warn "[" . __PACKAGE__ . "::save] Missing file\n";
684			return undef;
685			}
686		}
687	$filename	= $archive->{'source_file'}	unless $filename;
688	unless ($filename)
689		{
690		warn "[" . __PACKAGE__ . "::save] No target file\n";
691		return undef;
692		}
693
694	unless ($self->{'part'})
695		{
696		warn "[" . __PACKAGE__ . "::save] Missing archive part name\n";
697		return undef;
698		}
699
700	my $result = $archive->save($filename);
701	return $result;
702	}
703
704#------------------------------------------------------------------------------
705# raw file import
706
707sub	raw_import
708	{
709	my $self	= shift;
710	if ($self->{'container'})
711		{
712		my $target	= shift;
713		unless ($target)
714			{
715			warn	"[" . __PACKAGE__ . "::raw_import] "	.
716				"No target member for import\n";
717			return undef;
718			}
719		$target =~ s/^#//;
720		return $self->{'container'}->raw_import($target, @_);
721		}
722	else
723		{
724		warn	"[" . __PACKAGE__ . "::raw_import] "	.
725			"No container for file import\n";
726		return undef;
727		}
728	}
729
730#------------------------------------------------------------------------------
731# raw file export
732
733sub	raw_export
734	{
735	my $self	= shift;
736	if ($self->{'container'})
737		{
738		my $source	= shift;
739		unless ($source)
740			{
741			warn	"[" . __PACKAGE__ . "::raw_import] "	.
742				"Missing source file name\n";
743			return undef;
744			}
745		$source =~ s/^#//;
746		return $self->{'container'}->raw_export($source, @_);
747		}
748	else
749		{
750		warn	"[" . __PACKAGE__ . "::raw_import] "	.
751			"No container for file export\n";
752		return undef;
753		}
754	}
755
756#------------------------------------------------------------------------------
757# exports the whole content of the document as an XML string
758
759sub	exportXMLContent
760	{
761	my $self	= shift;
762	my $target	= shift;
763	if ($target)
764		{
765		return $self->{'twig'}->print($target);
766		}
767	else
768		{
769		return $self->{'twig'}->sprint;
770		}
771	}
772
773#------------------------------------------------------------------------------
774# brute force tree reorganization
775
776sub	reorganize
777	{
778	warn "[" . __PACKAGE__ . "::reorganize] No longer implemented\n";
779	return undef;
780	}
781
782#------------------------------------------------------------------------------
783# returns the root of the XML document
784
785sub	getRoot
786	{
787	my $self	= shift;
788	return $self->{'xpath'}->root;
789	}
790
791#------------------------------------------------------------------------------
792# returns the name of the document part (content, styles, meta, ...)
793
794sub     getPartName
795        {
796        my $self        = shift;
797        my $name        = $self->getRoot->getName;
798        $name           =~ s/^office:document-//;
799        return $name;
800        }
801
802#------------------------------------------------------------------------------
803# returns the root element of the XML document
804
805sub	getRootElement
806	{
807	my $self	= shift;
808
809	my $root	= $self->{'xpath'}->root;
810	my $rootname	= $root->name() || '';
811	return ($rootname eq $self->{'element'})	?
812			$root				:
813			$root->first_child($self->{'element'});
814	}
815
816#------------------------------------------------------------------------------
817# get/set/reset the current search context
818
819sub	currentContext
820	{
821	my $self	= shift;
822	my $new_context	= shift;
823	$self->{'context'} = $new_context if (ref $new_context);
824	return $self->{'context'};
825	}
826
827sub	resetCurrentContext
828	{
829	my $self	= shift;
830	return $self->currentContext($self->getRoot);
831	}
832
833#------------------------------------------------------------------------------
834# returns the content class (text, spreadsheet, presentation, drawing)
835
836sub	contentClass
837	{
838	my $self	= shift;
839
840	my $content_class	=
841		$self->getRootElement->getAttribute('office:class');
842	return $content_class if $content_class;
843
844	my $body = $self->getBody	or return undef;
845	my $name = $body->name		or return undef;
846	$name =~ /(.*):(.*)/;
847	return $2;
848	}
849
850#------------------------------------------------------------------------------
851# element name check
852
853sub	getRootName
854	{
855	my $self	= shift;
856	return $self->getRootElement->name;
857	}
858
859#------------------------------------------------------------------------------
860# XML part type checks
861
862sub	isMeta
863	{
864	my $self	= shift;
865	return ($self->getRootName() eq $XMLNAMES{'meta'}) ? 1 : undef;
866	}
867
868sub	isStyles
869	{
870	my $self	= shift;
871	return ($self->getRootName() eq $XMLNAMES{'styles'}) ? 1 : undef;
872	}
873
874sub	isSettings
875	{
876	my $self	= shift;
877	return ($self->getRootName() eq $XMLNAMES{'settings'}) ? 1 : undef;
878	}
879
880#------------------------------------------------------------------------------
881# returns the document body element (if defined)
882
883sub	getBody
884	{
885	my $self	= shift;
886
887	return $self->{'body'} if ref $self->{'body'};
888
889	my $root = $self->getRoot;
890	if ($self->{'body_path'})
891		{
892		$self->{'body'} = $self->getElement
893		                        ($self->{'body_path'}, 0, $root);
894		return $self->{'body'};
895		}
896
897	my $office_body = $self->getElement('//office:body', 0, $root);
898
899	if ($office_body)
900		{
901		$self->{'body'} = $self->{'opendocument'} ?
902		    $office_body->selectChildElement
903			('office:(text|spreadsheet|presentation|drawing)')
904			:
905		    $office_body;
906		}
907	else
908		{
909		$self->{'body'} = $self->getRootElement->selectChildElement
910				(
911				'office:(body|meta|master-styles|settings)'
912				);
913		}
914
915	return $self->{'body'};
916	}
917
918#------------------------------------------------------------------------------
919# makes the current OODoc::XPath object share the same content as another one
920
921sub	cloneContent
922	{
923	my $self        = shift;
924	my $source	= shift;
925
926	unless ($source && $source->{'xpath'})
927		{
928		warn "[" . __PACKAGE__ . "::cloneContent] No valid source\n";
929		return undef;
930		}
931
932	$self->{'xpath'}	= $source->{'xpath'};
933	$self->{'begin'}	= $source->{'begin'};
934	$self->{'xml'}		= $source->{'xml'};
935	$self->{'end'}		= $source->{'end'};
936
937	return $self->getRoot;
938	}
939
940#------------------------------------------------------------------------------
941# exports an individual element as an XML string
942
943sub	exportXMLElement
944	{
945	my $self	= shift;
946	my $path	= shift;
947	my $element	=
948		(ref $path) ? $path : $self->getElement($path, shift);
949	unless (defined $element)
950	        {
951	        warn    "[" . __PACKAGE__ . "::exportXMLElement]] "     .
952	                "Missing element\n";
953	        return undef;
954	        }
955	return $element->sprint(@_);
956	}
957
958#------------------------------------------------------------------------------
959# exports the document body (if defined) as an XML string
960
961sub	exportXMLBody
962	{
963	my $self	= shift;
964
965	return	$self->exportXMLElement($self->getBody, @_);
966	}
967
968#------------------------------------------------------------------------------
969# gets the reference of an XML element identified by path & position
970# for subsequent processing
971
972sub	getElement
973	{
974	my $self	= shift;
975	my $path	= shift;
976	return undef	unless $path;
977	if (ref $path)
978		{
979		return	$path->isElementNode ? $path : undef;
980		}
981	my $pos		= shift || 0;
982	my $context	= shift || $self->{'context'} || $self->getRoot;
983	if (defined $pos && (($pos =~ /^\d*$/) || ($pos =~ /^[\d+-]\d+$/)))
984		{
985		my $node = $self->selectNodeByXPath($context, $path, $pos);
986		return	$node && $node->isElementNode ? $node : undef;
987		}
988	else
989		{
990		warn	"[" . __PACKAGE__ . "::getElement] "	.
991			"Invalid node position\n";
992		return undef;
993		}
994	}
995
996#------------------------------------------------------------------------------
997# get the list of children (or the first child unless wantarray) matching
998# a given element name and belonging to a given element
999
1000sub	selectChildElementsByName
1001	{
1002	my $self	= shift;
1003	my $path	= shift;
1004	my $element	= ref $path ? $path : $self->getElement($path, shift);
1005	return undef	unless $element;
1006
1007	return $element->selectChildElements(@_);
1008	}
1009
1010#------------------------------------------------------------------------------
1011# get the first child belonging to a given element and matching a given name
1012
1013sub	selectChildElementByName
1014	{
1015	my $self	= shift;
1016	my $path	= shift;
1017	my $element	= ref $path ? $path : $self->getElement($path, shift);
1018	return undef			unless $element;
1019	return $element->selectChildElement(@_);
1020	}
1021
1022#-----------------------------------------------------------------------------
1023# create a user field
1024
1025sub     setUserFieldDeclaration
1026        {
1027        my $self        = shift;
1028        my $name        = shift         or return undef;
1029        my %attr        =
1030                        (
1031                        type    => 'string',
1032                        value   => "",
1033                        @_
1034                        );
1035
1036        return undef if $self->getUserField($name);
1037
1038        my $body        = $self->getBody;
1039        my $context     = $body->first_child('text:user-field-decls');
1040        unless ($context)
1041                {
1042                $context = $self->appendElement
1043                        ($body, 'text:user-field-decls');
1044                }
1045
1046
1047        my $va =
1048            (
1049                ($attr{'type'} eq 'float')      ||
1050                ($attr{'type'} eq 'currency')   ||
1051                ($attr{'type'} eq 'percentage')
1052            ) ?
1053                'office:value' : "office:$attr{'type'}-value" ;
1054        $attr{'office:value-type'}      = $attr{'type'};
1055        $attr{$va}                      = $attr{'value'};
1056        $attr{'text:name'}              = $name;
1057        $attr{'office:currency'}        = $attr{'currency'};
1058        delete @attr{qw(type value currency)};
1059
1060        return $self->appendElement
1061                (
1062                $context, 'text:user-field-decl',
1063                attributes => { %attr }
1064                );
1065        }
1066
1067#-----------------------------------------------------------------------------
1068# get user field element
1069
1070sub	getUserField
1071	{
1072	my $self	= shift;
1073	my $name	= shift;
1074
1075	unless ($name)
1076		{
1077		warn "[" . __PACKAGE__ . "::getUserField] Missing name\n";
1078		return undef;
1079		}
1080	if (ref $name)
1081		{
1082		my $n = $name->getName;
1083		return ($n eq 'text:user-field-decl') ? $name : undef;
1084		}
1085	$name = $self->inputTextConversion($name);
1086	my $context     = $self->getRoot();
1087	if ($self->getPartName() eq 'styles')
1088	        {
1089	        $context = shift || $self->currentContext;
1090	        }
1091	return $self->getNodeByXPath
1092			(
1093			"//text:user-field-decl[\@text:name=\"$name\"]",
1094			$context
1095			);
1096	}
1097
1098#-----------------------------------------------------------------------------
1099# get user field list
1100
1101sub     getUserFields
1102        {
1103        my $self        = shift;
1104        my $context     = $self->getRoot;
1105
1106        if ($self->getPartName() eq 'styles')
1107                {
1108                $context = shift || $self->currentContext;
1109                }
1110
1111        return $self->selectNodesByXPath('//text:user-field-decl', $context);
1112        }
1113
1114#-----------------------------------------------------------------------------
1115# get/set user field value
1116
1117sub	userFieldValue
1118	{
1119	my $self	= shift;
1120	my $field	= $self->getUserField(shift) or return undef;
1121	my $value	= shift;
1122
1123	my $value_att	= $self->fieldValueAttributeName($field);
1124
1125	if (defined $value)
1126		{
1127		if ($value)
1128			{
1129			$self->setAttribute($field, $value_att, $value);
1130			}
1131		else
1132			{
1133			$field->set_att($value_att => $value);
1134			}
1135		}
1136	return $self->getAttribute($field, $value_att);
1137	}
1138
1139#-----------------------------------------------------------------------------
1140# get a variable element (contributed by Andrew Layton)
1141
1142sub	getVariable
1143	{
1144	my $self	= shift;
1145	my $name	= shift;
1146
1147	unless ($name) {
1148		warn	"[" . __PACKAGE__ . "::getVariable] " .
1149			"Missing name\n";
1150		return undef;
1151		}
1152
1153	if (ref $name) {
1154		my $n = $name->getName;
1155		return ($n eq 'text:variable-set') ? $name : undef;
1156	}
1157
1158	$name = $self->inputTextConversion($name);
1159	return $self->getNodeByXPath
1160	        ("//text:variable-set[\@text:name=\"$name\"]");
1161	}
1162
1163#-----------------------------------------------------------------------------
1164# get/set the content of a variable element (contributed by Andrew Layton)
1165
1166sub	variableValue
1167	{
1168	my $self	= shift;
1169	my $variable	= $self->getVariable(shift) or return undef;
1170	my $value	= shift;
1171
1172	my $value_att	= $self->fieldValueAttributeName($variable);
1173
1174	if (defined $value)
1175		{
1176		$self->setAttribute($variable, $value_att, $value);
1177		$self->setText($variable, $value);
1178		}
1179
1180	$value = $self->getAttribute($variable, $value_att);
1181	return defined $value ? $value : $self->getText($variable);
1182	}
1183
1184#-----------------------------------------------------------------------------
1185# some usual text field constructors
1186
1187sub	create_field
1188	{
1189	my $self	= shift;
1190	my $tag		= shift;
1191	my %opt		= @_;
1192	my $prefix	= $opt{'-prefix'};
1193	delete $opt{'-prefix'};
1194
1195	if ($prefix)
1196		{
1197		$tag = "$prefix:$tag" unless $tag =~ /:/;
1198		my %att = ();
1199		foreach my $k (keys %opt)
1200			{
1201			my $a = ($k =~ /:/) ? $k : "$prefix:$k";
1202			$att{$a} = $opt{$k};
1203			}
1204		%opt = %att;
1205		}
1206	my $element = OpenOffice::OODoc::Element->new($tag);
1207	$self->setAttributes($element, %opt);
1208	return $element;
1209	}
1210
1211sub	spaces
1212	{
1213	my $self	= shift;
1214	my $length	= shift;
1215	return $self->create_field('text:s', 'text:c' => $length, @_);
1216	}
1217
1218sub	tabStop
1219	{
1220	my $self	= shift;
1221	my $tag = $self->{'opendocument'} ? 'text:tab' : 'text:tab-stop';
1222	return $self->create_field($tag, @_);
1223	}
1224
1225sub	lineBreak
1226	{
1227	my $self	= shift;
1228	return $self->create_field('text:line-break', @_);
1229	}
1230
1231#------------------------------------------------------------------------------
1232
1233sub	appendLineBreak
1234	{
1235	my $self	= shift;
1236	my $element	= shift;
1237
1238	return $element->appendChild('text:line-break');
1239	}
1240
1241#------------------------------------------------------------------------------
1242
1243sub	appendSpaces
1244	{
1245	my $self	= shift;
1246	my $element	= shift;
1247	my $length	= shift;
1248
1249	my $spaces	= $self->spaces($length) or return undef;
1250	$spaces->paste_last_child($element);
1251	}
1252
1253#------------------------------------------------------------------------------
1254# multiple whitespace handling routine, contributed by J David Eisenberg
1255
1256sub processSpaces
1257	{
1258	my $self = shift;
1259	my $element = shift;
1260	my $str = shift;
1261	my @words = split(/(\s\s+)/, $str);
1262	foreach my $word (@words)
1263		{
1264		if ($word =~ m/^ +$/)
1265			{
1266			$self->appendSpaces($element, length($word));
1267			}
1268		elsif (length($word) > 0)
1269			{
1270			$element->appendTextChild($word);
1271			}
1272		}
1273	}
1274
1275#------------------------------------------------------------------------------
1276
1277sub	appendTabStop
1278	{
1279	my $self	= shift;
1280	my $element	= shift;
1281
1282	my $tabtag = $self->{'opendocument'} ? 'text:tab' : 'text:tab-stop';
1283
1284	return $element->appendChild($tabtag);
1285	}
1286
1287#------------------------------------------------------------------------------
1288
1289sub	createFrameElement
1290	{
1291	my $self	= shift;
1292	my %opt		= @_;
1293	my %attr	= ();
1294
1295	$attr{'draw:name'} = $opt{'name'}; delete $opt{'name'};
1296
1297	my $content_class = $self->contentClass;
1298
1299	$attr{'draw:style-name'} = $opt{'style'}; delete $opt{'style'};
1300	if ($opt{'page'})
1301		{
1302		my $pg = $opt{'page'};
1303		if (ref $pg)
1304			{
1305			$opt{'attachment'} = $pg unless $opt{'attachment'};
1306			}
1307		elsif ($content_class eq 'text')
1308			{
1309			$opt{'attachment'} = $self->{'body'};
1310			$attr{'text:anchor-type'} = 'page';
1311			$attr{'text:anchor-page-number'} = $pg;
1312			}
1313		elsif 	(
1314				($content_class eq 'presentation')
1315					or
1316				($content_class eq 'drawing')
1317			)
1318			{
1319			my $n = $self->inputTextConversion($pg);
1320			$opt{'attachment'} = $self->getNodeByXPath
1321					("//draw:page[\@draw:name=\"$n\"]");
1322			}
1323		}
1324	delete $opt{'page'};
1325
1326	my $tag = $opt{'tag'} || 'draw:frame'; delete $opt{'tag'};
1327
1328	my $frame = OpenOffice::OODoc::XPath::new_element($tag);
1329
1330	if ($opt{'position'})
1331		{
1332		$self->setObjectCoordinates($frame, $opt{'position'});
1333		delete $opt{'position'};
1334		}
1335	if ($opt{'size'})
1336		{
1337		$self->setObjectSize($frame, $opt{'size'});
1338		delete $opt{'size'};
1339		}
1340	if ($opt{'description'})
1341		{
1342		$self->setObjectDescription($frame, $opt{'description'});
1343		delete $opt{'description'};
1344		}
1345	if ($opt{'attachment'})
1346		{
1347		$frame->paste_first_child($opt{'attachment'});
1348		delete $opt{'attachment'};
1349		}
1350
1351	foreach my $k (keys %opt)
1352		{
1353		$attr{$k} = $opt{$k} if ($k =~ /:/);
1354		}
1355	$self->setAttributes($frame, %attr);
1356
1357	return $frame;
1358	}
1359
1360sub	createFrame
1361	{
1362	my $self	= shift;
1363	return $self->createFrameElement(@_);
1364	}
1365
1366#-----------------------------------------------------------------------------
1367# select an individual frame element by name
1368
1369sub	selectFrameElementByName
1370	{
1371	my $self	= shift;
1372	my $text	= $self->inputTextConversion(shift);
1373	my $tag		= shift || 'draw:frame';
1374	return $self->selectNodeByXPath
1375			("//$tag\[\@draw:name=\"$text\"\]", @_);
1376	}
1377
1378#-----------------------------------------------------------------------------
1379# gets frame element (name or ref, with type checking)
1380
1381sub	getFrameElement
1382	{
1383	my $self	= shift;
1384	my $frame	= shift;
1385	return undef unless defined $frame;
1386	my $tag		= shift || 'draw:frame';
1387
1388	my $element	= undef;
1389	if (ref $frame)
1390		{
1391		$element = $frame;
1392		}
1393	else
1394		{
1395		if ($frame =~ /^[\-0-9]*$/)
1396			{
1397			return $self->getElement("//$tag", $frame, @_);
1398			}
1399		else
1400			{
1401			return $self->selectFrameElementByName
1402				($frame, $tag, @_);
1403			}
1404		}
1405	}
1406
1407#------------------------------------------------------------------------------
1408
1409sub	getFrameList
1410	{
1411	my $self	= shift;
1412	return $self->getDescendants('draw:frame', shift);
1413	}
1414
1415#------------------------------------------------------------------------------
1416
1417sub	frameStyle
1418	{
1419	my $self	= shift;
1420	my $frame	= $self->getFrameElement(shift) or return undef;
1421	my $style	= shift;
1422	my $attr	= 'draw:style-name';
1423	return (defined $style) ?
1424		$self->setAttribute($frame, $attr => shift)	:
1425		$self->getAttribute($frame, $attr);
1426	}
1427
1428#------------------------------------------------------------------------------
1429# replaces any previous content of an existing element by a given text
1430# without processing other than encoding
1431
1432sub	setFlatText
1433	{
1434	my $self	= shift;
1435	my $path	= shift;
1436	my $element     = ref $path ?
1437	                        $path     :
1438	                        $self->OpenOffice::OODoc::XPath::getElement
1439	                                                ($path, shift);
1440	return undef unless $element;
1441	my $text	= shift;
1442
1443	my $t		= $self->inputTextConversion($text);
1444	return undef unless defined $t;
1445
1446	$element->set_text($t);
1447	return $text;
1448	}
1449
1450#------------------------------------------------------------------------------
1451# replaces any previous content of an existing element by a given text
1452# processing tab stops and line breaks
1453
1454sub	setText
1455	{
1456	my $self	= shift;
1457	my $path	= shift;
1458	my $element     = ref $path ?
1459	                        $path     :
1460	                        $self->OpenOffice::OODoc::XPath::getElement
1461	                                                ($path, shift);
1462	return undef unless $element;
1463
1464	my $text	= shift;
1465	return undef	unless defined $text;
1466
1467	unless ($text)
1468		{
1469		$element->set_text($text); return $text;
1470		}
1471	return $self->setFlatText($element, $text) if $element->isTextNode;
1472
1473	my $tabtag = $self->{'opendocument'} ? 'text:tab' : 'text:tab-stop';
1474	$element->set_text("");
1475	my @lines	= split "\n", $text;
1476	while (@lines)
1477		{
1478		my $line	= shift @lines;
1479		my @columns	= split "\t", $line;
1480		while (@columns)
1481			{
1482			my $column	=
1483				$self->inputTextConversion(shift @columns);
1484			unless ($self->{'multiple_spaces'})
1485				{
1486				$element->appendTextChild($column);
1487				}
1488			else
1489				{
1490				$self->processSpaces($element, $column);
1491				}
1492			$element->appendChild($tabtag) if (@columns);
1493			}
1494		$element->appendChild('text:line-break') if (@lines);
1495		}
1496	$element->normalize;
1497	return $text;
1498	}
1499
1500#------------------------------------------------------------------------------
1501# extends the text of an existing element
1502
1503sub	extendText
1504	{
1505	my $self	= shift;
1506	my $path	= shift;
1507	my $pos		= (ref $path) ? undef : shift;
1508	my $text	= shift;
1509
1510	return undef	unless defined $text;
1511
1512	my $element 	= $self->getElement($path, $pos);
1513	return undef	unless $element;
1514
1515	my $offset	= shift;
1516
1517	if (ref $text)
1518		{
1519		if ($text->isElementNode)
1520			{
1521			unless (defined $offset)
1522				{
1523				$text->paste_last_child($element);
1524				}
1525			else
1526				{
1527				$text->paste_within($element, $offset);
1528				}
1529			}
1530		return $text;
1531		}
1532
1533	my $tabtag = $self->{'opendocument'} ? 'text:tab' : 'text:tab-stop';
1534	my @lines	= split "\n", $text;
1535	my $ref_node	= undef;
1536	while (@lines)
1537		{
1538		my $line	= shift @lines;
1539		my @columns	= split "\t", $line;
1540		while (@columns)
1541			{
1542			my $column	=
1543				$self->inputTextConversion(shift @columns);
1544			unless ($ref_node)
1545				{
1546				$ref_node = $element->insertTextChild
1547						($column, $offset);
1548				$ref_node = $ref_node->insertNewNode
1549						($tabtag, 'after')
1550					if (@columns);
1551				}
1552			else
1553				{
1554				my $tn = $self->createTextNode($column);
1555				$ref_node = $ref_node->insertNewNode
1556						($tn, 'after');
1557				$ref_node = $ref_node->insertNewNode
1558						($tabtag, 'after')
1559					if (@columns);
1560				}
1561			}
1562		if (@lines)
1563			{
1564			if ($ref_node)
1565				{
1566				$ref_node->insertNewNode
1567						('text:line-break', 'after');
1568				}
1569			else
1570				{
1571			 	$element->insertNewNode
1572						(
1573						'text:line-break',
1574						'within',
1575						$offset
1576						);
1577				}
1578			}
1579		}
1580
1581	$element->normalize;
1582	return $text;
1583	}
1584
1585#------------------------------------------------------------------------------
1586# converts the content of an element to flat text
1587
1588sub	flatten
1589	{
1590	my $self	= shift;
1591	my $element	= shift || $self->{'context'};
1592	return $element->flatten;
1593	}
1594
1595#------------------------------------------------------------------------------
1596# creates a new encoded text node
1597
1598sub	newTextNode
1599	{
1600	my $self	= shift;
1601	my $text	= $self->inputTextConversion(shift)
1602	                or return undef;
1603	return OpenOffice::OODoc::Element->new('#PCDATA' => $text);
1604	}
1605
1606#------------------------------------------------------------------------------
1607# gets decoded text without other processing
1608
1609sub	getFlatText
1610	{
1611	my $self	= shift;
1612	my $path	= shift;
1613	my $element     = ref $path ?
1614	                        $path     :
1615	                        $self->OpenOffice::OODoc::XPath::getElement
1616	                                                ($path, @_);
1617	return undef unless $element;
1618
1619	return $self->outputTextConversion($element->text);
1620	}
1621
1622#------------------------------------------------------------------------------
1623# gets text in element by path (sub-element texts are concatenated)
1624
1625sub	getText
1626	{
1627	my $self	= shift;
1628        my $path        = shift;
1629        my $element     = ref $path ?
1630                                $path   :
1631                                $self->OpenOffice::OODoc::XPath::getElement
1632                                                        ($path, @_);
1633        return undef unless $element;
1634        return $self->getFlatText($element) if $element->isTextNode;
1635	return undef	unless $element->isElementNode;
1636
1637	my $text	= '';
1638
1639	my $name	= $element->getName;
1640
1641	if	($name =~ /^text:tab(|-stop)$/)	{ return "\t"; }
1642	if	($name eq 'text:line-break')	{ return "\n"; }
1643	if	($name eq 'text:s')
1644		{
1645		my $spaces = "";
1646		my $count = $element->att('text:c') || 1;
1647		while ($count > 0) { $spaces .= ' '; $count--; }
1648		return $spaces;
1649		}
1650	foreach my $node ($element->getChildNodes)
1651		{
1652		if ($node->isElementNode)
1653			{
1654			$text .= $self->getText($node);
1655			}
1656		else
1657			{
1658			$text .= $self->outputTextConversion($node->text);
1659			}
1660		}
1661	return $text;
1662	}
1663
1664#------------------------------------------------------------------------------
1665
1666sub	xpathInContext
1667	{
1668	my $self	= shift;
1669	my $path	= shift	|| "/";
1670	my $context	= shift || $self->{'context'};
1671	if ($context ne $self->{'xpath'})
1672		{
1673		$path =~ s/^\//\.\//;
1674		}
1675	return ($path, $context);
1676	}
1677
1678#------------------------------------------------------------------------------
1679
1680sub	getDescendants
1681	{
1682	my $self	= shift;
1683	my $tag		= shift;
1684	my $context	= shift || $self->{'context'};
1685	return $context->descendants($tag, @_);
1686	}
1687
1688#------------------------------------------------------------------------------
1689
1690sub     getTextNodes
1691        {
1692        my $self        = shift;
1693	my $path	= shift;
1694	my $element	= ref $path ? $path : $self->getElement($path, shift)
1695	                        or return undef;
1696        my $filter      = $self->inputTextConversion(shift);
1697        return $element->getTextDescendants($filter);
1698        }
1699
1700#------------------------------------------------------------------------------
1701# brute XPath nodelist selection; allows any XML::XPath expression
1702
1703sub	selectNodesByXPath
1704	{
1705	my $self	= shift;
1706	my ($p1, $p2)	= @_;
1707	my $path	= undef;
1708	my $context	= undef;
1709	if (ref $p1)	{ $context = $p1; $path = $p2; }
1710	else		{ $path = $p1; $context = $p2; }
1711	($path, $context) = $self->xpathInContext($path, $context);
1712	unless (ref $context)
1713	        {
1714	        warn    "[" . __PACKAGE__ . "::selectNodesByXPath] "    .
1715	                "Bad context argument\n";
1716	        return undef;
1717	        }
1718	return $context->get_xpath($path);
1719	}
1720
1721#------------------------------------------------------------------------------
1722# like selectNodesByXPath, without variable context (direct XML::Twig method)
1723
1724sub     get_xpath
1725        {
1726        my $self        = shift;
1727        return $self->{'xpath'}->get_xpath(@_);
1728        }
1729
1730#------------------------------------------------------------------------------
1731# brute XPath single node selection; allows any XML::XPath expression
1732
1733sub	selectNodeByXPath
1734	{
1735	my $self	= shift;
1736	my $p1		= shift;
1737	my $p2		= shift;
1738	my $offset	= shift || 0;
1739	my $path	= undef;
1740	my $context	= undef;
1741	if (ref $p1)	{ $context = $p1; $path = $p2; }
1742	else		{ $path = $p1; $context = $p2; }
1743	($path, $context) = $self->xpathInContext($path, $context);
1744	unless (ref $context)
1745	        {
1746	        warn    "[" . __PACKAGE__ . "::selectNodeByXPath] "    .
1747	                "Bad context argument\n";
1748	        return undef;
1749	        }
1750
1751	return $context->get_xpath($path, $offset);
1752	}
1753
1754#------------------------------------------------------------------------------
1755# brute XPath value extraction; allows any XML::XPath expression
1756
1757sub	getXPathValue
1758	{
1759	my $self	= shift;
1760	my ($p1, $p2)	= @_;
1761	my $path	= undef;
1762	my $context	= undef;
1763	if (ref $p1)	{ $context = $p1; $path = $p2; }
1764	else		{ $path = $p1; $context = $p2; }
1765	($path, $context) = $self->xpathInContext($path, $context);
1766	unless (ref $context)
1767	        {
1768	        warn    "[" . __PACKAGE__ . "::getXPathValue] "    .
1769	                "Bad context argument\n";
1770	        return undef;
1771	        }
1772	return $self->outputTextConversion($context->findvalue($path, @_));
1773	}
1774
1775#------------------------------------------------------------------------------
1776# create or update an xpath
1777
1778sub	makeXPath
1779	{
1780	my $self	= shift;
1781	my $path	= shift;
1782	my $root	= undef;
1783	if (ref $path)
1784		{
1785		$root	= $path;
1786		$path	= shift;
1787		}
1788	else
1789		{
1790		$root	= $self->getRoot;
1791		}
1792	$path =~ s/^[\/ ]*//; $path =~ s/[\/ ]*$//;
1793	my @list	= split '/', $path;
1794	my $posnode	= $root;
1795	while (@list)
1796		{
1797		my $item	= shift @list;
1798		while (($item =~ /\[.*/) && !($item =~ /\[.*\]/))
1799			{
1800			my $cont = shift @list or last;
1801			$item .= ('/' . $cont);
1802			}
1803		next unless $item;
1804		my $node	= undef;
1805		my $name	= undef;
1806		my $param	= undef;
1807		$item =~ s/\[(.*)\] *//;
1808		$param = $1;
1809		$name = $item; $name =~ s/^ *//; $name =~ s/ *$//;
1810		my %attributes = ();
1811		my $text = undef;
1812		my $indice = undef;
1813		if ($param)
1814			{
1815			my @attrlist = [];
1816			$indice = undef;
1817			$param =~ s/^ *//; $param =~ s/ *$//;
1818			$param =~ s/^@//;
1819			@attrlist = split /@/, $param;
1820			foreach my $a (@attrlist)
1821				{
1822				next unless $a;
1823				$a =~ s/^ *//;
1824				my $tmp = $a;
1825				$tmp =~ s/ *$//;
1826				if ($tmp =~ /^\d*$/)
1827					{
1828					$indice = $tmp;
1829					next;
1830					}
1831				if ($a =~ s/^\"(.*)\".*/$1/)
1832					{
1833					$text = $1; next;
1834					}
1835				if ($a =~ /^=/)
1836					{
1837					$a	=~ s/^=//;
1838					$a	=~ '^"(.*)"$';
1839					$text	= $1 ? $1 : $a;
1840					next;
1841					}
1842				$a =~ s/^@//;
1843				my ($attname, $attvalue) = split '=', $a;
1844				next unless $attname;
1845				if ($attvalue)
1846					{
1847					$attvalue =~ '"(.*)"';
1848					$attvalue = $1 if $1;
1849					}
1850				$attname =~ s/^ *//; $attname =~ s/ *$//;
1851				$attributes{$attname} = $attvalue;
1852				}
1853			}
1854		if (defined $indice)
1855			{
1856			$node = $self->getNodeByXPath
1857					($posnode, "$name\[$indice\]");
1858			}
1859		else
1860			{
1861			$node	=
1862				$self->getChildElementByName($posnode, $name);
1863			}
1864		if ($node)
1865			{
1866			$self->setAttributes($node, %attributes);
1867			$self->setText($node, $text)	if (defined $text);
1868			}
1869		else
1870			{
1871			$node = $self->appendElement
1872					(
1873					$posnode, $name,
1874					text		=> $text,
1875					attributes	=> {%attributes}
1876					);
1877			}
1878		if ($node)	{ $posnode = $node;	}
1879		else		{ return undef;		}
1880		}
1881	return $posnode;
1882	}
1883
1884#------------------------------------------------------------------------------
1885# selects element by path and attribute
1886
1887sub	selectElementByAttribute
1888	{
1889	my $self	= shift;
1890	my $path	= shift         or return undef;
1891	my $key		= shift         or return undef;
1892	my $arg3        = shift;
1893
1894	my $xp  = undef;
1895	if (defined $arg3 && ! ref $arg3)       # arg3 = value
1896	        {
1897	        my $value = $self->inputTextConversion($arg3);
1898	        $xp = "//$path\[\@$key=\"$value\"\]";
1899	        }
1900	else                                    # arg3 = undef or context
1901	        {
1902	        $xp = "//$path\[\@$key\]" ; unshift @_, $arg3;
1903	        }
1904
1905        return $self->selectNodeByXPath($xp, @_);
1906	}
1907
1908#------------------------------------------------------------------------------
1909
1910sub     selectElementByIdentifier
1911        {
1912        my $self        = shift;
1913
1914        return $self->selectElementByAttribute(shift, $ELT_ID, @_);
1915        }
1916
1917#------------------------------------------------------------------------------
1918# selects list of elements by path and attribute
1919
1920sub	selectElementsByAttribute
1921	{
1922	my $self	= shift;
1923	my $path	= shift         or return undef;
1924	my $key		= shift         or return undef;
1925	my $arg3        = shift;
1926
1927	my $xp  = undef;
1928	if (defined $arg3 && ! ref $arg3)       # arg3 = value
1929	        {
1930	        my $value = $self->inputTextConversion($arg3);
1931	        $xp = "//$path\[\@$key=\"$value\"\]";
1932	        }
1933	else                                    # arg3 = undef or context
1934	        {
1935	        $xp = "//$path\[\@$key\]" ; unshift @_, $arg3;
1936	        }
1937
1938
1939	return wantarray ?      $self->selectNodesByXPath($xp, @_)      :
1940	                        $self->selectNodeByXPath($xp, @_);
1941	}
1942
1943#------------------------------------------------------------------------------
1944# get a list of elements matching a given path and an optional content pattern
1945
1946sub	findElementList
1947	{
1948	my $self	= shift;
1949	my $path	= shift;
1950	my $pattern	= shift;
1951	my $replace	= shift;
1952	my $context	= shift;
1953
1954	return undef unless $path;
1955
1956	my @result	= ();
1957
1958	($path, $context) = $self->xpathInContext($path, $context);
1959	foreach my $n ($context->findnodes($path))
1960		{
1961		push @result,
1962		    [ $self->findDescendants($n, $pattern, $replace, @_) ];
1963		}
1964
1965	return @result;
1966	}
1967
1968#------------------------------------------------------------------------------
1969# get a list of elements matching a given path and an optional content pattern
1970# without replacement operation, and from an optional context node
1971
1972sub	selectElements
1973	{
1974	my $self	= shift;
1975	my $path	= shift;
1976	my $context	= $self->{'context'};
1977	if (ref $path)
1978		{
1979		$context	= $path;
1980		$path		= shift;
1981		}
1982	my $filter	= shift;
1983
1984	my @candidates	= $self->selectNodesByXPath($context, $path);
1985	return @candidates	unless $filter;
1986
1987	my @result	= ();
1988	while (@candidates)
1989		{
1990		my $node = shift @candidates;
1991		push @result, $node
1992			if $self->_search_content($node, $filter, @_, $node);
1993		}
1994	return @result;
1995	}
1996
1997#------------------------------------------------------------------------------
1998# get the 1st element matching a given path and on optional content pattern
1999
2000sub	selectElement
2001	{
2002	my $self	= shift;
2003	my $path	= shift;
2004	my $context	= $self->{'context'};
2005	if (ref $path)
2006		{
2007		$context	= $path;
2008		$path		= shift;
2009		}
2010	return undef	unless $path;
2011	my $filter	= shift;
2012
2013	my @candidates	= $self->selectNodesByXPath($context, $path);
2014	return $candidates[0]	unless $filter;
2015
2016	while (@candidates)
2017		{
2018		my $node = shift @candidates;
2019		return $node
2020			if $self->_search_content($node, $filter, @_, $node);
2021		}
2022	return undef;
2023	}
2024
2025#------------------------------------------------------------------------------
2026# gets the descendants of a given node, with optional in fly search/replacement
2027
2028sub	findDescendants
2029	{
2030	my $self	= shift;
2031	my $node	= shift;
2032	my $pattern	= shift;
2033	my $replace	= shift;
2034
2035	my @result		= ();
2036
2037	my $n	= $self->selectNodeByContent($node, $pattern, $replace, @_);
2038	push @result, $n	if $n;
2039	foreach my $m ($node->getChildNodes)
2040		{
2041		push @result,
2042		    [ $self->findDescendants($m, $pattern, $replace, @_) ];
2043		}
2044
2045	return @result;
2046	}
2047
2048#------------------------------------------------------------------------------
2049# search & replace text in an individual node
2050
2051sub	selectNodeByContent
2052	{
2053	my $self	= shift;
2054	my $node	= shift;
2055	my $pattern	= shift;
2056	my $replace	= shift;
2057
2058	return $node	unless $pattern;
2059	my $l	= $node->text;
2060
2061	return undef	unless $l;
2062
2063	unless (defined $replace)
2064		{
2065		return ($l =~ /$pattern/) ? $node : undef;
2066		}
2067	else
2068		{
2069		if (ref $replace)
2070			{
2071			unless
2072			  ($l =~ s/($pattern)/&$replace(@_, $node, $1)/eg)
2073				{
2074				return undef;
2075				}
2076			}
2077		else
2078			{
2079			unless ($l =~ s/$pattern/$replace/g)
2080				{
2081				return undef;
2082				}
2083			}
2084		$node->set_text($l);
2085		return $node;
2086		}
2087	}
2088
2089#------------------------------------------------------------------------------
2090# gets the text content of a nodelist
2091
2092sub	getTextList
2093	{
2094	my $self	= shift;
2095	my $path	= shift;
2096	my $pattern	= shift;
2097	my $context	= shift;
2098
2099	return undef unless $path;
2100
2101	($path, $context) = $self->xpathInContext($path, $context);
2102	my @nodelist = $context->findnodes($path);
2103	my @text = ();
2104
2105	foreach my $n (@nodelist)
2106		{
2107		my $l	= $self->outputTextConversion($n->string_value);
2108		push @text, $l if ((! defined $pattern) || ($l =~ /$pattern/));
2109		}
2110
2111	return wantarray ? @text : join "\n", @text;
2112	}
2113
2114#------------------------------------------------------------------------------
2115# gets the attributes of an element in the key => value form
2116
2117sub	getAttributes
2118	{
2119	my $self	= shift;
2120	my $path	= shift;
2121	my $pos		= (ref $path) ? undef : shift;
2122
2123	my $node	= $self->getElement($path, $pos, @_);
2124	return undef	unless $path;
2125
2126	my %attributes	= ();
2127	my $aa		= $node->atts(@_);
2128	my %atts	= %{$aa} if $aa;
2129	foreach my $a (keys %atts)
2130		{
2131		$attributes{$a}	= $self->outputTextConversion($atts{$a});
2132		}
2133
2134	return %attributes;
2135	}
2136
2137#------------------------------------------------------------------------------
2138# gets the value of an attribute by path + name
2139
2140sub	getAttribute
2141	{
2142	my $self	= shift;
2143	my $path	= shift;
2144	my $pos		= (ref $path) ? undef : shift;
2145	my $name	= shift or return undef;
2146
2147	my $node	= $self->getElement($path, $pos, @_);
2148	unless ($name =~ /:/)
2149	        {
2150	        my $prefix = $node->ns_prefix;
2151	        $name = $prefix . ':' . $name   if $prefix;
2152	        }
2153	$name =~ s/ /-/g;
2154	return	$self->outputTextConversion($node->att($name));
2155	}
2156
2157#------------------------------------------------------------------------------
2158# set/replace a list of attributes in an element
2159
2160sub	setAttributes
2161	{
2162	my $self	= shift;
2163	my $path	= shift;
2164	my $pos		= (ref $path) ? undef : shift;
2165	my %attr	= @_;
2166
2167	my $node	= $self->getElement($path, $pos, $attr{'context'});
2168	return undef	unless $node;
2169	my $prefix      = $node->ns_prefix();
2170
2171	foreach my $k (keys %attr)
2172		{
2173		my $att_name = $k;
2174		$att_name =~ s/ /-/g;
2175		if (!($k =~ /:/) && $prefix)
2176		        {
2177		        $att_name = $prefix . ':' . $att_name;
2178		        }
2179		if (defined $attr{$k})
2180		    {
2181		    $node->set_att
2182		    		(
2183				$att_name,
2184				$self->inputTextConversion($attr{$k})
2185				);
2186		    }
2187		else
2188		    {
2189		    $node->del_att($att_name) if $node->att($att_name);
2190		    }
2191		}
2192
2193	return %attr;
2194	}
2195
2196#------------------------------------------------------------------------------
2197# set/replace a single attribute in an element
2198
2199sub	setAttribute
2200	{
2201	my $self	= shift;
2202	my $path	= shift;
2203	my $pos		= (ref $path) ? undef : shift;
2204
2205	my $attribute	= shift or return undef;
2206	my $value	= shift;
2207	my $node	= $self->getElement($path, $pos, @_)
2208		or return undef;
2209
2210        $attribute =~ s/ /-/g;
2211        unless ($attribute =~ /:/)
2212                {
2213                my $prefix = $node->ns_prefix;
2214                $attribute = $prefix . ':' . $attribute if $prefix;
2215                }
2216	if (defined $value)
2217		{
2218		$node->set_att
2219			(
2220			$attribute,
2221			$self->inputTextConversion($value)
2222			);
2223		}
2224	else
2225		{
2226		$node->del_att($attribute) if $node->att($attribute);
2227		}
2228
2229	return $value;
2230	}
2231
2232#------------------------------------------------------------------------------
2233# removes an attribute in element
2234
2235sub	removeAttribute
2236	{
2237	my $self	= shift;
2238	my $path	= shift;
2239	my $pos		= (ref $path) ? undef : shift;
2240	my $name	= shift or return undef;
2241
2242	my $node	= $self->getElement($path, $pos, @_)
2243	                        or return undef;
2244
2245        unless ($name =~ /:/)
2246                {
2247                my $prefix = $node->ns_prefix;
2248                $name = $prefix . ':' . $name   if $prefix;
2249                }
2250	return $node->del_att($name) if $node->att($name);
2251	}
2252
2253#------------------------------------------------------------------------------
2254# replicates an existing element, provided as an XPath ref or an XML string
2255
2256sub	replicateElement
2257	{
2258	my $self	= shift;
2259	my $proto	= shift;
2260	my $position	= shift;
2261	my %options	= @_;
2262
2263	unless ($proto && ref $proto && $proto->isElementNode)
2264		{
2265		warn "[" . __PACKAGE__ . "::replicateElement] No prototype\n";
2266		return undef;
2267		}
2268
2269	$position	= 'end'	unless $position;
2270
2271	my $element		= $proto->copy;
2272	$self->setAttributes($element, %{$options{'attribute'}});
2273
2274	if	(ref $position)
2275		{
2276		if (! $options{'position'})
2277			{
2278			$element->paste_last_child($position);
2279			}
2280		elsif ($options{'position'} eq 'before')
2281			{
2282			$element->paste_before($position);
2283			}
2284		elsif ($options{'position'} eq 'after')
2285			{
2286			$element->paste_after($position);
2287			}
2288		elsif ($options{'position'} ne 'free')
2289			{
2290			warn	"[" . __PACKAGE__ . "::replicateElement] " .
2291				"No valid attachment option\n";
2292			}
2293		}
2294	elsif	($position eq 'end')
2295		{
2296		$element->paste_last_child($self->{'xpath'}->root);
2297		}
2298	elsif	($position eq 'body')
2299		{
2300		$element->paste_last_child($self->getBody);
2301		}
2302
2303	return $element;
2304	}
2305
2306#------------------------------------------------------------------------------
2307# create an element, just with a mandatory name and an optional text
2308# the name can have the namespace:name form
2309# if the $name argument is a '<.*>' string, it's processed as XML and
2310# the new element is completely generated from it
2311
2312sub	createElement
2313	{
2314	my $self	= shift;
2315	my $name	= shift;
2316	my $text	= shift;
2317
2318	my $element = OpenOffice::OODoc::XPath::new_element($name, @_);
2319	unless ($element)
2320		{
2321		warn	"[" . __PACKAGE__ . "::createElement] "	.
2322			"Element creation failure\n";
2323		return undef;
2324		}
2325
2326	$self->setText($element, $text)		if defined $text;
2327
2328	return $element;
2329	}
2330
2331#------------------------------------------------------------------------------
2332# replaces an element by another one
2333# the new element is inserted before the old one,
2334# then the old element is removed.
2335# the new element can be inserted by copy (default) or by reference
2336# return = new element if success, undef if failure
2337
2338sub	replaceElement
2339	{
2340	my $self	= shift;
2341	my $path	= shift;
2342	my $pos		= (ref $path) ? undef : shift;
2343	my $new_element	= shift;
2344	my %options	=
2345			(
2346			mode		=> 'copy',
2347			@_
2348			);
2349	unless ($new_element)
2350		{
2351		warn	"[" . __PACKAGE__ . "::replaceElement] " .
2352			"Missing new element\n";
2353		return undef;
2354		}
2355	unless (ref $new_element)
2356		{
2357		$new_element = $self->createElement($new_element);
2358		$options{'mode'} = 'reference';
2359		}
2360	unless ($new_element && $new_element->isElementNode)
2361		{
2362		warn	"[" . __PACKAGE__ . "::replaceElement] " .
2363			"No valid replacement\n";
2364		return undef;
2365		}
2366
2367	my $result	= undef;
2368
2369	my $old_element	= $self->getElement
2370			($path, $pos, $options{'context'});
2371	unless ($old_element)
2372		{
2373		warn	"[" . __PACKAGE__ . "::replaceElement] " .
2374			"Non existing element to be replaced\n";
2375		return undef;
2376		}
2377	if	(! $options{'mode'} || $options{'mode'} eq 'copy')
2378		{
2379		$result = $new_element->copy;
2380		$result->replace($old_element);
2381		return $result;
2382		}
2383	elsif	($options{'mode'} && $options{'mode'} eq 'reference')
2384		{
2385		$result = $self->insertElement
2386					(
2387					$old_element,
2388					$new_element,
2389					position	=> 'before'
2390					);
2391		$old_element->delete;
2392		return $result;
2393		}
2394	else
2395		{
2396		warn	"[" . __PACKAGE__ . "::replaceElement] " .
2397			"Unknown option\n";
2398		}
2399	return undef;
2400	}
2401
2402#------------------------------------------------------------------------------
2403# appends a new or existing child element to any existing element
2404
2405sub	appendElement
2406	{
2407	my $self	= shift;
2408	my $path	= shift;
2409	my $pos		= (ref $path) ? undef : shift;
2410	my $name	= shift;
2411	my %opt		= @_;
2412	$opt{'attribute'} = $opt{'attributes'} unless ($opt{'attribute'});
2413
2414	return undef	unless $name;
2415	my $element	= undef;
2416
2417	unless (ref $name)
2418		{
2419		$element	= $self->createElement($name, $opt{'text'});
2420		}
2421	else
2422		{
2423		$element	= $name;
2424		$self->setText($element, $opt{'text'})	if $opt{'text'};
2425		}
2426	return undef	unless $element;
2427	my $parent	= $self->getElement
2428			($path, $pos, $opt{'context'});
2429	unless ($parent)
2430		{
2431		warn	"[" . __PACKAGE__ .
2432			"::appendElement] Position not found\n";
2433		return undef;
2434		}
2435	$element->paste_last_child($parent);
2436	$self->setAttributes($element, %{$opt{'attribute'}});
2437
2438	return $element;
2439	}
2440
2441#-----------------------------------------------------------------------------
2442# append an element to the document body
2443
2444sub	appendBodyElement
2445	{
2446	my $self	= shift;
2447
2448	return $self->appendElement($self->{'body'}, @_);
2449	}
2450
2451#------------------------------------------------------------------------------
2452# appends a list of children to an existing element
2453
2454sub	appendElements
2455	{
2456	my $self	= shift;
2457	my $path	= shift;
2458	my $pos		= (ref $path) ? undef : shift;
2459	my $parent	= $self->getElement($path, $pos) or return undef;
2460	my @children	= @_;
2461	foreach my $child (@children)
2462		{
2463		$parent->appendChild($child);
2464		}
2465	return $parent;
2466	}
2467
2468#------------------------------------------------------------------------------
2469# cuts a set of existing elements and pastes them as children of a given one
2470
2471sub	moveElements
2472	{
2473	my $self	= shift;
2474	my $path	= shift;
2475	my $pos		= (ref $path) ? undef : shift;
2476	my $parent	= $self->getElement($path, $pos) or return undef;
2477	$parent->pickUpChildren(@_);
2478	return $parent;
2479	}
2480
2481#------------------------------------------------------------------------------
2482# selects a text node in a given element according to offset & expression
2483
2484sub     textIndex
2485        {
2486        my $self        = shift;
2487        my $path        = shift;
2488        my $element     = (ref $path) ? $path : $self->getElement($path, shift)
2489                        or return undef;
2490	my %opt         = @_;
2491
2492        my $offset      = $opt{'offset'};
2493        my $way         = $opt{'way'} || 'forward';
2494        if (defined $offset && $offset < 0)
2495                {
2496                $way = 'backward';
2497                }
2498        $offset = -abs($offset) if defined $offset && $way eq 'backward';
2499
2500        my $start_mark  = $opt{'start_mark'};
2501        my $end_mark    = $opt{'end_mark'};
2502
2503        my $expr        = undef;
2504        if (defined $opt{'after'})
2505                {
2506                $expr = $opt{'after'};
2507                delete @opt{qw(before replace capture content)};
2508                }
2509        elsif (defined $opt{'before'})
2510                {
2511                $expr = $opt{'before'};
2512                delete @opt{qw(replace capture content)};
2513                }
2514        else
2515                {
2516                $expr = $opt{'content'} || $opt{'replace'} || $opt{'capture'};
2517                }
2518        $expr           = $self->inputTextConversion($expr);
2519
2520        my $node        = undef;
2521        my $node_text   = undef;
2522        my $node_length = undef;
2523        my $found       = undef;
2524        my $end_pos     = undef;
2525        my $match       = undef;
2526
2527        if ($way ne 'backward')         # positive offset, forward
2528                {
2529                if ($element->isTextNode)
2530                        {
2531                        $node = $element;
2532                        }
2533                elsif ($start_mark)
2534                        {
2535                        unless($start_mark->isTextNode)
2536                                {
2537                                my $n   = $start_mark->last_descendant;
2538                                $start_mark = $n        if $n;
2539                                $node   = $n->next_elt($element, '#PCDATA');
2540                                }
2541                        else
2542                                {
2543                                $node   = $start_mark;
2544                                }
2545                        }
2546                else
2547                        {
2548                        $node = $element->first_descendant('#PCDATA');
2549                        }
2550                if ($end_mark && ! $node->before($end_mark))
2551                        {
2552                        $node = undef;
2553                        }
2554                ($node_length, $node_text) = $node->textLength  if $node;
2555                FORWARD_LOOP: while ($node && !defined $found)
2556                        {
2557                        if ($end_mark && ! $node->before($end_mark))
2558                                {
2559                                $node = undef;
2560                                last;
2561                                }
2562                        if (defined $offset && ($offset > $node_length))
2563                                {                       # skip node
2564                                $offset -= $node_length;
2565                                $node = $node->next_elt($element, '#PCDATA');
2566                                ($node_length, $node_text) = $node->textLength
2567                                        if $node;
2568                                }
2569
2570                        elsif (defined $expr)
2571                                {                       # look for substring
2572                                my $text = $node->text() || "";
2573                                if (defined $offset && $offset > 0)
2574                                        {
2575                                        $text = substr($text, $offset);
2576                                        }
2577                                if ($text =~ /($expr)/)
2578                                        {
2579                                        $found = length($`);
2580                                        $found += $offset if defined $offset;
2581                                        $end_pos = $found + length($&);
2582                                        $match = $1;
2583                                        }
2584                                unless (defined $found)
2585                                        {
2586                                        $offset = undef;
2587                                        $node   = $node->next_elt
2588                                                        ($element, '#PCDATA');
2589                                        }
2590                                }
2591                        else                              # selected by offset
2592                            {
2593                            $found = $offset || 0;
2594                            }
2595                        }
2596                }
2597        else                            # negative offset, backward
2598                {
2599                if ($element->isTextNode)
2600                        {
2601                        $node = $element;
2602                        }
2603                elsif ($start_mark)
2604                        {
2605                        unless ($start_mark->isTextNode)
2606                                {
2607                                $node   = $start_mark->prev_elt('#PCDATA');
2608                                }
2609                        else
2610                                {
2611                                $node   = $start_mark;
2612                                }
2613                        }
2614                else
2615                        {
2616                        $node   = $element->last_descendant('#PCDATA');
2617                        }
2618                if ($end_mark)
2619                        {
2620                        my $n = $end_mark->last_descendant;
2621                        $end_mark = $n        if $n;
2622                        $node = undef if
2623                                ($end_mark && ! $node->after($end_mark));
2624                        }
2625                ($node_length, $node_text) = $node->textLength  if $node;
2626                BACKWARD_LOOP: while ($node && !defined $found)
2627                        {
2628                        if ($end_mark && ! $node->after($end_mark))
2629                                {
2630                                $node = undef;
2631                                last;
2632                                }
2633                        ($node_length, $node_text) = $node->textLength;
2634                        if (defined $offset && (abs($offset) > $node_length))
2635                                {                       # skip node
2636                                $offset += $node_length;
2637                                $node = $node->prev_elt($element, '#PCDATA');
2638                                }
2639                        elsif (defined $expr)
2640                                {
2641                                my $text = $node->text() || "";
2642                                if (defined $offset && $offset < 0)
2643                                        {
2644                                        $text = substr($text, 0, $offset);
2645                                        }
2646                                my @r = ($text =~ m/($expr)/g);
2647                                if (@r)
2648                                        {
2649                                        $found = length($`);
2650                                        $end_pos = $found + length($&);
2651                                        $match = $1;
2652                                        }
2653                                unless (defined $found)
2654                                        {
2655                                        $offset = undef;
2656                                        $node   = $node->prev_elt
2657                                                        ($element, '#PCDATA');
2658                                        }
2659                                }
2660                        else                              # selected by offset
2661                                {
2662                                $found = $offset || 0;
2663                                }
2664                        }
2665                }
2666
2667        return ($node, $found, $end_pos, $match);
2668        }
2669
2670#------------------------------------------------------------------------------
2671# creates new child elements in a given element and splits the content
2672# according to a regexp
2673
2674sub     splitContent
2675        {
2676        my $self        = shift;
2677        my $path        = shift;
2678        my $pos         = (ref $path) ? undef : shift;
2679        my $context     = $self->getElement($path, $pos) or return undef;
2680        my $tag         = shift         or return undef;
2681        my $expr        = $self->inputTextConversion(shift);
2682        return undef unless defined $expr;
2683        my %opt         = @_;
2684
2685        my $prefix      = undef;
2686        if ($tag =~ /(.*):/)
2687                {
2688                $prefix = $1 || 'text';
2689                }
2690        else
2691                {
2692                $prefix = $context->ns_prefix() || 'text';
2693                $tag = $prefix . ':' . $tag;
2694                }
2695
2696        my %attr        = ();
2697        foreach my $k (keys %opt)
2698                {
2699                my $a = $self->inputTextConversion($opt{$k});
2700                $k = $prefix . ':' . $k         unless $k =~ /:/;
2701                $attr{$k} = $a;
2702                }
2703        %opt            = ();
2704
2705        return $context->mark("($expr)", $tag, { %attr });
2706        }
2707
2708#------------------------------------------------------------------------------
2709# creates a child element in place within an existing element
2710# at a given position or before/after a given substring
2711
2712sub     setChildElement
2713        {
2714        my $self        = shift;
2715        my $path        = shift;
2716        my $node        = (ref $path) ? $path : $self->getElement($path, shift)
2717                        or return undef;
2718        my $name        = shift or return undef;
2719        my %opt         = @_;
2720        if (defined $opt{'text'})
2721                {
2722                $opt{'replace'} = $opt{'capture'}
2723                                unless defined $opt{'replace'};
2724                delete $opt{'capture'};
2725                }
2726        my $newnode     = undef;
2727        my $function    = undef;
2728
2729        if (ref $name)
2730                {
2731                if      ((ref $name) eq 'CODE')
2732                        {
2733                        $function   = $name;
2734                        $name       = undef;
2735                        }
2736                else
2737                        {
2738                        $newnode    = $name;
2739                        }
2740                }
2741        else
2742                {
2743                unless ($name =~ /:/ || $name =~ /^#/)
2744                        {
2745                        my $prefix = $node->ns_prefix() || 'text';
2746                        $name = $prefix . ':' . $name;
2747                        }
2748                $newnode = OpenOffice::OODoc::XPath::new_element($name);
2749                }
2750
2751       	my $offset = $opt{'offset'} || 0;
2752	if (lc($offset) eq 'end')
2753		{
2754		unless ($function)
2755		        {
2756		        $newnode->paste_last_child($node);
2757		        }
2758		else
2759		        {
2760		        $newnode = &$function($self, $node, 'end');
2761		        }
2762		}
2763	elsif (lc($offset) eq 'start')
2764	        {
2765	        unless ($function)
2766	                {
2767	                $newnode->paste_first_child($node);
2768	                }
2769                else
2770                        {
2771                        $newnode = &$function($self, $node, 'start');
2772                        }
2773	        }
2774	else
2775		{
2776                my ($text_node, $start_pos, $end_pos, $match) =
2777                                        $self->textIndex($node, %opt);
2778                if ($text_node)
2779                        {
2780                        if (defined $opt{'replace'} || defined $opt{'capture'})
2781                                {
2782                                my $t = $text_node->text;
2783                                substr  (
2784                                        $t, $start_pos, $end_pos - $start_pos,
2785                                        ""
2786                                        );
2787                                $text_node->set_text($t);
2788                                unless ($function)
2789                                        {
2790                                        $newnode->paste_within
2791                                                ($text_node, $start_pos);
2792                                        $newnode->set_text($match)
2793                                                if defined $opt{'capture'};
2794                                        }
2795                                else
2796                                        {
2797                                        $newnode = &$function
2798                                                        (
2799                                                        $self,
2800                                                        $text_node,
2801                                                        $start_pos,
2802                                                        $match
2803                                                        );
2804                                        }
2805                                }
2806                        else
2807                                {
2808                                my $p = defined $opt{'after'} ?
2809                                                $end_pos : $start_pos;
2810                                unless ($function)
2811                                        {
2812                                        $newnode->paste_within($text_node, $p);
2813                                        }
2814                                else
2815                                        {
2816                                        $newnode = &$function
2817                                                        (
2818                                                        $self,
2819                                                        $text_node,
2820                                                        $p,
2821                                                        $match
2822                                                        );
2823                                        }
2824                                }
2825                        }
2826                else
2827                        {
2828                        return undef;
2829                        }
2830		}
2831
2832        if ($newnode)
2833                {
2834                $self->setAttributes($newnode, %{$opt{'attributes'}});
2835                $self->setText($newnode, $opt{'text'})
2836                                unless is_true($opt{'no_text'});
2837                }
2838        return $newnode;
2839        }
2840
2841#------------------------------------------------------------------------------
2842# create successive child elements
2843
2844sub     setChildElements
2845        {
2846        my $self        = shift;
2847        my $path        = shift;
2848        my $pos         = (ref $path) ? undef : shift;
2849        my $element     = $self->getElement($path, $pos) or return undef;
2850        my $name        = shift or return undef;
2851        my %opt         = @_;
2852
2853        my @elements    = ();
2854        my $node        = $self->setChildElement($element, $name, %opt);
2855        push @elements, $node if $node;
2856
2857        if (defined $opt{'text'})
2858                {
2859                $opt{'replace'} = $opt{'capture'}
2860                                unless defined $opt{'replace'};
2861                delete $opt{'capture'};
2862                }
2863
2864        delete $opt{'attributes'};
2865        delete $opt{'text'};
2866        delete $opt{'offset'} if
2867                (
2868                defined $opt{'after'}   ||
2869                defined $opt{'before'}  ||
2870                defined $opt{'replace'} ||
2871                defined $opt{'capture'}
2872                );
2873        $opt{'offset'} = 1 if
2874                (
2875                    ($opt{'way'} ne 'backward' && defined $opt{'before'})
2876                        ||
2877                    ($opt{'way'} eq 'backward' && defined $opt{'after'})
2878                );
2879
2880        while ($node)
2881                {
2882                my $arg = ref($name) eq 'CODE' ? $name : $node->copy;
2883                $node = $self->setChildElement
2884                                ($element, $arg, %opt, start_mark => $node);
2885                push @elements, $node if $node;
2886                }
2887
2888        return @elements;
2889        }
2890
2891#------------------------------------------------------------------------------
2892
2893sub     markElement
2894        {
2895        my $self        = shift;
2896        my $context     = shift         or return undef;
2897        my $tag         = shift;
2898        my $expression  = $self->inputTextConversion(shift);
2899        my %attr        = @_;
2900
2901        return $context->mark("($expression)", $tag, { %attr });
2902        }
2903
2904#------------------------------------------------------------------------------
2905# inserts a new element before or after a given node
2906
2907sub	insertElement
2908	{
2909	my $self	= shift;
2910	my $path	= shift;
2911	my $pos		= (ref $path) ? undef : shift;
2912	my $name	= shift;
2913	my %opt		= @_;
2914	$opt{'attributes'} = $opt{'attribute'} unless $opt{'attributes'};
2915
2916	return undef	unless $name;
2917	my $element	= undef;
2918	unless (ref $name)
2919		{
2920		$element	= $self->createElement($name, $opt{'text'});
2921		}
2922	else
2923		{
2924		$element	= $name;
2925		$self->setText($element, $opt{'text'})	if $opt{'text'};
2926		}
2927	return undef	unless $element;
2928
2929	my $posnode	= $self->getElement($path, $pos, $opt{'context'});
2930	unless ($posnode)
2931		{
2932		warn "[" . __PACKAGE__ . "::insertElement] Unknown position\n";
2933		return undef;
2934		}
2935
2936	if ($opt{'position'})
2937		{
2938		if ($opt{'position'} eq 'after')
2939			{
2940			$element->paste_after($posnode);
2941			}
2942		elsif ($opt{'position'} eq 'before')
2943			{
2944			$element->paste_before($posnode);
2945			}
2946		elsif ($opt{'position'} eq 'within')
2947			{
2948			my $offset = $opt{'offset'} || 0;
2949			$element->paste_within($posnode, $offset);
2950			}
2951		else
2952			{
2953			warn	"[" . __PACKAGE__ . "::insertElement] "	.
2954				"Invalid $opt{'position'} option\n";
2955			return undef;
2956			}
2957		}
2958	else
2959		{
2960		$element->paste_before($posnode);
2961		}
2962
2963	$self->setAttributes($element, %{$opt{'attributes'}});
2964
2965	return $element;
2966	}
2967
2968#------------------------------------------------------------------------------
2969# removes the given element & children
2970
2971sub	removeElement
2972	{
2973	my $self	= shift;
2974
2975	my $e	= $self->getElement(@_);
2976	return undef	unless $e;
2977	return $e->delete;
2978	}
2979
2980#------------------------------------------------------------------------------
2981# cuts the given element & children (to be pasted elsewhere)
2982
2983sub	cutElement
2984	{
2985	my $self	= shift;
2986
2987	my $e	= $self->getElement(@_);
2988	return undef	unless $e;
2989	$e->cut;
2990
2991	return $e;
2992	}
2993
2994#-----------------------------------------------------------------------------
2995# splits a text element at a given offset
2996
2997sub	splitElement
2998	{
2999	my $self	= shift;
3000	my $path	= shift;
3001	my $old_element	=
3002		(ref $path) ? $path : $self->getElement($path, shift);
3003	my $offset	= shift;
3004
3005	my $new_element = $old_element->split_at($offset);
3006	$new_element->set_atts($old_element->atts);
3007	return wantarray ? ($old_element, $new_element) : $new_element;
3008	}
3009
3010#------------------------------------------------------------------------------
3011# get/set ODF element identifier
3012
3013sub     getIdentifier
3014        {
3015        my $self        = shift;
3016	my $path	= shift;
3017	my $element	=
3018		(ref $path) ? $path : $self->getElement($path, shift);
3019	return $self->outputTextConversion($element->getID());
3020        }
3021
3022sub     setIdentifier
3023        {
3024        my $self        = shift;
3025	my $path	= shift;
3026	my $element	=
3027		(ref $path) ? $path : $self->getElement($path, shift);
3028	my $value       = shift;
3029	return (defined $value) ?
3030	        $self->inputTextConversion($element->setID($value))     :
3031	        $self->removeIdentifier($element);
3032        }
3033
3034sub     identifier
3035        {
3036        my $self        = shift;
3037	my $path	= shift;
3038	my $element	=
3039		(ref $path) ? $path : $self->getElement($path, shift);
3040	my $value       = shift;
3041        return (defined $value) ?
3042                $self->setIdentifier($element, $value)  :
3043                $self->getIdentifier($element);
3044        }
3045
3046sub     removeIdentifier
3047        {
3048        my $self        = shift;
3049	my $path	= shift;
3050	my $element	=
3051		(ref $path) ? $path : $self->getElement($path, shift);
3052	return $element->setID();
3053        }
3054
3055sub     getElementName
3056        {
3057        my $self        = shift;
3058        my $path        = shift;
3059	my $element	=
3060		(ref $path) ? $path : $self->getElement($path, shift);
3061        my $attr        = $element->ns_prefix() . ':name';
3062        return $self->getAttribute($element, $attr);
3063        }
3064
3065sub     setElementName
3066        {
3067        my $self        = shift;
3068        my $path        = shift;
3069	my $element	=
3070		(ref $path) ? $path : $self->getElement($path, shift);
3071        my $attr        = $element->ns_prefix() . ':name';
3072        return $self->setAttribute($element, $attr => shift);
3073        }
3074
3075sub     elementName
3076        {
3077        my $self        = shift;
3078	my $path	= shift;
3079	my $element	=
3080		(ref $path) ? $path : $self->getElement($path, shift);
3081	my $value       = shift;
3082        return (defined $value) ?
3083                $self->setElementName($element, $value)  :
3084                $self->getElementName($element);
3085        }
3086
3087#------------------------------------------------------------------------------
3088# some extensions for XML Twig elements
3089package	OpenOffice::OODoc::Element;
3090our @ISA	= qw ( XML::Twig::Elt );
3091#------------------------------------------------------------------------------
3092
3093BEGIN   {
3094	*identifier             = *ID;
3095	*getPrefix              = *XML::Twig::Elt::ns_prefix;
3096	*getNodeValue           = *XML::Twig::Elt::text;
3097	*getValue               = *XML::Twig::Elt::text;
3098	*setNodeValue           = *XML::Twig::Elt::set_text;
3099	*getAttribute           = *XML::Twig::Elt::att;
3100	*setName                = *XML::Twig::Elt::set_tag;
3101	*getParentNode          = *XML::Twig::Elt::parent;
3102	*getDescendantTextNodes = *getTextDescendants;
3103	*dispose                = *XML::Twig::Elt::delete;
3104        }
3105
3106sub	hasTag
3107	{
3108	my $node	= shift;
3109	my $name	= $node->getName;
3110	my $value	= shift;
3111	return ($name && ($name eq $value)) ? 1 : undef;
3112	}
3113
3114sub	isFrame
3115	{
3116	my $node	= shift;
3117	return $node->hasTag('draw:frame');
3118	}
3119
3120sub	getLocalPosition
3121	{
3122	my $node	= shift;
3123	my $tag		= (shift || $node->getName) or return undef;
3124	my $xpos	= $node->pos($tag);
3125	return defined $xpos ? $xpos - 1 : undef;
3126	}
3127
3128sub     selectChildElements
3129        {
3130        my $node        = shift;
3131        my $filter      = shift;
3132        my $condition   = ref $filter ? $filter : qr($filter);
3133        return $node->children($condition);
3134        }
3135
3136sub	selectChildElement
3137	{
3138	my $node	= shift;
3139	my $filter	= shift;
3140	my $pos		= shift || 0;
3141
3142	my $count	= 0;
3143	my $fc = $node->first_child;
3144	return $fc unless defined $filter;
3145	my $name = $fc->name if $fc;
3146	while ($fc)
3147		{
3148		if ($name && ($name =~ /$filter/))
3149			{
3150			return $fc if ($count >= $pos);
3151			$count++;
3152			}
3153		$fc = $fc->next_sibling;
3154		$name = $fc->name if $fc;
3155		}
3156	return undef;
3157	}
3158
3159sub	getFirstChild
3160	{
3161	my $node	= shift;
3162	my $fc = $node->first_child(@_);
3163	my $name = $fc->name if $fc;
3164	while ($name && ($name =~ /^#/))
3165		{
3166		$fc = $fc->next_sibling(@_);
3167		$name = $fc->name if $fc;
3168		}
3169	return $fc;
3170	}
3171
3172sub	getLastChild
3173	{
3174	my $node	= shift;
3175	my $lc = $node->last_child(@_);
3176	my $name = $lc->name;
3177	while ($name && ($name =~ /^#/))
3178		{
3179		$lc = $lc->prev_sibling(@_);
3180		$name = $lc->name;
3181		}
3182	return $lc;
3183	}
3184
3185sub     getChildrenTextNodes
3186        {
3187        my $node        = shift;
3188        return $node->children('#PCDATA');
3189        }
3190
3191sub     getChildTextNode
3192        {
3193        my $node        = shift;
3194        my $pos         = shift || 0;
3195        my @children    = $node->children('#PCDATA');
3196        return $children[$pos];
3197        }
3198
3199sub	getTextDescendants
3200	{
3201	my ($node, $filter)     = @_;
3202	return  defined $filter ?
3203	        $node->get_xpath('#PCDATA[string()=~/' . $filter . '/]') :
3204	        $node->descendants('#PCDATA');
3205	}
3206
3207sub     textLength      # length of a text node
3208        {
3209        my $node        = shift;
3210        my $text        = $node->text;
3211        my $length      = length($text);
3212        return wantarray ? ($length, $text) : $length;
3213        }
3214
3215sub	appendChild
3216	{
3217	my $node	= shift;
3218	my $child	= shift;
3219	unless (ref $child)
3220		{
3221		$child = OpenOffice::OODoc::XPath::new_element($child, @_);
3222		}
3223	return $child->paste_last_child($node);
3224	}
3225
3226sub	pickUpChildren
3227	{
3228	my $parent	= shift;
3229	my @children	= @_;
3230	foreach my $child (@children)
3231		{
3232		$child->move(last_child => $parent);
3233		}
3234	return $parent;
3235	}
3236
3237sub	insertNewNode
3238	{
3239	my $node	= shift;
3240	my $newnode	= shift or return undef;
3241	my $position	= shift;	# 'before', 'after', 'within', ...
3242	my $offset	= shift;
3243	unless (ref $newnode)
3244		{
3245		$newnode = OpenOffice::OODoc::XPath::new_element($newnode, @_);
3246		}
3247	if (defined $offset)
3248		{
3249		return $newnode->paste($position => $node, $offset);
3250		}
3251	else
3252		{
3253		return $newnode->paste($position => $node);
3254		}
3255	}
3256
3257sub     insertNodes
3258        {
3259        my $node        = shift;
3260        my $offset      = shift;
3261        my $child       = shift         or return undef;
3262        $child->paste_within($node, $offset);
3263        my $count = 1;
3264        while (@_)
3265                {
3266                my $next_child = shift;
3267                $next_child->paste_after($child);
3268                $child = $next_child;
3269                $count++;
3270                }
3271        return $count;
3272        }
3273
3274sub	replicateNode
3275	{
3276	my $node	= shift;
3277	my $number	= shift;
3278	$number = 1 unless defined $number;
3279	my $position	= shift || 'after';
3280	my $last_node	= $node;
3281	while ($number > 0)
3282		{
3283		my $newnode	= $node->copy;
3284		$newnode->paste($position => $last_node);
3285		$last_node	= $newnode;
3286		$number--;
3287		}
3288	return $last_node;
3289	}
3290
3291sub	flatten
3292	{
3293	my $node	= shift;
3294	return $node->set_text($node->text);
3295	}
3296
3297sub	appendTextChild
3298	{
3299	my $node	= shift;
3300	my $text	= shift;
3301	return undef unless defined $text;
3302	my $text_node	= OpenOffice::OODoc::Element->new('#PCDATA' => $text);
3303	return $text_node->paste_last_child($node);
3304	}
3305
3306sub	insertTextChild
3307	{
3308	my $node	= shift;
3309	my $text	= shift;
3310	return undef unless defined $text;
3311	my $offset	= shift;
3312	return $node->appendTextChild($text) unless defined $offset;
3313	my $text_node	= OpenOffice::OODoc::Element->new('#PCDATA' => $text);
3314	return $offset > 0 ?
3315	        $text_node->paste_within($node, $offset)        :
3316	        $text_node->paste_first_child($node);
3317	}
3318
3319sub	getAttributes
3320	{
3321	my $node	= shift;
3322	return %{$node->atts(@_) || {}};
3323	}
3324
3325sub	setAttribute
3326	{
3327	my $node	= shift or return undef;
3328	my $attribute	= shift;
3329	my $value	= shift;
3330	if (defined $value)
3331		{
3332		return $node->set_att($attribute, $value, @_);
3333		}
3334	else
3335		{
3336		return $node->removeAttribute($attribute);
3337		}
3338	}
3339
3340sub     setID
3341        {
3342        my $node        = shift;
3343        return $node->setAttribute($ELT_ID, shift);
3344        }
3345
3346sub     getID
3347        {
3348        my $node        = shift;
3349        return $node->getAttribute($ELT_ID);
3350        }
3351
3352sub     ID
3353        {
3354        my $node        = shift;
3355        my $new_id      = shift;
3356        return (defined $new_id) ? $node->setID($new_id) : $node->getID();
3357        }
3358
3359sub	removeAttribute
3360	{
3361	my $node	= shift or return undef;
3362	my $attribute	= shift or return undef;
3363	return $node->att($attribute) ? $node->del_att($attribute) : undef;
3364	}
3365
3366#------------------------------------------------------------------------------
33671;
3368