File Coverage

blib/lib/ODF/lpOD/Element.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

line	stmt	sub	time	code
1				#=============================================================================
2				#
3				# Copyright (c) 2010 Ars Aperta, Itaapy, Pierlis, Talend.
4				# Copyright (c) 2014 Jean-Marie Gouarné.
5				# Author: Jean-Marie Gouarné
6				#
7				#=============================================================================
8	2	2	37	use 5.010_001;
	2		8
	2		81
9	2	2	11	use strict;
	2		3
	2		62
10	2	2	9	use experimental 'smartmatch';
	2		3
	2		12
11				#=============================================================================
12				# Base ODF element class and some derivatives
13				#=============================================================================
14				package ODF::lpOD::Element;
15				our $VERSION = '1.015';
16	2	2	146	use constant PACKAGE_DATE => '2014-04-30T08:27:41';
	2		4
	2		114
17	2	2	12	use ODF::lpOD::Common;
	2		4
	2		1456
18				#-----------------------------------------------------------------------------
19	2	2	3406	use XML::Twig 3.34;
	0
	0
20				use base 'XML::Twig::Elt';
21				#=== element classes =========================================================
22
23				our %CLASS =
24				(
25				'#PCDATA' => odf_text_node,
26				'text:p' => odf_paragraph,
27				'text:h' => odf_heading,
28				'text:span' => odf_text_element,
29				'text:a' => odf_text_hyperlink,
30				'text:bibliography-mark' => odf_bibliography_mark,
31				'text:note' => odf_note,
32				'office:annotation' => odf_annotation,
33				'text:changed-region' => odf_changed_region,
34				'text:section' => odf_section,
35				'text:list' => odf_list,
36				'table:table' => odf_table,
37				'table:table-column-group' => odf_column_group,
38				'table:table-header-columns' => odf_column_group,
39				'table:table-row-group' => odf_row_group,
40				'table:table-header-rows' => odf_row_group,
41				'table:table-column' => odf_column,
42				'table:table-row' => odf_row,
43				'table:table-cell' => odf_cell,
44				'table:covered-table-cell' => odf_cell,
45				'text:variable-decl' => odf_simple_variable,
46				'text:user-field-decl' => odf_user_variable,
47				'draw:page' => odf_draw_page,
48				'draw:rect' => odf_rectangle,
49				'draw:ellipse' => odf_ellipse,
50				'draw:line' => odf_line,
51				'draw:connector' => odf_connector,
52				'draw:frame' => odf_frame,
53				'draw:image' => odf_image,
54				'manifest:file-entry' => odf_file_entry,
55				'style:font-face' => odf_font_declaration,
56				'style:style' => odf_style,
57				'style:default-style' => odf_style,
58				'text:list-style' => odf_list_style,
59				'text:list-level-style-number' => odf_list_level_style,
60				'text:list-level-style-bullet' => odf_list_level_style,
61				'text:list-level-style-image' => odf_list_level_style,
62				'text:outline-level-style' => odf_list_level_style,
63				'text:outline-style' => odf_outline_style,
64				'style:master-page' => odf_master_page,
65				'style:page-layout' => odf_page_layout,
66				'draw:gradient' => odf_gradient,
67				'style:presentation-page-layout'
68				=> odf_presentation_page_layout,
69				'style:header-style' => odf_page_end_style,
70				'style:footer-style' => odf_page_end_style,
71				'text:table-of-content' => odf_toc,
72				'table:named-range' => odf_named_range
73				);
74
75				sub get_class_map { %CLASS }
76				sub associate_tag
77				{
78				my $caller = shift;
79				my $class = ref($caller) \|\| $caller;
80				$CLASS{$_} = $class for @_;
81				}
82
83				#=== aliases and initialization ==============================================
84
85				BEGIN
86				{
87				create = new;
88				xe_new = XML::Twig::Elt::new;
89				get_tag = XML::Twig::Elt::tag;
90				get_tagname = XML::Twig::Elt::tag;
91				del_attributes = XML::Twig::Elt::del_atts;
92				get_children = XML::Twig::Elt::children;
93				get_descendants = XML::Twig::Elt::descendants;
94				get_parent = XML::Twig::Elt::parent;
95				get_ancestor = XML::Twig::Elt::parent;
96				previous_sibling = XML::Twig::Elt::prev_sibling;
97				ungroup = XML::Twig::Elt::erase;
98				get_root = XML::Twig::Elt::root;
99				is_element = XML::Twig::Elt::is_elt;
100				is_text_segment = XML::Twig::Elt::is_text;
101				_set_text = XML::Twig::Elt::set_text;
102				_get_text = XML::Twig::Elt::text;
103				_set_tag = XML::Twig::Elt::set_tag;
104				_set_first_child = XML::Twig::Elt::set_first_child;
105				_set_last_child = XML::Twig::Elt::set_last_child;
106				replace_element = XML::Twig::Elt::replace;
107				set_child = set_first_child;
108				get_element_list = get_elements;
109				get_bookmark_list = get_bookmarks;
110				get_index_mark_list = get_index_marks;
111				get_bibliography_mark_list = get_bibliography_marks;
112				get_table_list = get_tables;
113				get_draw_page_list = get_draw_pages;
114				get_part = lpod_part;
115				document_part = lpod_part;
116				get_document_part = lpod_part;
117				get_document = document;
118				get_document_type = document_type;
119				export = serialize;
120				}
121
122				#=== exported constructor ====================================================
123
124				sub _create { ODF::lpOD::Element->new(@_) }
125
126				#-----------------------------------------------------------------------------
127
128				our $INIT_CALLBACK = undef;
129
130				sub new
131				{
132				my $caller = shift;
133				my $class = ref($caller) \|\| $caller;
134				my $data = shift or return undef;
135				my $element;
136				if (ref $data \|\| $data =~ /\.xml$/i) # load from file
137				{
138				$data = load_file($data);
139				}
140				$data =~ s/^\s+//;
141				$data =~ s/\s+$//;
142				if ($data =~ /^
143				{
144				return ODF::lpOD::Element->parse_xml($data, @_);
145				}
146				# odf_element creation
147				return undef unless $data;
148				$element = $class->SUPER::new($data, @_);
149				# possible subclassing according to the tag
150				my $tag = $element->tag;
151				if ($CLASS{$tag})
152				{
153				bless $element, $CLASS{$tag};
154				}
155				elsif ($tag =~ /^number:.*-style$/)
156				{
157				bless $element, 'ODF::lpOD::DataStyle';
158				}
159				# optional user-defined post-constructor function
160				if ($INIT_CALLBACK && (caller() eq 'XML::Twig'))
161				{
162				&$INIT_CALLBACK($element);
163				}
164				return $element;
165				}
166
167				#-----------------------------------------------------------------------------
168
169				sub parse_xml
170				{
171				state $twig;
172				unless ($twig)
173				{
174				$twig = XML::Twig->new
175				(
176				elt_class => 'ODF::lpOD::Element',
177				output_encoding => TRUE,
178				id => $ODF::lpOD::Common::LPOD_ID
179				);
180				$twig->set_output_encoding('UTF-8');
181				}
182				my $class = shift;
183				$twig->safe_parse(@_) or return undef;
184				my $element = $twig->root;
185				$element->set_classes;
186				return $element;
187				}
188
189				sub clone
190				{
191				my $self = shift;
192				my $class = ref $self;
193				my $elt = $self->copy;
194				return bless $elt, $class;
195				}
196
197				#-----------------------------------------------------------------------------
198
199				sub convert { FALSE }
200				sub context_path {}
201
202				sub set_tag
203				{
204				my $self = shift;
205				my $tag = shift;
206				$self->_set_tag($tag);
207				bless $self, $CLASS{$tag} \|\| 'ODF::lpOD::Element';
208				$self->set_class;
209				return $tag;
210				}
211
212				sub set_class
213				{
214				my $self = shift;
215				my $prefix = $self->ns_prefix or return $self;
216				if ($prefix eq 'text')
217				{
218				ODF::lpOD::TextField::classify($self);
219				}
220				return $self;
221				}
222
223				sub set_classes
224				{
225				my $self = shift;
226				foreach my $e ($self->descendants_or_self)
227				{
228				my $class;
229				next if $e->isa('ODF::lpOD::TextNode');
230				my $tag = $e->tag;
231				if ($tag =~ /^number:.*style$/)
232				{
233				$class = 'ODF::lpOD::Style';
234				}
235				$class \|\|= $CLASS{$tag};
236				$class \|\|= 'ODF::lpOD::Element';
237				bless $e, $class;
238				$e->set_class;
239				}
240				return $self;
241				}
242
243				sub check_tag
244				{
245				my $self = shift;
246				my $new_tag = shift;
247				my $old_tag = $self->tag;
248				return $old_tag unless $new_tag;
249				unless ($new_tag eq $old_tag)
250				{
251				$self->set_tag($new_tag);
252				}
253				return $self->tag;
254				}
255
256				sub is
257				{
258				my $self = shift;
259				my $classname = shift;
260				unless (ref($classname))
261				{
262				return (
263				$self->isa($classname) \|\| $classname eq $self->tag
264				) ? TRUE : FALSE;
265				}
266				if (ref($classname) eq 'Regexp')
267				{
268				my $tag = $self->tag;
269				return ($tag =~ $classname) ? TRUE : FALSE;
270				}
271				else
272				{
273				alert("Wrong reference");
274				return undef;
275				}
276				}
277
278				sub set_id
279				{
280				my $self = shift;
281				return $self->set_attribute('id' => shift);
282				}
283
284				sub get_id
285				{
286				my $self = shift;
287				return $self->get_attribute('id');
288				}
289
290				sub is_child
291				{
292				my $self = shift;
293				my $ref_elt = shift;
294				my $parent = $self->parent;
295				return ($parent && $parent == $ref_elt) ? TRUE : FALSE;
296				}
297
298				sub get_child
299				{
300				my $self = shift;
301				my $tag = $self->normalize_name(shift) or return undef;
302				return $self->first_child($tag);
303				}
304
305				sub set_first_child
306				{
307				my $self = shift;
308				return $self->_set_first_child(@_) if caller() eq 'XML::Twig::Elt';
309				my $tag = $self->normalize_name(shift);
310				my $child = $self->first_child($tag)
311				//
312				$self->insert_element($tag);
313				$child->set_text(shift);
314				$child->set_attributes(@_);
315				return $child;
316				}
317
318				sub set_last_child
319				{
320				my $self = shift;
321				return $self->_set_last_child(@_) if caller() eq 'XML::Twig::Elt';
322				my $tag = $self->normalize_name(shift);
323				my $child = $self->first_child($tag)
324				//
325				$self->append_element($tag);
326				$child->set_text(shift);
327				$child->set_attributes(@_);
328				return $child;
329				}
330
331				sub set_parent
332				{
333				my $self = shift;
334				my $tag = $self->normalize_name(shift);
335				my $parent = $self->parent;
336
337				if ($parent)
338				{
339				unless ($parent->is($tag))
340				{
341				$parent = ODF::lpOD::Element->create($tag);
342				$parent->paste(before => $self);
343				$self->move(first_child => $parent);
344				}
345				}
346				else
347				{
348				$parent = ODF::lpOD::Element->create($tag);
349				$self->move(first_child => $parent);
350				}
351
352				$parent->set_text(shift);
353				$parent->set_attributes(@_);
354				return $parent;
355				}
356
357				sub delete_child
358				{
359				my $self = shift;
360				my $child = $self->get_child(shift) or return FALSE;
361				$child->delete;
362				return TRUE;
363				}
364
365				sub delete_children
366				{
367				my $self = shift;
368				my @children= $self->children(shift);
369				my $count = 0;
370				foreach my $e (@children)
371				{
372				$e->delete; $count++;
373				}
374				return $count;
375				}
376
377				sub import_children
378				{
379				my $self = shift;
380				my $source = shift or return FALSE;
381				my $count = 0;
382				foreach my $e ($source->children(shift))
383				{
384				$e->clone->paste_last_child($self); $count++
385				}
386				return $count;
387				}
388
389				sub substitute_children
390				{
391				my $self = shift;
392				my $source = shift or return FALSE;
393				$self->delete_children(@_);
394				return $self->import_children($source, @_);
395				}
396
397				sub replace_child
398				{
399				my $self = shift;
400				my $tag = $self->normalize_name(shift) or return undef;
401				$self->delete_child($tag);
402				my $child = $self->insert_element($tag);
403				$child->set_text(shift);
404				$child->set_attributes(@_);
405				return $child;
406				}
407
408				sub next
409				{
410				my $self = shift;
411				my $context = shift;
412				my $tag = $self->get_tag;
413				unless ($context)
414				{
415				return $self->next_sibling($tag);
416				}
417				return $self->next_elt($context, $tag);
418				}
419
420				sub previous
421				{
422				my $self = shift;
423				my $context = shift;
424				my $tag = $self->get_tag;
425				unless ($context)
426				{
427				return $self->previous_sibling($tag);
428				}
429				return $self->prev_elt($self, $tag);
430				}
431
432				sub get_class
433				{
434				my $self = shift;
435				return Scalar::Util::blessed($self);
436				}
437
438				sub get_children_elements
439				{
440				my $self = shift;
441				return $self->children(qr'^[^#]');
442				}
443
444				sub get_descendant_elements
445				{
446				my $self = shift;
447				return $self->descendants(qr'^[^#]');
448				}
449
450				sub group
451				{
452				my $self = shift;
453				my @elts = @_;
454				$_->move(last_child => $self) for @elts;
455				}
456
457				sub node_info
458				{
459				my $self = shift;
460				my %i = ();
461				$i{text} = $self->_get_text;
462				$i{size} = length($i{text});
463				$i{tag} = $self->tag;
464				$i{class} = $self->get_class;
465				$i{attributes} = $self->get_attributes;
466				return %i;
467				}
468
469				sub has_text
470				{
471				my $self = shift;
472				return $self->has_child(TEXT_SEGMENT) ? TRUE : FALSE;
473				}
474
475				sub is_text_container
476				{
477				my $self = shift;
478				my $name = $self->tag;
479				return $name =~ /^text:(p\|h\|span)$/ ? TRUE : FALSE;
480				}
481
482				sub normalize_name
483				{
484				my $self = shift;
485				my $name = shift // return undef;
486				$name =~ s/^\s+//;
487				$name =~ s/\s+$//;
488				return $name if $name =~ /^
489				$name .= ' name' if $name eq 'style';
490				if ($name && ! ref $name)
491				{
492				unless ($name =~ /[:#]/)
493				{
494				my $prefix = $self->ns_prefix;
495				$name = $prefix . ':' . $name if $prefix;
496				}
497				$name =~ s/[ _]/-/g;
498				}
499				return $name;
500				}
501
502				sub repeat
503				{
504				my $self = shift;
505				unless ($self->parent)
506				{
507				alert "Repeat not allowed for root elements";
508				return FALSE;
509				}
510				my $r = shift;
511				return undef unless defined $r;
512
513				my $count = 0;
514				while ($r > 1)
515				{
516				my $elt = $self->clone;
517				$elt->paste_after($self);
518				$count++; $r--;
519				}
520				return $count;
521				}
522
523				sub set_lpod_mark
524				{
525				state $count = 0;
526				my $self = shift;
527				my %opt = @_;
528
529				my $id;
530				if (defined $opt{id})
531				{
532				$id = $opt{id}; delete $opt{id};
533				}
534				else
535				{
536				$id = lpod_common->new_id;
537				}
538
539				my $e = $self->insert_element($ODF::lpOD::Common::LPOD_MARK, %opt);
540				$e->set_attribute($ODF::lpOD::Common::LPOD_ID, $id);
541				return $id;
542				}
543
544				sub ro
545				{
546				my $self = shift;
547				my $ro = shift;
548				unless (defined $ro)
549				{
550				return $self->att('#lpod:ro') // FALSE;
551				}
552				elsif (is_true($ro))
553				{
554				$self->set_att('#lpod:ro', TRUE);
555				}
556				else
557				{
558				$self->del_att('#lpod:ro') if $self->att('#lpod:ro');
559				return undef;
560				}
561				}
562
563				sub rw
564				{
565				my $self = shift;
566				my $rw = shift;
567				unless (defined $rw)
568				{
569				return is_false($self->att('#lpod:ro'));
570				}
571				elsif (is_true($rw))
572				{
573				$self->del_att('#lpod:ro') if $self->att('#lpod:ro');
574				return TRUE;
575				}
576				elsif (is_false($rw))
577				{
578				$self->set_att('#lpod:ro', TRUE);
579				return FALSE;
580				}
581				}
582
583				sub get_lpod_mark
584				{
585				my $self = shift;
586				my $id = shift;
587				return $self->get_element
588				(
589				$ODF::lpOD::Common::LPOD_MARK,
590				attribute => $ODF::lpOD::Common::LPOD_ID,
591				value => $id
592				);
593				}
594
595				sub remove_lpod_mark
596				{
597				my $self = shift;
598				my $mark = $self->get_lpod_mark(shift);
599				if ($mark)
600				{
601				$mark->delete; return TRUE;
602				}
603				return FALSE;
604				}
605
606				sub remove_lpod_marks
607				{
608				my $self = shift;
609				$_->delete()
610				for $self->get_elements($ODF::lpOD::Common::LPOD_MARK);
611				}
612
613				sub set_lpod_id
614				{
615				my $self = shift;
616				return $self->set_att($ODF::lpOD::Common::LPOD_ID, shift);
617				}
618
619				sub remove_lpod_id
620				{
621				my $self = shift;
622				return $self->del_att($ODF::lpOD::Common::LPOD_ID);
623				}
624
625				sub strip_lpod_id
626				{
627				my $self = shift;
628				return $self->strip_att($ODF::lpOD::Common::LPOD_ID);
629				}
630
631				sub lpod_part
632				{
633				my $self = shift;
634				my $part = shift;
635				if ($part)
636				{
637				return $self->set_att($ODF::lpOD::Common::LPOD_PART, $part);
638				}
639				else
640				{
641				return
642				$self->att($ODF::lpOD::Common::LPOD_PART) \|\|
643				$self->root->att($ODF::lpOD::Common::LPOD_PART);
644				}
645				}
646
647				sub document
648				{
649				my $self = shift;
650				my $part = $self->lpod_part or return undef;
651				return $part->document;
652				}
653
654				sub document_type
655				{
656				my $self = shift;
657				my $doc = $self->document or return undef;
658				return $doc->get_type;
659				}
660
661				#-----------------------------------------------------------------------------
662
663				sub text_segments
664				{
665				my $self = shift;
666				my %opt =
667				(
668				deep => FALSE,
669				@_
670				);
671				return (is_true($opt{deep})) ?
672				$self->descendants(TEXT_SEGMENT) :
673				$self->children(TEXT_SEGMENT);
674				}
675
676				sub search_in_text_segment
677				{
678				my $self = shift;
679				unless ($self->is_text)
680				{
681				alert("Not in text segment");
682				return undef;
683				}
684				return search_string($self->get_text, @_);
685				}
686
687				sub replace_in_text_segment
688				{
689				my $self = shift;
690				my $expr = shift;
691				my $repl = shift;
692
693				my ($content, $change_count) = search_string
694				($self->get_text, $expr, replace => $repl, @_);
695				$self->set_text($content) if $change_count;
696				return $change_count;
697				}
698
699				#--- generic element retrieval method ----------------------------------------
700
701				sub _get_elements
702				{
703				my $self = shift;
704				my $tag = shift;
705				if (ref $tag)
706				{
707				return $self->descendants($tag);
708				}
709				my %opt =
710				(
711				content => undef,
712				attribute => undef,
713				position => undef,
714				@_
715				);
716				$tag = $self->normalize_name($tag);
717				my $xpath = './/' . ($tag // "");
718
719				if (defined $opt{attribute})
720				{
721				my $a = $opt{attribute};
722				my $v = input_conversion($opt{value});
723				$a =~ s/[ _]/-/g;
724				unless ($a =~ /:/)
725				{
726				$tag =~ /^(.*):/; $a = $1 . ':' . $a;
727				}
728				$xpath .= '[@' . $a . '="' . $v . '"]';
729				}
730
731				my $pos = $opt{position};
732				my $expr = $opt{content};
733				unless (defined $opt{content})
734				{
735				return defined $pos ?
736				$self->get_xpath($xpath, $pos) :
737				$self->get_xpath($xpath);
738				}
739				else
740				{
741				my $elt;
742				my @elts = ();
743				my $count = 0;
744				unless (defined $pos)
745				{
746				foreach $elt ($self->get_xpath($xpath))
747				{
748				push @elts, $elt if $elt->count_matches($expr);
749				}
750				return @elts;
751				}
752				elsif ($pos >= 0)
753				{
754				foreach $elt ($self->get_xpath($xpath))
755				{
756				if ($elt->count_matches($expr))
757				{
758				$count++;
759				return $elt if $count > $pos;
760				}
761				}
762				return undef;
763				}
764				else
765				{
766				foreach $elt ($self->get_xpath($xpath))
767				{
768				push @elts, $elt if $elt->count_matches($expr);
769				}
770				my $size = scalar @elts;
771				return ($size >= abs($pos)) ? $elts[$pos] : undef;
772				}
773				}
774				}
775
776				sub get_element
777				{
778				my $self = shift;
779				my $tag = shift;
780				my %opt = @_;
781				$opt{position} //= 0;
782				if ($opt{bookmark})
783				{
784				return $self->get_element_by_bookmark
785				($opt{bookmark}, tag => $tag);
786				}
787				return $self->_get_elements($tag, %opt);
788				}
789
790				sub get_element_by_id
791				{
792				my $self = shift;
793				my $tag = shift;
794				return $self->get_element($tag, attribute => 'id', value => shift);
795				}
796
797				sub get_element_by_name
798				{
799				my $self = shift;
800				my $name = shift;
801				unless ($name)
802				{
803				alert "Missing object name"; return undef;
804				}
805				return $self->get_element($name, attribute => 'name', value => shift);
806				}
807
808				sub get_elements
809				{
810				my $self = shift;
811				my $tag = shift;
812				my %opt = @_;
813				delete $opt{position};
814				return $self->_get_elements($tag, %opt);
815				}
816
817				#--- specific unnamed element retrieval methods ------------------------------
818
819				sub get_text_element
820				{
821				my $self = shift;
822				my %opt = @_;
823				my $type = $opt{type} // 'p';
824				delete $opt{type};
825				$type = 'text:' . $type unless $type =~ /:/;
826
827				if ($opt{bookmark})
828				{
829				return $self->get_element_by_bookmark
830				($opt{bookmark}, tag => $type);
831				}
832				unless (defined $opt{style})
833				{
834				return $self->get_element($type, %opt);
835				}
836				else
837				{
838				return $self->get_element
839				(
840				$type,
841				attribute => 'style name',
842				value => $opt{style},
843				position => $opt{position},
844				content => $opt{content}
845				);
846				}
847				}
848
849				sub get_paragraph
850				{
851				my $self = shift;
852				return $self->get_text_element(type => 'p', @_);
853				}
854
855				sub get_text_span
856				{
857				my $self = shift;
858				return $self->get_text_element(type => 'span', @_);
859				}
860
861				sub get_parent_paragraph
862				{
863				my $self = shift;
864				return $self->parent(qr'text:(p\|h)');
865				}
866
867				sub get_text_elements
868				{
869				my $self = shift;
870				my %opt = @_;
871				my $type = $opt{type} // 'p';
872				delete $opt{type};
873				$type = 'text:' . $type unless $type =~ /:/;
874
875				if ($opt{style})
876				{
877				$opt{attribute} = 'style name';
878				$opt{value} = $opt{style};
879				delete $opt{style};
880				}
881				return $self->get_elements($type, %opt);
882				}
883
884				sub get_paragraphs
885				{
886				my $self = shift;
887				return $self->get_text_elements(type => 'p', @_);
888				}
889
890				sub get_text_spans
891				{
892				my $self = shift;
893				return $self->get_text_elements(type => 'span', @_);
894				}
895
896				sub get_heading
897				{
898				my $self = shift;
899				my %opt = @_;
900				if ($opt{bookmark})
901				{
902				return $self->get_element_by_bookmark
903				($opt{bookmark}, tag => 'text:h');
904				}
905				if (defined $opt{level})
906				{
907				$opt{attribute} = 'outline level';
908				$opt{value} = $opt{level};
909				delete $opt{level};
910				}
911				return $self->get_element('text:h', %opt);
912				}
913
914				sub get_headings
915				{
916				my $self = shift;
917				my %opt = @_;
918				unless (is_true($opt{all}))
919				{
920				if (defined $opt{level})
921				{
922				$opt{attribute} = 'outline level';
923				$opt{value} = $opt{level};
924				delete $opt{level};
925				}
926				return $self->get_elements('text:h', %opt);
927				}
928				else
929				{
930				unless (defined $opt{level})
931				{
932				return $self->get_elements('text:h');
933				}
934				my @headings = ();
935				my $h = $self->first_child('text:h');
936				while ($h)
937				{
938				my $l = $h->get_level;
939				push @headings, $h if $l > 0 and $l <= $opt{level};
940				$h = $h->next_sibling('text:h');
941				}
942				return @headings;
943				}
944				}
945
946				sub get_hyperlinks
947				{
948				my $self = shift;
949				my %opt = @_;
950				my $type = $opt{type};
951				delete $opt{type};
952				unless ($type)
953				{
954				return (
955				$self->get_hyperlinks(type => 'text', %opt),
956				$self->get_hyperlinks(type => 'draw', %opt)
957				);
958				}
959				if (defined $opt{url})
960				{
961				$opt{attribute} = 'xlink:href';
962				$opt{value} = $opt{url};
963				delete $opt{url};
964				}
965				return $self->get_elements("$type:a", %opt);
966				}
967
968				sub get_list
969				{
970				my $self = shift;
971				return $self->get_element('text:list', @_);
972				}
973
974				sub get_list_by_id
975				{
976				my $self = shift;
977				return $self->get_list(attribute => 'xml:id', value => shift);
978				}
979
980				sub get_lists
981				{
982				my $self = shift;
983				return $self->get_elements('text:list', @_);
984				}
985
986				sub get_fields
987				{
988				my $self = shift;
989				my $type = shift;
990				unless ($type)
991				{
992				my @elts;
993				for (ODF::lpOD::TextField->types)
994				{
995				push @elts, $self->get_fields($_);
996				}
997				return @elts;
998				}
999				return $self->get_elements('text:' . $type);
1000				}
1001
1002				#--- table retrieval ---------------------------------------------------------
1003
1004				sub get_table
1005				{
1006				my $self = shift;
1007				my $arg = shift // 0;
1008				return is_numeric($arg) ?
1009				$self->get_table_by_position($arg, @_) :
1010				$self->get_table_by_name($arg, @_);
1011				}
1012
1013				sub get_parent_table
1014				{
1015				my $self = shift;
1016				return $self->parent('table:table');
1017				}
1018
1019				sub get_parent_cell
1020				{
1021				my $self = shift;
1022				return $self->parent('table:table-cell');
1023				}
1024
1025				sub get_tables
1026				{
1027				my $self = shift;
1028				return $self->get_elements('table:table', @_);
1029				}
1030
1031				sub get_table_by_name
1032				{
1033				my $self = shift;
1034				my $name = shift;
1035				return $self->get_element_by_name('table:table', $name);
1036				}
1037
1038				sub get_table_by_position
1039				{
1040				my $self = shift;
1041				my $position = shift \|\| 0;
1042				return $self->get_element('table:table', position => $position);
1043				}
1044
1045				sub get_table_by_content
1046				{
1047				my $self = shift;
1048				my $expr = shift;
1049				unless (defined $expr)
1050				{
1051				alert "Missing search expression";
1052				return FALSE;
1053				}
1054				foreach my $t ($self->get_tables(@_))
1055				{
1056				foreach my $n ($t->descendants(TEXT_SEGMENT))
1057				{
1058				my $text = $n->get_text() or next;
1059				return $t;
1060				}
1061				}
1062				return FALSE;
1063				}
1064
1065				#--- check & retrieval tools for bookmarks, index marks ----------------------
1066
1067				sub get_position_mark
1068				{
1069				my $self = shift;
1070				my $tag = $self->normalize_name(shift);
1071				my $name = shift;
1072				my $role = shift;
1073				unless ($name)
1074				{
1075				alert ("Name is mandatory for position mark retrieval");
1076				return FALSE;
1077				}
1078				my $attr = $tag =~ /bookmark\|reference-mark/ ?
1079				'text:name' : 'text:id';
1080				my %opt = (attribute => $attr, value => $name);
1081				given ($role)
1082				{
1083				when (undef)
1084				{
1085				my $single = $self->get_element($tag, %opt);
1086				unless ($single)
1087				{
1088				my $start = $self->get_element
1089				($tag . '-start', %opt);
1090				my $end = $self->get_element
1091				($tag . '-end', %opt);
1092				return wantarray ? ($start, $end) : $start;
1093				}
1094				return $single;
1095				}
1096				when (/^(start\|end)$/)
1097				{
1098				return $self->get_element($tag . '-' . $_, %opt);
1099				}
1100				default
1101				{
1102				alert "Wrong role $role";
1103				return FALSE;
1104				}
1105				}
1106				}
1107
1108				sub check_position_mark
1109				{
1110				my $self = shift;
1111				my $tag = shift;
1112				my $name = shift;
1113
1114				my %opt = (attribute => 'text:name', value => $name);
1115
1116				return TRUE if $self->get_element($tag, %opt);
1117
1118				my $start = $self->get_position_mark($tag, $name, 'start')
1119				or return FALSE;
1120				my $end = $self->get_position_mark($tag, $name, 'end')
1121				or return FALSE;
1122				return $start->before($end) ? TRUE : FALSE;
1123				}
1124
1125				sub remove_position_mark
1126				{
1127				my $self = shift;
1128				my $tag = shift;
1129				my $name = shift;
1130
1131				my %opt = (attribute => 'text:name', value => $name);
1132
1133				my $single = $self->get_element($tag, %opt);
1134				if ($single)
1135				{
1136				$single->delete;
1137				return TRUE;
1138				}
1139
1140				my $start = $self->get_position_mark($tag, $name, 'start')
1141				or return FALSE;
1142				my $end = $self->get_position_mark($tag, $name, 'end')
1143				or return FALSE;
1144				$start->delete;
1145				$end->delete;
1146				return TRUE;
1147				}
1148
1149				#--- text mark retrieval stuff -----------------------------------------------
1150
1151				sub get_bookmark
1152				{
1153				my $self = shift;
1154				return $self->get_position_mark('text:bookmark', shift);
1155				}
1156
1157				sub get_bookmarks
1158				{
1159				my $self = shift;
1160				return $self->get_elements(qr'bookmark$\|bookmark-start$');
1161				}
1162
1163				sub get_reference_mark
1164				{
1165				my $self = shift;
1166				return $self->get_position_mark('text:reference-mark', shift);
1167				}
1168
1169				sub get_reference_marks
1170				{
1171				my $self = shift;
1172				return $self->get_elements(qr'reference-mark$\|reference-mark-start$');
1173				}
1174
1175				sub get_index_marks
1176				{
1177				my $self = shift;
1178				my $type = shift;
1179
1180				my $filter;
1181				given ($type)
1182				{
1183				when (undef)
1184				{
1185				alert "Missing index mark type";
1186				}
1187				when (["lexical", "alphabetical"])
1188				{
1189				$filter = 'alphabetical-index-mark';
1190				}
1191				when ("toc")
1192				{
1193				$filter = 'toc-mark';
1194				}
1195				when ("user")
1196				{
1197				$filter = 'user-index-mark';
1198				}
1199				default
1200				{
1201				alert "Wrong index mark type";
1202				}
1203				}
1204				return FALSE unless $filter;
1205				$filter = $filter . '$\|' . $filter . '-start$';
1206				return $self->get_elements(qr($filter));
1207				}
1208
1209				sub clean_marks
1210				{
1211				my $self = shift;
1212				my $count = 0;
1213				my ($tag, $start, $end, $att, $id);
1214				foreach $start ($self->get_elements(qr'mark-start$'))
1215				{
1216				$tag = $start->get_tag;
1217				$att = $tag =~ /bookmark/ ? 'text:name' : 'text:id';
1218				$id = $start->get_attribute($att);
1219				unless ($id)
1220				{
1221				$start->delete; $count++;
1222				next;
1223				}
1224				$tag =~ s/start$/end/;
1225				$end = $self->get_element
1226				($tag, attribute => $att, value => $id);
1227				unless ($end)
1228				{
1229				$start->delete; $count++;
1230				next;
1231				}
1232				unless ($start->before($end))
1233				{
1234				$start->delete; $end->delete; $count += 2;
1235				}
1236				}
1237				foreach $end ($self->get_elements(qr'mark-end$'))
1238				{
1239				$tag = $end->get_tag;
1240				$att = $tag =~ /bookmark/ ? 'text:name' : 'text:id';
1241				$id = $end->get_attribute($att);
1242				unless ($id)
1243				{
1244				$end->delete; $count++;
1245				next;
1246				}
1247				$tag =~ s/end$/start/;
1248				$start = $self->get_element
1249				($tag, attribute => $att, value => $id);
1250				unless ($start)
1251				{
1252				$end->delete; $count++;
1253				next;
1254				}
1255				unless ($end->after($start))
1256				{
1257				$start->delete; $end->delete; $count += 2;
1258				}
1259				}
1260				return $count;
1261				}
1262
1263				sub remove_bookmark
1264				{
1265				my $self = shift;
1266				return $self->remove_position_mark('text:bookmark', shift);
1267				}
1268
1269				sub check_bookmark
1270				{
1271				my $self = shift;
1272				return $self->check_position_mark('text:bookmark', shift);
1273				}
1274
1275				sub get_element_by_bookmark
1276				{
1277				my $self = shift;
1278				my $name = shift;
1279				my %opt = @_;
1280
1281				my $bookmark = $self->get_position_mark
1282				('text:bookmark', $name, $opt{role});
1283				unless ($bookmark)
1284				{
1285				alert("Bookmark not found"); return FALSE;
1286				}
1287				if ($opt{tag})
1288				{
1289				return $bookmark->get_ancestor($opt{tag});
1290				}
1291				return $bookmark->parent;
1292				}
1293
1294				sub get_paragraph_by_bookmark
1295				{
1296				my $self = shift;
1297				my $name = shift;
1298				my %opt = @_;
1299				$opt{tag} = qr'text:(p\|h)';
1300				return $self->get_element_by_bookmark($name, %opt);
1301				}
1302
1303				sub get_bookmark_text
1304				{
1305				my $self = shift;
1306				my ($start, $end) = $self->get_bookmark(shift);
1307				unless ($start && $end && $start->before($end))
1308				{
1309				alert "The required bookmark in not defined in the context";
1310				return undef;
1311				}
1312				my $text = "";
1313				my $n = $start->next_elt($self, TEXT_SEGMENT);
1314				while ($n && $n->before($end))
1315				{
1316				$text .= $n->get_text;
1317				$n = $n->next_elt($self, TEXT_SEGMENT);
1318				}
1319				return $text;
1320				}
1321
1322				sub remove_reference_mark
1323				{
1324				my $self = shift;
1325				return $self->remove_position_mark('text:reference-mark', shift);
1326				}
1327
1328				sub check_reference_mark
1329				{
1330				my $self = shift;
1331				return $self->check_position_mark('text:reference-mark', shift);
1332				}
1333
1334				sub get_bibliography_marks
1335				{
1336				my $self = shift;
1337				my $text = shift;
1338				return defined $text ?
1339				$self->get_elements
1340				(
1341				'text:bibliography-mark',
1342				attribute => 'identifier',
1343				value => $text
1344				)
1345				:
1346				$self->get_elements('text:bibliography-mark');
1347				}
1348
1349				#--- note retrieval ----------------------------------------------------------
1350
1351				sub get_note
1352				{
1353				my $self = shift;
1354				my $id = shift;
1355				unless ($id)
1356				{
1357				alert "Missing note identifier"; return FALSE;
1358				}
1359				return $self->get_element(
1360				'text:note',
1361				attribute => 'id',
1362				value => $id
1363				);
1364				}
1365
1366				sub get_notes
1367				{
1368				my $self = shift;
1369				my %opt = process_options(@_);
1370				my $class = $opt{class} \|\| $opt{note_class};
1371				my $label = $opt{label};
1372				my $citation = $opt{citation};
1373
1374				my $xp = './/text:note';
1375				$xp .= '[@text:note-class="' . $class . '"]' if defined $class;
1376				if (defined $label \|\| defined $citation)
1377				{
1378				$xp .= '/text:note-citation';
1379				$xp .= '[@text:label="' . $label . '"]'
1380				if defined $label;
1381				$xp .= '[string()="' . $citation . '"]'
1382				if defined $citation;
1383				my @result = ();
1384				foreach my $n ($self->get_xpath($xp))
1385				{
1386				push @result, $n->parent;
1387				}
1388				return @result;
1389				}
1390				return $self->get_xpath($xp);
1391				}
1392
1393				sub get_annotations
1394				{
1395				my $self = shift;
1396				my %opt = @_;
1397				my $date = $opt{date};
1398				my $author = $opt{author};
1399
1400				my $xp = './/office:annotation';
1401				$xp .= '[@dc:date="' . $date . '"]' if $date;
1402				$xp .= '[@dc:creator="' . $author . '"]' if $author;
1403
1404				return $self->get_xpath($xp);
1405				}
1406
1407				#--- tracked change retrieval ------------------------------------------------
1408
1409				sub get_changes
1410				{
1411				my $self = shift;
1412				my %opt = @_;
1413				my $context = $self;
1414
1415				unless ($opt{date} \|\| $opt{author})
1416				{
1417				return $context->get_elements('text:changed-region');
1418				}
1419
1420				my @r = ();
1421				foreach my $ci ($context->descendants('text:changed-region'))
1422				{
1423				my ($elt, $text);
1424				if ($opt{date})
1425				{
1426				$elt = $ci->first_descendant('dc:date') or next;
1427				$text = $elt->get_text or next;
1428				if (ref $opt{date})
1429				{
1430				my $start = ${opt{date}}[0];
1431				my $end = ${opt{date}}[1];
1432				next if $start && ($text lt $start);
1433				next if $end && ($text gt $end);
1434				}
1435				else
1436				{
1437				next unless $text eq $opt{date};
1438				}
1439				}
1440				if ($opt{author})
1441				{
1442				$elt = $ci->first_descendant('dc:creator') or next;
1443				$text = $elt->get_text;
1444				next unless $text eq $opt{author};
1445				}
1446				push @r, $ci;
1447				}
1448				return @r;
1449				}
1450
1451				sub get_change
1452				{
1453				my $self = shift;
1454				return $self->get_element(
1455				'text:changed-region',
1456				attribute => 'id',
1457				value => shift
1458				);
1459				}
1460
1461				#--- section retrieval -------------------------------------------------------
1462
1463				sub get_section
1464				{
1465				my $self = shift;
1466				return $self->get_element
1467				('text:section', attribute => 'text:name', value => shift);
1468				}
1469
1470				sub get_sections
1471				{
1472				my $self = shift;
1473				return $self->get_elements('text:section', @_);
1474				}
1475
1476				sub get_parent_section
1477				{
1478				my $self = shift;
1479				return $self->parent('text:section');
1480				}
1481
1482				#--- frame & draw page retrieval ---------------------------------------------
1483
1484				sub get_shape
1485				{
1486				my $self = shift;
1487				my $type = shift;
1488				$type = 'draw:' . $type unless $type =~ /:/;
1489				return $self->get_element(
1490				$type, attribute => 'draw:name', value => shift
1491				);
1492				}
1493
1494				sub get_rectangle
1495				{
1496				my $self = shift; return $self->get_shape('rect', @_);
1497				}
1498
1499				sub get_rectangles
1500				{
1501				my $self = shift; return $self->get_elements('draw:rect', @_);
1502				}
1503
1504				sub get_ellipse
1505				{
1506				my $self = shift; return $self->get_shape('ellipse', @_);
1507				}
1508
1509				sub get_ellipses
1510				{
1511				my $self = shift; return $self->get_elements('draw:ellipse', @_);
1512				}
1513
1514				sub get_line
1515				{
1516				my $self = shift; return $self->get_shape('line', @_);
1517				}
1518
1519				sub get_lines
1520				{
1521				my $self = shift; return $self->get_elements('draw:line', @_);
1522				}
1523
1524				sub get_connector
1525				{
1526				my $self = shift; return $self->get_shape('connector', @_);
1527				}
1528
1529				sub get_connectors
1530				{
1531				my $self = shift; return $self->get_elements('draw:connector', @_);
1532				}
1533
1534				sub get_frame
1535				{
1536				my $self = shift; return $self->get_shape('frame', @_);
1537				}
1538
1539				sub get_parent_frame
1540				{
1541				my $self = shift;
1542				return $self->parent('draw:frame');
1543				}
1544
1545				sub get_frames
1546				{
1547				my $self = shift; return $self->get_elements('draw:frame', @_);
1548				}
1549
1550				sub get_draw_page_by_position
1551				{
1552				my $self = shift;
1553				return $self->get_element('draw:page', position => shift);
1554				}
1555
1556				sub get_draw_page_by_name
1557				{
1558				my $self = shift;
1559				return $self->get_element(
1560				'draw:page', attribute => 'name', value => shift
1561				);
1562				}
1563
1564				sub get_draw_page
1565				{
1566				my $self = shift;
1567				my $arg = shift;
1568				return $self->get_element(
1569				'draw:page', attribute => 'id', value => $arg
1570				) \|\|
1571				$self->get_draw_page_by_name($arg);
1572				}
1573
1574				sub get_draw_pages
1575				{
1576				my $self = shift; return $self->get_elements('draw:page', @_);
1577				}
1578
1579				#-----------------------------------------------------------------------------
1580
1581				sub get_attribute
1582				{
1583				my $self = shift;
1584				my $name = $self->normalize_name(shift) or return undef;
1585				my $value = $self->att($name);
1586				return output_conversion($value);
1587				}
1588
1589				sub get_attributes
1590				{
1591				my $self = shift;
1592				return undef unless $self->is_element;
1593				my $atts = $self->atts or return undef;
1594				my %attr = %{$atts};
1595				my %result = ();
1596				$result{$_} = output_conversion($attr{$_}) for keys %attr;
1597
1598				return wantarray ? %result : { %result };
1599				}
1600
1601				sub set_attribute
1602				{
1603				my $self = shift;
1604				my $name = $self->normalize_name(shift) or return undef;
1605				my $value = input_conversion(shift);
1606				if ($name =~ /color$/)
1607				{
1608				$value = color_code($value);
1609				}
1610				return defined $value ?
1611				$self->set_att($name, $value) : $self->del_attribute($name);
1612				}
1613
1614				sub set_boolean_attribute
1615				{
1616				my $self = shift;
1617				my ($name, $value) = @_;
1618				$value = odf_boolean($value);
1619				return $self->set_attribute($name, $value);
1620				}
1621
1622				sub get_boolean_attribute
1623				{
1624				my $self = shift;
1625				my $value = $self->get_attribute(shift);
1626				given ($value)
1627				{
1628				when (undef)
1629				{
1630				return undef;
1631				}
1632				when ('true')
1633				{
1634				return TRUE;
1635				}
1636				when ('false')
1637				{
1638				return FALSE;
1639				}
1640				default
1641				{
1642				alert("Improper ODF boolean");
1643				return undef;
1644				}
1645				}
1646				}
1647
1648				sub input_convert_attributes
1649				{
1650				my $self = shift;
1651				my $in = shift;
1652				my %out = ();
1653				my $prefix = $self->ns_prefix;
1654				foreach my $kin (keys %{$in})
1655				{
1656				my $kout = $kin;
1657				unless ($kout =~ /:/)
1658				{
1659				$kout = $prefix . ':' . $kout;
1660				}
1661				$kout =~ s/ /-/g;
1662				$out{$kout} = input_conversion($in->{$kin});
1663				}
1664				return wantarray ? %out : { %out };
1665				}
1666
1667				sub set_attributes
1668				{
1669				my $self = shift;
1670				my $attr = shift or return undef;
1671				my %attr = ref $attr ? %{$attr} : ($attr, @_);
1672
1673				foreach my $k (keys %attr)
1674				{
1675				$self->set_attribute($k, $attr{$k});
1676				}
1677				return $self->get_attributes;
1678				}
1679
1680				sub del_attribute
1681				{
1682				my $self = shift;
1683				my $name = $self->normalize_name(shift);
1684				return $self->att($name) ? $self->del_att($name) : FALSE;
1685				}
1686
1687				sub clear
1688				{
1689				my $self = shift;
1690				return $self->_set_text('');
1691				}
1692
1693				sub get_text
1694				{
1695				my $self = shift;
1696				my %opt = (recursive => FALSE, @_);
1697				my $text = undef;
1698				unless ($self->is_element)
1699				{
1700				$text = $self->text;
1701				}
1702				elsif (is_true($opt{recursive}))
1703				{
1704				foreach my $t ($self->descendants(TEXT_SEGMENT))
1705				{
1706				$text .= $t->text;
1707				}
1708				}
1709				else
1710				{
1711				$text = $self->text_only;
1712				}
1713				return output_conversion($text);
1714				}
1715
1716				sub set_text
1717				{
1718				my $self = shift;
1719				my $input = shift;
1720				return undef unless defined $input;
1721
1722				my $text = caller() ne 'XML::Twig::Elt' ?
1723				input_conversion($input) : $input;
1724				my $r = $self->_set_text($text);
1725				bless $_, 'ODF::lpOD::TextNode' for $self->children(TEXT_SEGMENT);
1726				return $r;
1727				}
1728
1729				sub get_text_content
1730				{
1731				my $self = shift;
1732				my $t = "";
1733				foreach my $p ($self->descendants('text:p'))
1734				{
1735				$t .= ($p->get_text(@_) // "");
1736				}
1737				return $t;
1738				}
1739
1740				sub set_text_content
1741				{
1742				my $self = shift;
1743				my $text = shift;
1744				my %opt = @_;
1745
1746				my @paragraphs = $self->descendants('text:p');
1747				my $p = shift @paragraphs;
1748				unless (defined $p)
1749				{
1750				$p = ODF::lpOD::Element->create('text:p');
1751				$p->paste_first_child($self);
1752				}
1753				else
1754				{
1755				$_->delete() for @paragraphs;
1756				}
1757				$p->set_style($opt{style}) if $opt{style};
1758				return $p->set_text($text);
1759				}
1760
1761				sub get_family {}
1762
1763				sub get_name
1764				{
1765				my $self = shift;
1766				return $self->get_attribute('name');
1767				}
1768
1769				sub set_name
1770				{
1771				my $self = shift;
1772				my $name = shift;
1773				return undef unless defined $name;
1774				return caller() eq 'XML::Twig::Elt' ?
1775				$self->set_tag($name) :
1776				$self->set_attribute('name' => $name);
1777				}
1778
1779				sub get_size
1780				{
1781				my $self = shift;
1782				my $sep = shift // ', ';
1783				my $w = $self->get_attribute('svg:width');
1784				my $h = $self->get_attribute('svg:height');
1785				return undef unless (defined $w && defined $h);
1786				return wantarray ? ($w, $h) : join $sep, $w, $h;
1787				}
1788
1789				sub set_size
1790				{
1791				my $self = shift;
1792				my ($w, $h) = input_2d_value(@_);
1793				$self->set_attribute('svg:width' => $w);
1794				$self->set_attribute('svg:height' => $h);
1795				return $self->get_size;
1796				}
1797
1798				sub get_display
1799				{
1800				my $self = shift;
1801				return is_true($self->get_attribute('display'));
1802				}
1803
1804				sub set_display
1805				{
1806				my $self = shift;
1807				return $self->set_attribute('display' => odf_boolean(shift));
1808				}
1809
1810				sub get_position
1811				{
1812				my $self = shift;
1813				my $sep = shift // ', ';
1814				my $x = $self->get_attribute('svg:x');
1815				my $y = $self->get_attribute('svg:y');
1816				return undef unless (defined $x && defined $y);
1817				if (wantarray)
1818				{
1819				return ($x, $y);
1820				}
1821				else {
1822				my $r;
1823				$r = join $sep, $x, $y if (defined $x && defined $y);
1824				return $r;
1825				}
1826				}
1827
1828				sub set_position
1829				{
1830				my $self = shift;
1831				my ($x, $y) = input_2d_value(@_);
1832				$self->set_attribute('svg:x' => $x);
1833				$self->set_attribute('svg:y' => $y);
1834				return $self->get_position;
1835				}
1836
1837				sub get_url
1838				{
1839				my $self = shift;
1840				return $self->get_attribute('xlink:href');
1841				}
1842
1843				sub set_url
1844				{
1845				my $self = shift;
1846				return $self->set_attribute('xlink:href' => shift);
1847				}
1848
1849				sub get_style
1850				{
1851				my $self = shift;
1852				return $self->get_attribute('style name');
1853				}
1854
1855				sub set_style
1856				{
1857				my $self = shift;
1858				my $style = shift;
1859				my $name;
1860				if (ref $style)
1861				{
1862				if ($style->isa('ODF::lpOD::Style'))
1863				{
1864				$name = $style->get_name;
1865				}
1866				else
1867				{
1868				alert "Wrong style"; return undef;
1869				}
1870				}
1871				else
1872				{
1873				$name = $style;
1874				}
1875				return $self->set_attribute('style name' => $name);
1876				}
1877
1878				sub insert_element
1879				{
1880				my $self = shift;
1881				my $tag = $self->normalize_name(shift) or return undef;
1882				my %opt =
1883				(
1884				position => 'FIRST_CHILD',
1885				@_
1886				);
1887				my $position = uc $opt{position};
1888				$position =~ s/ /_/g;
1889				my $new_elt;
1890				if (ref $tag)
1891				{
1892				if ($tag->parent && $position ne 'PARENT')
1893				{
1894				alert "Element already belonging to a tree";
1895				return FALSE;
1896				}
1897				$new_elt = $tag;
1898				}
1899				else
1900				{
1901				$new_elt = ODF::lpOD::Element->new($tag);
1902				}
1903				if (defined $opt{after})
1904				{
1905				$new_elt->paste_after($opt{after}); return $new_elt;
1906				}
1907				elsif (defined $opt{before})
1908				{
1909				$new_elt->paste_before($opt{before}); return $new_elt;
1910				}
1911
1912				given($position)
1913				{
1914				when (/^(FIRST_CHILD\|LAST_CHILD)$/)
1915				{
1916				$new_elt->paste((lc $position) => $self);
1917				}
1918				when ('NEXT_SIBLING')
1919				{
1920				$new_elt->paste_after($self);
1921				}
1922				when ('PREV_SIBLING')
1923				{
1924				$new_elt->paste_before($self);
1925				}
1926				when ('WITHIN')
1927				{
1928				if ($opt{offset})
1929				{
1930				$new_elt->paste_within($self, $opt{offset});
1931				}
1932				else
1933				{
1934				$new_elt->paste_first_child($self);
1935				}
1936				}
1937				when ('PARENT')
1938				{
1939				if ($self->parent)
1940				{
1941				$new_elt->paste_before($self);
1942				$self->move(last_child => $new_elt);
1943				}
1944				else
1945				{
1946				$self->paste_last_child($new_elt);
1947				}
1948				}
1949				default
1950				{
1951				alert("Wrong insertion option");
1952				return FALSE;
1953				}
1954				}
1955				return $new_elt;
1956				}
1957
1958				sub append_element
1959				{
1960				my $self = shift;
1961				return $self->insert_element(shift, position => 'LAST_CHILD');
1962				}
1963
1964				sub insert
1965				{
1966				my $self = shift;
1967				my $target = shift or return undef;
1968				return $target->insert_element($self, @_);
1969				}
1970
1971				sub append
1972				{
1973				my $self = shift;
1974				my $target = shift or return undef;
1975				return $target->append_element($self);
1976				}
1977
1978				sub set_comment
1979				{
1980				my $self = shift;
1981				unless ($self->parent)
1982				{
1983				alert "Not allowed in free element"; return undef;
1984				}
1985				my $text = input_conversion(shift);
1986				my $cmt = ODF::lpOD::Element->create('#COMMENT' => $text);
1987				$cmt->paste_before($self);
1988				return $cmt;
1989				}
1990
1991				sub set_annotation
1992				{
1993				my $self = shift;
1994				my $a = ODF::lpOD::Annotation->create(@_);
1995				$a->paste_first_child($self);
1996				return $a;
1997				}
1998
1999				sub serialize
2000				{
2001				my $self = shift;
2002				my %opt = process_options
2003				(
2004				empty_tags => EMPTY_TAGS,
2005				@_
2006				);
2007
2008				$opt{pretty} //= ($opt{indent} // lpod->debug);
2009				$self->set_pretty_print(PRETTY_PRINT) if is_true($opt{pretty});
2010				$self->set_empty_tag_style($opt{empty_tags});
2011				delete @opt{qw(pretty indent empty_tags)};
2012				return $self->sprint(%opt);
2013				}
2014
2015				#=============================================================================
2016
2017				sub _search_forward
2018				{
2019				my $self = shift;
2020				my $expr = shift;
2021				my %opt = (@_);
2022
2023				my $offset = $opt{offset};
2024
2025				my ($target_node, $n, $start_pos, $end_pos, $match);
2026				if ($self->is_text)
2027				{
2028				$n = $self;
2029				}
2030				elsif ($opt{start_mark})
2031				{
2032				if ($opt{start_mark}->is_text)
2033				{
2034				$n = $opt{start_mark};
2035				}
2036				else
2037				{
2038				$n = $opt{start_mark}
2039				->last_descendant
2040				->next_elt($self, TEXT_SEGMENT);
2041				}
2042				}
2043				else
2044				{
2045				$n = $self->first_descendant(TEXT_SEGMENT);
2046				}
2047				my %info = $n->node_info() if $n;
2048				if (defined $offset)
2049				{
2050				while ($n && $offset >= $info{size})
2051				{
2052				if ($opt{end_mark} && ! $n->before($opt{end_mark}))
2053				{
2054				$n = undef; last;
2055				}
2056				$offset -= $info{size};
2057				$n = $n->next_elt($self, TEXT_SEGMENT);
2058				%info = $n->node_info() if $n;
2059				}
2060				}
2061				while ($n && !defined $start_pos)
2062				{
2063				if ($opt{end_mark} && ! $n->before($opt{end_mark}))
2064				{
2065				$n = undef; last;
2066				}
2067				unless (defined $expr)
2068				{
2069				$start_pos = $offset;
2070				$match = defined $opt{range} ?
2071				substr($info{text}, $start_pos, $opt{range}) :
2072				substr($info{text}, $start_pos);
2073				$end_pos = $start_pos + length($match);
2074				}
2075				else
2076				{
2077				($start_pos, $end_pos, $match) =
2078				search_string
2079				(
2080				$info{text},
2081				$expr,
2082				offset => $offset,
2083				range => $opt{range}
2084				);
2085				}
2086				if (defined $start_pos)
2087				{
2088				$target_node = $n;
2089				}
2090				else
2091				{
2092				$n = $n->next_elt($self, TEXT_SEGMENT);
2093				%info = $n->node_info() if $n;
2094				$offset = 0;
2095				}
2096				}
2097				return wantarray ?
2098				($target_node, $start_pos, $match, $end_pos) :
2099				$start_pos;
2100				}
2101
2102				sub _search_backward
2103				{
2104				my $self = shift;
2105				my $expr = shift;
2106				my %opt = (@_);
2107
2108				my $offset = $opt{offset};
2109				if (defined $offset && $offset > 0)
2110				{
2111				$offset = -abs($offset);
2112				}
2113				my ($target_node, $n, $start_pos, $end_pos, $match);
2114
2115				if ($self->is_text)
2116				{
2117				$n = $self;
2118				}
2119				elsif ($opt{start_mark})
2120				{
2121				unless ($opt{start_mark}->is_text)
2122				{
2123				$n = $opt{start_mark}->prev_elt($self, TEXT_SEGMENT);
2124				}
2125				else
2126				{
2127				$n = $opt{start_mark};
2128				}
2129				}
2130				else
2131				{
2132				$n = $self->last_descendant(TEXT_SEGMENT);
2133				}
2134				my %info = $n->node_info() if $n;
2135				if (defined $offset)
2136				{
2137				while ($n && abs($offset) >= $info{size})
2138				{
2139				if ($opt{end_mark} && ! $n->after($opt{end_mark}))
2140				{
2141				$n = undef; last;
2142				}
2143				$offset += $info{size};
2144				$n = $n->prev_elt($self, TEXT_SEGMENT);
2145				%info = $n->node_info() if $n;
2146				}
2147				}
2148				while ($n && !defined $start_pos)
2149				{
2150				if ($opt{end_mark} && ! $n->before($opt{end_mark}))
2151				{
2152				$n = undef; last;
2153				}
2154				unless (defined $expr)
2155				{
2156				$start_pos = $offset;
2157				$match = defined $opt{range} ?
2158				substr($info{text}, $start_pos, $opt{range}) :
2159				substr($info{text}, $start_pos);
2160				$end_pos = $start_pos + length($match);
2161				}
2162				else
2163				{
2164				($start_pos, $end_pos, $match) =
2165				search_string
2166				(
2167				$info{text},
2168				$expr,
2169				offset => $offset,
2170				range => $opt{range}
2171				);
2172				}
2173				if (defined $start_pos)
2174				{
2175				$target_node = $n;
2176				}
2177				else
2178				{
2179				$n = $n->next_elt($self, TEXT_SEGMENT);
2180				%info = $n->node_info() if $n;
2181				$offset = 0;
2182				}
2183				}
2184				return wantarray ?
2185				($target_node, $start_pos, $match, $end_pos) :
2186				$start_pos;
2187				}
2188
2189				sub search
2190				{
2191				my $self = shift;
2192				my $expr = input_conversion(shift);
2193				my %opt = process_options
2194				(
2195				backward => FALSE,
2196				start_mark => undef,
2197				end_mark => undef,
2198				offset => undef,
2199				range => undef,
2200				@_
2201				);
2202				unless (defined $expr \|\| defined $opt{offset})
2203				{
2204				alert("Missing search argument");
2205				return undef;
2206				}
2207				my $backward = $opt{backward}; delete $opt{backward};
2208				if (defined $opt{offset} && $opt{offset} < 0)
2209				{
2210				$backward = TRUE;
2211				}
2212				my %r = ();
2213				my $match = undef;
2214				if(is_false($backward))
2215				{
2216				($r{segment}, $r{offset}, $match, $r{end}) =
2217				$self->_search_forward($expr, %opt);
2218				}
2219				else
2220				{
2221				($r{segment}, $r{offset}, $match, $r{end}) =
2222				$self->_search_backward($expr, %opt);
2223				}
2224				$r{match} = output_conversion($match);
2225				return wantarray ? %r : { %r };
2226				}
2227
2228				sub replace
2229				{
2230				my $self = shift;
2231				return $self->replace_element(@_) if caller() eq 'XML::Twig::Elt';
2232				my $expr = shift;
2233				my $repl = shift;
2234				return $self->count_matches($expr, @_) unless defined $repl;
2235				my %opt =
2236				(
2237				deep => TRUE,
2238				@_
2239				);
2240				my $deep = $opt{deep}; delete $opt{deep};
2241				my $count = 0;
2242				foreach my $segment ($self->text_segments(deep => $deep))
2243				{
2244				$count += $segment->replace_in_text_segment
2245				($expr, $repl, %opt);
2246				}
2247				return $count;
2248				}
2249
2250				sub count_matches
2251				{
2252				my $self = shift;
2253				my $expr = shift;
2254				my %opt =
2255				(
2256				deep => TRUE,
2257				@_
2258				);
2259				my $count = 0;
2260				foreach my $segment ($self->text_segments(deep => $opt{deep}))
2261				{
2262				my $t = $segment->get_text;
2263				$count += count_substrings($t, $expr);
2264				}
2265				return $count;
2266				}
2267
2268				#=============================================================================
2269
2270				our $AUTOLOAD;
2271
2272				sub AUTOLOAD
2273				{
2274				$AUTOLOAD =~ /(.:)(.)/;
2275				my $package = $1;
2276				my $method = $2;
2277				my $element = shift;
2278
2279				$method =~ /^([gs]et)_(.*)/;
2280				my $action = $1;
2281
2282				no strict;
2283				my $target = ${$package . "ATTRIBUTE"}{$2};
2284				use strict;
2285				unless ($action && $target)
2286				{
2287				alert "Unknown method $method @_";
2288				return undef;
2289				}
2290				my $name = $target->{attribute};
2291				my $type = $target->{type};
2292
2293				my $value = undef;
2294				given ($action)
2295				{
2296				when ('get')
2297				{
2298				$value = $element->get_attribute($name, @_);
2299				return ($type and ($type eq 'boolean')) ?
2300				is_true($value) : $value;
2301				}
2302				when ('set')
2303				{
2304				$value = input_conversion(shift);
2305				if ($type)
2306				{
2307				$value = check_odf_value($value, $type);
2308				}
2309				return defined $value ?
2310				$element->set_att($name => $value) :
2311				$element->del_attribute($name);
2312				}
2313				default
2314				{
2315				alert "Unknown method $method @_";
2316				}
2317				}
2318
2319				return undef;
2320				}
2321
2322				sub not_allowed
2323				{
2324				my $self = shift;
2325				my $tag = $self->get_tag;
2326				my $class = ref $self;
2327				alert "Not allowed for this $tag ($class) element";
2328				return undef;
2329				}
2330
2331				#=============================================================================
2332				package ODF::lpOD::TextNode;
2333				use base 'ODF::lpOD::Element';
2334				our $VERSION = '1.000';
2335				use constant PACKAGE_DATE => '2011-02-27T00:44:46';
2336				use ODF::lpOD::Common;
2337				#-----------------------------------------------------------------------------
2338
2339				BEGIN
2340				{
2341				create = XML::Twig::Elt::new;
2342				get_tag = XML::Twig::Elt::tag;
2343				set_tag = ODF::lpOD::Element::set_tag;
2344				set_text = ODF::lpOD::Element::set_text;
2345				get_parent = XML::Twig::Elt::parent;
2346				get_ancestor = XML::Twig::Elt::parent;
2347				previous_sibling = XML::Twig::Elt::prev_sibling;
2348				get_root = XML::Twig::Elt::root;
2349				is_element = XML::Twig::Elt::is_elt;
2350				is_text_segment = XML::Twig::Elt::is_text;
2351				_set_text = XML::Twig::Elt::set_text;
2352				_get_text = XML::Twig::Elt::text;
2353				_set_tag = XML::Twig::Elt::set_tag;
2354				replace_element = XML::Twig::Elt::replace;
2355				}
2356
2357				#-----------------------------------------------------------------------------
2358
2359				sub node_info
2360				{
2361				my $self = shift;
2362				my %i = ();
2363				$i{text} = $self->_get_text;
2364				$i{size} = length($i{text});
2365				$i{tag} = TEXT_SEGMENT;
2366				$i{class} = __PACKAGE__;
2367				$i{attributes} = undef;
2368				return %i;
2369				}
2370
2371				sub get_text
2372				{
2373				my $self = shift;
2374				return output_conversion($self->text);
2375				}
2376
2377				#=============================================================================
2378				package ODF::lpOD::BibliographyMark;
2379				use base 'ODF::lpOD::Element';
2380				our $VERSION = '1.000';
2381				use constant PACKAGE_DATE => '2010-12-24T13:37:35';
2382				#=============================================================================
2383				package ODF::lpOD::Note;
2384				use base 'ODF::lpOD::Element';
2385				our $VERSION = '1.002';
2386				use constant PACKAGE_DATE => '2011-02-22T00:16:40';
2387				use ODF::lpOD::Common;
2388				#-----------------------------------------------------------------------------
2389
2390				BEGIN {
2391				set_text = set_body;
2392				}
2393
2394				#-----------------------------------------------------------------------------
2395
2396				sub _create { ODF::lpOD::Note->create(@_) }
2397
2398				#-----------------------------------------------------------------------------
2399
2400				sub create
2401				{
2402				my $caller = shift;
2403				my $class = ref($caller) \|\| $caller;
2404				my $id = shift;
2405				unless ($id)
2406				{
2407				alert "Missing mandatory note identifier";
2408				return FALSE;
2409				}
2410				my %opt = process_options
2411				(
2412				class => 'footnote',
2413				@_
2414				);
2415				my $note = ODF::lpOD::Element->create('text:note');
2416				$note->set_id($id);
2417				$note->set_citation($opt{citation}, $opt{label});
2418				$note->{style} = $opt{style};
2419				if ($opt{body})
2420				{
2421				$note->set_body(@{$opt{body}});
2422				}
2423				else
2424				{
2425				$note->set_body($opt{text});
2426				}
2427
2428				return $note;
2429				}
2430
2431				#-----------------------------------------------------------------------------
2432
2433				sub get_citation
2434				{
2435				my $self = shift;
2436				my $c = $self->first_child('text:note-citation')
2437				or return undef;
2438				return $c->get_text;
2439				}
2440
2441				sub set_citation
2442				{
2443				my $self = shift;
2444				my $text = shift;
2445				my $label = shift;
2446				my $c = $self->set_child('text:note-citation');
2447				$c->set_attribute('label' => $label) if defined $label;
2448				$c->set_text($text);
2449				return $c;
2450				}
2451
2452				sub set_label
2453				{
2454				my $self = shift;
2455				my $label = shift;
2456				my $c = $self->set_child('text:note-citation');
2457				$c->set_attribute('label' => $label) if defined $label;
2458				return $c;
2459				}
2460
2461				sub get_label
2462				{
2463				my $self = shift;
2464				my $c = $self->first_child('text:note-citation')
2465				or return undef;
2466				return $c->get_attribute('label');
2467				}
2468
2469				sub get_body
2470				{
2471				my $self = shift;
2472				return $self->first_child('text:note-body');
2473				}
2474
2475				sub set_body
2476				{
2477				my $self = shift;
2478				my $body = $self->get_body();
2479				if ($body)
2480				{
2481				$body->cut_children;
2482				}
2483				else
2484				{
2485				$body = $self->append_element('text:note-body');
2486				}
2487				foreach my $arg (@_)
2488				{
2489				if (ref $arg)
2490				{
2491				$arg->paste_last_child($body);
2492				}
2493				else
2494				{
2495				my $p = ODF::lpOD::Paragraph->create(
2496				text => $arg, style => $self->{style}
2497				);
2498				$p->paste_last_child($body);
2499				}
2500				}
2501				return $body;
2502				}
2503
2504				#=============================================================================
2505				package ODF::lpOD::Annotation;
2506				use base 'ODF::lpOD::Element';
2507				our $VERSION = '1.002';
2508				use constant PACKAGE_DATE => '2011-02-15T11:16:59';
2509				use ODF::lpOD::Common;
2510				#-----------------------------------------------------------------------------
2511
2512				BEGIN {
2513				set_creator = set_author;
2514				get_creator = get_author;
2515				}
2516
2517				#-----------------------------------------------------------------------------
2518
2519				sub _create { ODF::lpOD::Annotation->create(@_) }
2520
2521				#-----------------------------------------------------------------------------
2522
2523				sub create
2524				{
2525				my $caller = shift;
2526				my %opt = @_;
2527				my $a = ODF::lpOD::Element->create('office:annotation');
2528				$a->set_date($opt{date});
2529				$a->set_author($opt{author});
2530				$a->set_style($opt{style});
2531				$a->set_size($opt{size}) if defined $opt{size};
2532				$a->set_position($opt{position}) if defined $opt{position};
2533				$a->set_display($opt{display});
2534				my $content = $opt{content};
2535				unshift @$content, $opt{text} if defined $opt{text};
2536				$a->set_content(@$content) if $content;
2537				return $a;
2538				}
2539
2540				#-----------------------------------------------------------------------------
2541
2542				sub set_date
2543				{
2544				my $self = shift;
2545				my $date = shift;
2546				my $elt = $self->set_child('dc:date');
2547				unless ($date)
2548				{
2549				return $elt->set_text(iso_date);
2550				}
2551				else
2552				{
2553				my $d = check_odf_value($date, 'date');
2554				unless ($d)
2555				{
2556				alert "Wrong date"; return undef;
2557				}
2558				return $elt->set_text($d);
2559				}
2560				}
2561
2562				sub get_date
2563				{
2564				my $self = shift;
2565				my $elt = $self->first_child('dc:date') or return undef;
2566				return $elt->get_text;
2567				}
2568
2569				sub set_author
2570				{
2571				my $self = shift;
2572				my $elt = $self->set_child('dc:creator');
2573				return $elt->set_text
2574				(
2575				shift
2576				//
2577				(scalar getlogin())
2578				//
2579				(scalar getpwuid($<))
2580				//
2581				$<
2582				);
2583				}
2584
2585				sub get_author
2586				{
2587				my $self = shift;
2588				my $elt = $self->first_child('dc:creator') or return undef;
2589				return $elt->get_text;
2590				}
2591
2592				sub get_content
2593				{
2594				my $self = shift;
2595				return $self->children;
2596				}
2597
2598				sub set_content
2599				{
2600				my $self = shift;
2601				$self->cut_children(qr'^text');
2602				foreach my $arg (@_)
2603				{
2604				if (ref $arg)
2605				{
2606				$arg->paste_last_child($self);
2607				}
2608				else
2609				{
2610				my $p = ODF::lpOD::Paragraph->create(
2611				text => $arg, style => $self->{style}
2612				);
2613				$p->paste_last_child($self);
2614				}
2615				}
2616				return $self->get_content;
2617				}
2618
2619				sub set_style
2620				{
2621				my $self = shift;
2622				return $self->{style} = shift;
2623				}
2624
2625				sub get_style
2626				{
2627				my $self = shift;
2628				return $self->{style};
2629				}
2630
2631				sub set_text
2632				{
2633				my $self = shift;
2634				return $self->set_content(@_);
2635				}
2636
2637				sub get_text
2638				{
2639				my $self = shift;
2640				return $self->get_text_content(@_);
2641				}
2642
2643				#=============================================================================
2644				package ODF::lpOD::ChangedRegion;
2645				use base 'ODF::lpOD::Element';
2646				our $VERSION = '1.000';
2647				use constant PACKAGE_DATE => '2010-12-24T13:39:17';
2648				use ODF::lpOD::Common;
2649				#-----------------------------------------------------------------------------
2650
2651				sub get_changed_context
2652				{
2653				my $self = shift;
2654				my $tcr = $self->parent('text:tracked-changes');
2655				my $context = $tcr ? $tcr->parent() : undef;
2656				unless ($context)
2657				{
2658				alert "Unknown tracked change context";
2659				}
2660				return $context;
2661				}
2662
2663				sub get_info
2664				{
2665				my $self = shift;
2666				my $tag = shift;
2667				$tag = 'dc:' . $tag unless $tag =~ /:/;
2668				my $info = $self->first_descendant($tag) or return undef;
2669				return $info->get_text;
2670				}
2671
2672				sub get_date
2673				{
2674				my $self = shift;
2675				return $self->get_info('date');
2676				}
2677
2678				sub get_author
2679				{
2680				my $self = shift;
2681				return $self->get_info('creator');
2682				}
2683
2684				sub get_type
2685				{
2686				my $self = shift;
2687				my $t = $self->first_child or return undef;
2688				my $type = $t->get_tag; $type =~ s/^text://;
2689				return $type;
2690				}
2691
2692				sub get_deleted_content
2693				{
2694				my $self = shift;
2695				my $deleted = $self->first_child('text:deletion') or return undef;
2696				my @content = ();
2697				foreach my $e ($deleted->children)
2698				{
2699				my $tag = $e->get_tag;
2700				push @content, $e unless $tag eq 'office:change-info';
2701				}
2702				return wantarray ? @content : [ @content ];
2703				}
2704
2705				sub get_change_mark
2706				{
2707				my $self = shift;
2708				my $id = $self->get_id;
2709				my $context = $self->get_changed_context or return undef;
2710				my $type = $self->get_type();
2711				unless ($type)
2712				{
2713				alert "Unknown change type"; return undef;
2714				}
2715				my $tag = ($type eq 'deletion') ? 'text:change' : 'text:change-start';
2716				return $context->get_element(
2717				$tag,
2718				attribute => 'change id',
2719				value => $id
2720				);
2721				}
2722
2723				sub get_insertion_marks
2724				{
2725				my $self = shift;
2726				my $id = $self->get_id;
2727				my $context = $self->get_changed_context or return undef;
2728				my $start = $context->get_element(
2729				'text:change-start',
2730				attribute => 'change id',
2731				value => $id
2732				);
2733				my $end = $context->get_element(
2734				'text:change-end',
2735				attribute => 'change id',
2736				value => $id
2737				);
2738				return wantarray ? ($start, $end) : [ $start, $end ];
2739				}
2740
2741				#=============================================================================
2742				package ODF::lpOD::FileEntry;
2743				use base 'ODF::lpOD::Element';
2744				our $VERSION = '1.000';
2745				use constant PACKAGE_DATE => '2010-12-24T13:39:36';
2746				use ODF::lpOD::Common;
2747				#-----------------------------------------------------------------------------
2748
2749				BEGIN {
2750				set_text = not_allowed;
2751				insert_element = not_allowed;
2752				append_element = not_allowed;
2753				}
2754
2755				#-----------------------------------------------------------------------------
2756
2757				our @ALLOWED_ATTRIBUTES = ('manifest:media-type', 'manifest:full-path');
2758
2759				sub set_attribute
2760				{
2761				my $self = shift;
2762				my $name = $self->normalize_name(shift);
2763				unless ($name ~~ [ @ALLOWED_ATTRIBUTES ])
2764				{
2765				alert "Attribute $name is not allowed";
2766				return FALSE;
2767				}
2768				return $self->SUPER::set_attribute($name, @_);
2769				}
2770
2771				sub get_path
2772				{
2773				my $self = shift;
2774				return $self->get_attribute('full path');
2775				}
2776
2777				sub set_path
2778				{
2779				my $self = shift;
2780				my $path = shift;
2781				unless ($path)
2782				{
2783				alert "Missing or wrong path"; return FALSE;
2784				}
2785				my $old_path = $self->get_path;
2786				my $lpod_part = $self->lpod_part;
2787				my $other = $lpod_part ? $lpod_part->get_entry($path) : undef;
2788				if ($other)
2789				{
2790				if ($other == $self)
2791				{
2792				return TRUE;
2793				}
2794				else
2795				{
2796				alert "Non unique entry path $path";
2797				return FALSE;
2798				}
2799				}
2800				$self->set_attribute('full path' => $path);
2801				if ($path =~ /.\/$/)
2802				{
2803				$self->set_attribute('media type' => "");
2804				}
2805				return TRUE;
2806				}
2807
2808				sub get_type
2809				{
2810				my $self = shift;
2811				return $self->get_attribute('media type');
2812				}
2813
2814				sub set_type
2815				{
2816				my $self = shift;
2817				my $type = shift;
2818				return $self->set_attribute('media type' => $type);
2819				}
2820
2821				#=============================================================================
2822				1;