ODF-lpOD/lpOD/Element.pm
#=============================================================================
#
# Copyright (c) 2010 Ars Aperta, Itaapy, Pierlis, Talend.
# Copyright (c) 2014 Jean-Marie Gouarné.
# Author: Jean-Marie Gouarné <jean.marie.gouarne@online.fr>
#
#=============================================================================
use 5.010_001;
use strict;
use experimental 'smartmatch';
#=============================================================================
# Base ODF element class and some derivatives
#=============================================================================
package ODF::lpOD::Element;
our $VERSION = '1.015';
use constant PACKAGE_DATE => '2014-04-30T08:27:41';
use ODF::lpOD::Common;
#-----------------------------------------------------------------------------
use XML::Twig 3.34;
use base 'XML::Twig::Elt';
#=== element classes =========================================================
our %CLASS =
(
'#PCDATA' => odf_text_node,
'text:p' => odf_paragraph,
'text:h' => odf_heading,
'text:span' => odf_text_element,
'text:a' => odf_text_hyperlink,
'text:bibliography-mark' => odf_bibliography_mark,
'text:note' => odf_note,
'office:annotation' => odf_annotation,
'text:changed-region' => odf_changed_region,
'text:section' => odf_section,
'text:list' => odf_list,
'table:table' => odf_table,
'table:table-column-group' => odf_column_group,
'table:table-header-columns' => odf_column_group,
'table:table-row-group' => odf_row_group,
'table:table-header-rows' => odf_row_group,
'table:table-column' => odf_column,
'table:table-row' => odf_row,
'table:table-cell' => odf_cell,
'table:covered-table-cell' => odf_cell,
'text:variable-decl' => odf_simple_variable,
'text:user-field-decl' => odf_user_variable,
'draw:page' => odf_draw_page,
'draw:rect' => odf_rectangle,
'draw:ellipse' => odf_ellipse,
'draw:line' => odf_line,
'draw:connector' => odf_connector,
'draw:frame' => odf_frame,
'draw:image' => odf_image,
'manifest:file-entry' => odf_file_entry,
'style:font-face' => odf_font_declaration,
'style:style' => odf_style,
'style:default-style' => odf_style,
'text:list-style' => odf_list_style,
'text:list-level-style-number' => odf_list_level_style,
'text:list-level-style-bullet' => odf_list_level_style,
'text:list-level-style-image' => odf_list_level_style,
'text:outline-level-style' => odf_list_level_style,
'text:outline-style' => odf_outline_style,
'style:master-page' => odf_master_page,
'style:page-layout' => odf_page_layout,
'draw:gradient' => odf_gradient,
'style:presentation-page-layout'
=> odf_presentation_page_layout,
'style:header-style' => odf_page_end_style,
'style:footer-style' => odf_page_end_style,
'text:table-of-content' => odf_toc,
'table:named-range' => odf_named_range
);
sub get_class_map { %CLASS }
sub associate_tag
{
my $caller = shift;
my $class = ref($caller) || $caller;
$CLASS{$_} = $class for @_;
}
#=== aliases and initialization ==============================================
BEGIN
{
*create = *new;
*xe_new = *XML::Twig::Elt::new;
*get_tag = *XML::Twig::Elt::tag;
*get_tagname = *XML::Twig::Elt::tag;
*del_attributes = *XML::Twig::Elt::del_atts;
*get_children = *XML::Twig::Elt::children;
*get_descendants = *XML::Twig::Elt::descendants;
*get_parent = *XML::Twig::Elt::parent;
*get_ancestor = *XML::Twig::Elt::parent;
*previous_sibling = *XML::Twig::Elt::prev_sibling;
*ungroup = *XML::Twig::Elt::erase;
*get_root = *XML::Twig::Elt::root;
*is_element = *XML::Twig::Elt::is_elt;
*is_text_segment = *XML::Twig::Elt::is_text;
*_set_text = *XML::Twig::Elt::set_text;
*_get_text = *XML::Twig::Elt::text;
*_set_tag = *XML::Twig::Elt::set_tag;
*_set_first_child = *XML::Twig::Elt::set_first_child;
*_set_last_child = *XML::Twig::Elt::set_last_child;
*replace_element = *XML::Twig::Elt::replace;
*set_child = *set_first_child;
*get_element_list = *get_elements;
*get_bookmark_list = *get_bookmarks;
*get_index_mark_list = *get_index_marks;
*get_bibliography_mark_list = *get_bibliography_marks;
*get_table_list = *get_tables;
*get_draw_page_list = *get_draw_pages;
*get_part = *lpod_part;
*document_part = *lpod_part;
*get_document_part = *lpod_part;
*get_document = *document;
*get_document_type = *document_type;
*export = *serialize;
}
#=== exported constructor ====================================================
sub _create { ODF::lpOD::Element->new(@_) }
#-----------------------------------------------------------------------------
our $INIT_CALLBACK = undef;
sub new
{
my $caller = shift;
my $class = ref($caller) || $caller;
my $data = shift or return undef;
my $element;
if (ref $data || $data =~ /\.xml$/i) # load from file
{
$data = load_file($data);
}
$data =~ s/^\s+//;
$data =~ s/\s+$//;
if ($data =~ /^</) # create from XML string
{
return ODF::lpOD::Element->parse_xml($data, @_);
}
# odf_element creation
return undef unless $data;
$element = $class->SUPER::new($data, @_);
# possible subclassing according to the tag
my $tag = $element->tag;
if ($CLASS{$tag})
{
bless $element, $CLASS{$tag};
}
elsif ($tag =~ /^number:.*-style$/)
{
bless $element, 'ODF::lpOD::DataStyle';
}
# optional user-defined post-constructor function
if ($INIT_CALLBACK && (caller() eq 'XML::Twig'))
{
&$INIT_CALLBACK($element);
}
return $element;
}
#-----------------------------------------------------------------------------
sub parse_xml
{
state $twig;
unless ($twig)
{
$twig = XML::Twig->new
(
elt_class => 'ODF::lpOD::Element',
output_encoding => TRUE,
id => $ODF::lpOD::Common::LPOD_ID
);
$twig->set_output_encoding('UTF-8');
}
my $class = shift;
$twig->safe_parse(@_) or return undef;
my $element = $twig->root;
$element->set_classes;
return $element;
}
sub clone
{
my $self = shift;
my $class = ref $self;
my $elt = $self->copy;
return bless $elt, $class;
}
#-----------------------------------------------------------------------------
sub convert { FALSE }
sub context_path {}
sub set_tag
{
my $self = shift;
my $tag = shift;
$self->_set_tag($tag);
bless $self, $CLASS{$tag} || 'ODF::lpOD::Element';
$self->set_class;
return $tag;
}
sub set_class
{
my $self = shift;
my $prefix = $self->ns_prefix or return $self;
if ($prefix eq 'text')
{
ODF::lpOD::TextField::classify($self);
}
return $self;
}
sub set_classes
{
my $self = shift;
foreach my $e ($self->descendants_or_self)
{
my $class;
next if $e->isa('ODF::lpOD::TextNode');
my $tag = $e->tag;
if ($tag =~ /^number:.*style$/)
{
$class = 'ODF::lpOD::Style';
}
$class ||= $CLASS{$tag};
$class ||= 'ODF::lpOD::Element';
bless $e, $class;
$e->set_class;
}
return $self;
}
sub check_tag
{
my $self = shift;
my $new_tag = shift;
my $old_tag = $self->tag;
return $old_tag unless $new_tag;
unless ($new_tag eq $old_tag)
{
$self->set_tag($new_tag);
}
return $self->tag;
}
sub is
{
my $self = shift;
my $classname = shift;
unless (ref($classname))
{
return (
$self->isa($classname) || $classname eq $self->tag
) ? TRUE : FALSE;
}
if (ref($classname) eq 'Regexp')
{
my $tag = $self->tag;
return ($tag =~ $classname) ? TRUE : FALSE;
}
else
{
alert("Wrong reference");
return undef;
}
}
sub set_id
{
my $self = shift;
return $self->set_attribute('id' => shift);
}
sub get_id
{
my $self = shift;
return $self->get_attribute('id');
}
sub is_child
{
my $self = shift;
my $ref_elt = shift;
my $parent = $self->parent;
return ($parent && $parent == $ref_elt) ? TRUE : FALSE;
}
sub get_child
{
my $self = shift;
my $tag = $self->normalize_name(shift) or return undef;
return $self->first_child($tag);
}
sub set_first_child
{
my $self = shift;
return $self->_set_first_child(@_) if caller() eq 'XML::Twig::Elt';
my $tag = $self->normalize_name(shift);
my $child = $self->first_child($tag)
//
$self->insert_element($tag);
$child->set_text(shift);
$child->set_attributes(@_);
return $child;
}
sub set_last_child
{
my $self = shift;
return $self->_set_last_child(@_) if caller() eq 'XML::Twig::Elt';
my $tag = $self->normalize_name(shift);
my $child = $self->first_child($tag)
//
$self->append_element($tag);
$child->set_text(shift);
$child->set_attributes(@_);
return $child;
}
sub set_parent
{
my $self = shift;
my $tag = $self->normalize_name(shift);
my $parent = $self->parent;
if ($parent)
{
unless ($parent->is($tag))
{
$parent = ODF::lpOD::Element->create($tag);
$parent->paste(before => $self);
$self->move(first_child => $parent);
}
}
else
{
$parent = ODF::lpOD::Element->create($tag);
$self->move(first_child => $parent);
}
$parent->set_text(shift);
$parent->set_attributes(@_);
return $parent;
}
sub delete_child
{
my $self = shift;
my $child = $self->get_child(shift) or return FALSE;
$child->delete;
return TRUE;
}
sub delete_children
{
my $self = shift;
my @children= $self->children(shift);
my $count = 0;
foreach my $e (@children)
{
$e->delete; $count++;
}
return $count;
}
sub import_children
{
my $self = shift;
my $source = shift or return FALSE;
my $count = 0;
foreach my $e ($source->children(shift))
{
$e->clone->paste_last_child($self); $count++
}
return $count;
}
sub substitute_children
{
my $self = shift;
my $source = shift or return FALSE;
$self->delete_children(@_);
return $self->import_children($source, @_);
}
sub replace_child
{
my $self = shift;
my $tag = $self->normalize_name(shift) or return undef;
$self->delete_child($tag);
my $child = $self->insert_element($tag);
$child->set_text(shift);
$child->set_attributes(@_);
return $child;
}
sub next
{
my $self = shift;
my $context = shift;
my $tag = $self->get_tag;
unless ($context)
{
return $self->next_sibling($tag);
}
return $self->next_elt($context, $tag);
}
sub previous
{
my $self = shift;
my $context = shift;
my $tag = $self->get_tag;
unless ($context)
{
return $self->previous_sibling($tag);
}
return $self->prev_elt($self, $tag);
}
sub get_class
{
my $self = shift;
return Scalar::Util::blessed($self);
}
sub get_children_elements
{
my $self = shift;
return $self->children(qr'^[^#]');
}
sub get_descendant_elements
{
my $self = shift;
return $self->descendants(qr'^[^#]');
}
sub group
{
my $self = shift;
my @elts = @_;
$_->move(last_child => $self) for @elts;
}
sub node_info
{
my $self = shift;
my %i = ();
$i{text} = $self->_get_text;
$i{size} = length($i{text});
$i{tag} = $self->tag;
$i{class} = $self->get_class;
$i{attributes} = $self->get_attributes;
return %i;
}
sub has_text
{
my $self = shift;
return $self->has_child(TEXT_SEGMENT) ? TRUE : FALSE;
}
sub is_text_container
{
my $self = shift;
my $name = $self->tag;
return $name =~ /^text:(p|h|span)$/ ? TRUE : FALSE;
}
sub normalize_name
{
my $self = shift;
my $name = shift // return undef;
$name =~ s/^\s+//;
$name =~ s/\s+$//;
return $name if $name =~ /^</;
$name .= ' name' if $name eq 'style';
if ($name && ! ref $name)
{
unless ($name =~ /[:#]/)
{
my $prefix = $self->ns_prefix;
$name = $prefix . ':' . $name if $prefix;
}
$name =~ s/[ _]/-/g;
}
return $name;
}
sub repeat
{
my $self = shift;
unless ($self->parent)
{
alert "Repeat not allowed for root elements";
return FALSE;
}
my $r = shift;
return undef unless defined $r;
my $count = 0;
while ($r > 1)
{
my $elt = $self->clone;
$elt->paste_after($self);
$count++; $r--;
}
return $count;
}
sub set_lpod_mark
{
state $count = 0;
my $self = shift;
my %opt = @_;
my $id;
if (defined $opt{id})
{
$id = $opt{id}; delete $opt{id};
}
else
{
$id = lpod_common->new_id;
}
my $e = $self->insert_element($ODF::lpOD::Common::LPOD_MARK, %opt);
$e->set_attribute($ODF::lpOD::Common::LPOD_ID, $id);
return $id;
}
sub ro
{
my $self = shift;
my $ro = shift;
unless (defined $ro)
{
return $self->att('#lpod:ro') // FALSE;
}
elsif (is_true($ro))
{
$self->set_att('#lpod:ro', TRUE);
}
else
{
$self->del_att('#lpod:ro') if $self->att('#lpod:ro');
return undef;
}
}
sub rw
{
my $self = shift;
my $rw = shift;
unless (defined $rw)
{
return is_false($self->att('#lpod:ro'));
}
elsif (is_true($rw))
{
$self->del_att('#lpod:ro') if $self->att('#lpod:ro');
return TRUE;
}
elsif (is_false($rw))
{
$self->set_att('#lpod:ro', TRUE);
return FALSE;
}
}
sub get_lpod_mark
{
my $self = shift;
my $id = shift;
return $self->get_element
(
$ODF::lpOD::Common::LPOD_MARK,
attribute => $ODF::lpOD::Common::LPOD_ID,
value => $id
);
}
sub remove_lpod_mark
{
my $self = shift;
my $mark = $self->get_lpod_mark(shift);
if ($mark)
{
$mark->delete; return TRUE;
}
return FALSE;
}
sub remove_lpod_marks
{
my $self = shift;
$_->delete()
for $self->get_elements($ODF::lpOD::Common::LPOD_MARK);
}
sub set_lpod_id
{
my $self = shift;
return $self->set_att($ODF::lpOD::Common::LPOD_ID, shift);
}
sub remove_lpod_id
{
my $self = shift;
return $self->del_att($ODF::lpOD::Common::LPOD_ID);
}
sub strip_lpod_id
{
my $self = shift;
return $self->strip_att($ODF::lpOD::Common::LPOD_ID);
}
sub lpod_part
{
my $self = shift;
my $part = shift;
if ($part)
{
return $self->set_att($ODF::lpOD::Common::LPOD_PART, $part);
}
else
{
return
$self->att($ODF::lpOD::Common::LPOD_PART) ||
$self->root->att($ODF::lpOD::Common::LPOD_PART);
}
}
sub document
{
my $self = shift;
my $part = $self->lpod_part or return undef;
return $part->document;
}
sub document_type
{
my $self = shift;
my $doc = $self->document or return undef;
return $doc->get_type;
}
#-----------------------------------------------------------------------------
sub text_segments
{
my $self = shift;
my %opt =
(
deep => FALSE,
@_
);
return (is_true($opt{deep})) ?
$self->descendants(TEXT_SEGMENT) :
$self->children(TEXT_SEGMENT);
}
sub search_in_text_segment
{
my $self = shift;
unless ($self->is_text)
{
alert("Not in text segment");
return undef;
}
return search_string($self->get_text, @_);
}
sub replace_in_text_segment
{
my $self = shift;
my $expr = shift;
my $repl = shift;
my ($content, $change_count) = search_string
($self->get_text, $expr, replace => $repl, @_);
$self->set_text($content) if $change_count;
return $change_count;
}
#--- generic element retrieval method ----------------------------------------
sub _get_elements
{
my $self = shift;
my $tag = shift;
if (ref $tag)
{
return $self->descendants($tag);
}
my %opt =
(
content => undef,
attribute => undef,
position => undef,
@_
);
$tag = $self->normalize_name($tag);
my $xpath = './/' . ($tag // "");
if (defined $opt{attribute})
{
my $a = $opt{attribute};
my $v = input_conversion($opt{value});
$a =~ s/[ _]/-/g;
unless ($a =~ /:/)
{
$tag =~ /^(.*):/; $a = $1 . ':' . $a;
}
$xpath .= '[@' . $a . '="' . $v . '"]';
}
my $pos = $opt{position};
my $expr = $opt{content};
unless (defined $opt{content})
{
return defined $pos ?
$self->get_xpath($xpath, $pos) :
$self->get_xpath($xpath);
}
else
{
my $elt;
my @elts = ();
my $count = 0;
unless (defined $pos)
{
foreach $elt ($self->get_xpath($xpath))
{
push @elts, $elt if $elt->count_matches($expr);
}
return @elts;
}
elsif ($pos >= 0)
{
foreach $elt ($self->get_xpath($xpath))
{
if ($elt->count_matches($expr))
{
$count++;
return $elt if $count > $pos;
}
}
return undef;
}
else
{
foreach $elt ($self->get_xpath($xpath))
{
push @elts, $elt if $elt->count_matches($expr);
}
my $size = scalar @elts;
return ($size >= abs($pos)) ? $elts[$pos] : undef;
}
}
}
sub get_element
{
my $self = shift;
my $tag = shift;
my %opt = @_;
$opt{position} //= 0;
if ($opt{bookmark})
{
return $self->get_element_by_bookmark
($opt{bookmark}, tag => $tag);
}
return $self->_get_elements($tag, %opt);
}
sub get_element_by_id
{
my $self = shift;
my $tag = shift;
return $self->get_element($tag, attribute => 'id', value => shift);
}
sub get_element_by_name
{
my $self = shift;
my $name = shift;
unless ($name)
{
alert "Missing object name"; return undef;
}
return $self->get_element($name, attribute => 'name', value => shift);
}
sub get_elements
{
my $self = shift;
my $tag = shift;
my %opt = @_;
delete $opt{position};
return $self->_get_elements($tag, %opt);
}
#--- specific unnamed element retrieval methods ------------------------------
sub get_text_element
{
my $self = shift;
my %opt = @_;
my $type = $opt{type} // 'p';
delete $opt{type};
$type = 'text:' . $type unless $type =~ /:/;
if ($opt{bookmark})
{
return $self->get_element_by_bookmark
($opt{bookmark}, tag => $type);
}
unless (defined $opt{style})
{
return $self->get_element($type, %opt);
}
else
{
return $self->get_element
(
$type,
attribute => 'style name',
value => $opt{style},
position => $opt{position},
content => $opt{content}
);
}
}
sub get_paragraph
{
my $self = shift;
return $self->get_text_element(type => 'p', @_);
}
sub get_text_span
{
my $self = shift;
return $self->get_text_element(type => 'span', @_);
}
sub get_parent_paragraph
{
my $self = shift;
return $self->parent(qr'text:(p|h)');
}
sub get_text_elements
{
my $self = shift;
my %opt = @_;
my $type = $opt{type} // 'p';
delete $opt{type};
$type = 'text:' . $type unless $type =~ /:/;
if ($opt{style})
{
$opt{attribute} = 'style name';
$opt{value} = $opt{style};
delete $opt{style};
}
return $self->get_elements($type, %opt);
}
sub get_paragraphs
{
my $self = shift;
return $self->get_text_elements(type => 'p', @_);
}
sub get_text_spans
{
my $self = shift;
return $self->get_text_elements(type => 'span', @_);
}
sub get_heading
{
my $self = shift;
my %opt = @_;
if ($opt{bookmark})
{
return $self->get_element_by_bookmark
($opt{bookmark}, tag => 'text:h');
}
if (defined $opt{level})
{
$opt{attribute} = 'outline level';
$opt{value} = $opt{level};
delete $opt{level};
}
return $self->get_element('text:h', %opt);
}
sub get_headings
{
my $self = shift;
my %opt = @_;
unless (is_true($opt{all}))
{
if (defined $opt{level})
{
$opt{attribute} = 'outline level';
$opt{value} = $opt{level};
delete $opt{level};
}
return $self->get_elements('text:h', %opt);
}
else
{
unless (defined $opt{level})
{
return $self->get_elements('text:h');
}
my @headings = ();
my $h = $self->first_child('text:h');
while ($h)
{
my $l = $h->get_level;
push @headings, $h if $l > 0 and $l <= $opt{level};
$h = $h->next_sibling('text:h');
}
return @headings;
}
}
sub get_hyperlinks
{
my $self = shift;
my %opt = @_;
my $type = $opt{type};
delete $opt{type};
unless ($type)
{
return (
$self->get_hyperlinks(type => 'text', %opt),
$self->get_hyperlinks(type => 'draw', %opt)
);
}
if (defined $opt{url})
{
$opt{attribute} = 'xlink:href';
$opt{value} = $opt{url};
delete $opt{url};
}
return $self->get_elements("$type:a", %opt);
}
sub get_list
{
my $self = shift;
return $self->get_element('text:list', @_);
}
sub get_list_by_id
{
my $self = shift;
return $self->get_list(attribute => 'xml:id', value => shift);
}
sub get_lists
{
my $self = shift;
return $self->get_elements('text:list', @_);
}
sub get_fields
{
my $self = shift;
my $type = shift;
unless ($type)
{
my @elts;
for (ODF::lpOD::TextField->types)
{
push @elts, $self->get_fields($_);
}
return @elts;
}
return $self->get_elements('text:' . $type);
}
#--- table retrieval ---------------------------------------------------------
sub get_table
{
my $self = shift;
my $arg = shift // 0;
return is_numeric($arg) ?
$self->get_table_by_position($arg, @_) :
$self->get_table_by_name($arg, @_);
}
sub get_parent_table
{
my $self = shift;
return $self->parent('table:table');
}
sub get_parent_cell
{
my $self = shift;
return $self->parent('table:table-cell');
}
sub get_tables
{
my $self = shift;
return $self->get_elements('table:table', @_);
}
sub get_table_by_name
{
my $self = shift;
my $name = shift;
return $self->get_element_by_name('table:table', $name);
}
sub get_table_by_position
{
my $self = shift;
my $position = shift || 0;
return $self->get_element('table:table', position => $position);
}
sub get_table_by_content
{
my $self = shift;
my $expr = shift;
unless (defined $expr)
{
alert "Missing search expression";
return FALSE;
}
foreach my $t ($self->get_tables(@_))
{
foreach my $n ($t->descendants(TEXT_SEGMENT))
{
my $text = $n->get_text() or next;
return $t;
}
}
return FALSE;
}
#--- check & retrieval tools for bookmarks, index marks ----------------------
sub get_position_mark
{
my $self = shift;
my $tag = $self->normalize_name(shift);
my $name = shift;
my $role = shift;
unless ($name)
{
alert ("Name is mandatory for position mark retrieval");
return FALSE;
}
my $attr = $tag =~ /bookmark|reference-mark/ ?
'text:name' : 'text:id';
my %opt = (attribute => $attr, value => $name);
given ($role)
{
when (undef)
{
my $single = $self->get_element($tag, %opt);
unless ($single)
{
my $start = $self->get_element
($tag . '-start', %opt);
my $end = $self->get_element
($tag . '-end', %opt);
return wantarray ? ($start, $end) : $start;
}
return $single;
}
when (/^(start|end)$/)
{
return $self->get_element($tag . '-' . $_, %opt);
}
default
{
alert "Wrong role $role";
return FALSE;
}
}
}
sub check_position_mark
{
my $self = shift;
my $tag = shift;
my $name = shift;
my %opt = (attribute => 'text:name', value => $name);
return TRUE if $self->get_element($tag, %opt);
my $start = $self->get_position_mark($tag, $name, 'start')
or return FALSE;
my $end = $self->get_position_mark($tag, $name, 'end')
or return FALSE;
return $start->before($end) ? TRUE : FALSE;
}
sub remove_position_mark
{
my $self = shift;
my $tag = shift;
my $name = shift;
my %opt = (attribute => 'text:name', value => $name);
my $single = $self->get_element($tag, %opt);
if ($single)
{
$single->delete;
return TRUE;
}
my $start = $self->get_position_mark($tag, $name, 'start')
or return FALSE;
my $end = $self->get_position_mark($tag, $name, 'end')
or return FALSE;
$start->delete;
$end->delete;
return TRUE;
}
#--- text mark retrieval stuff -----------------------------------------------
sub get_bookmark
{
my $self = shift;
return $self->get_position_mark('text:bookmark', shift);
}
sub get_bookmarks
{
my $self = shift;
return $self->get_elements(qr'bookmark$|bookmark-start$');
}
sub get_reference_mark
{
my $self = shift;
return $self->get_position_mark('text:reference-mark', shift);
}
sub get_reference_marks
{
my $self = shift;
return $self->get_elements(qr'reference-mark$|reference-mark-start$');
}
sub get_index_marks
{
my $self = shift;
my $type = shift;
my $filter;
given ($type)
{
when (undef)
{
alert "Missing index mark type";
}
when (["lexical", "alphabetical"])
{
$filter = 'alphabetical-index-mark';
}
when ("toc")
{
$filter = 'toc-mark';
}
when ("user")
{
$filter = 'user-index-mark';
}
default
{
alert "Wrong index mark type";
}
}
return FALSE unless $filter;
$filter = $filter . '$|' . $filter . '-start$';
return $self->get_elements(qr($filter));
}
sub clean_marks
{
my $self = shift;
my $count = 0;
my ($tag, $start, $end, $att, $id);
foreach $start ($self->get_elements(qr'mark-start$'))
{
$tag = $start->get_tag;
$att = $tag =~ /bookmark/ ? 'text:name' : 'text:id';
$id = $start->get_attribute($att);
unless ($id)
{
$start->delete; $count++;
next;
}
$tag =~ s/start$/end/;
$end = $self->get_element
($tag, attribute => $att, value => $id);
unless ($end)
{
$start->delete; $count++;
next;
}
unless ($start->before($end))
{
$start->delete; $end->delete; $count += 2;
}
}
foreach $end ($self->get_elements(qr'mark-end$'))
{
$tag = $end->get_tag;
$att = $tag =~ /bookmark/ ? 'text:name' : 'text:id';
$id = $end->get_attribute($att);
unless ($id)
{
$end->delete; $count++;
next;
}
$tag =~ s/end$/start/;
$start = $self->get_element
($tag, attribute => $att, value => $id);
unless ($start)
{
$end->delete; $count++;
next;
}
unless ($end->after($start))
{
$start->delete; $end->delete; $count += 2;
}
}
return $count;
}
sub remove_bookmark
{
my $self = shift;
return $self->remove_position_mark('text:bookmark', shift);
}
sub check_bookmark
{
my $self = shift;
return $self->check_position_mark('text:bookmark', shift);
}
sub get_element_by_bookmark
{
my $self = shift;
my $name = shift;
my %opt = @_;
my $bookmark = $self->get_position_mark
('text:bookmark', $name, $opt{role});
unless ($bookmark)
{
alert("Bookmark not found"); return FALSE;
}
if ($opt{tag})
{
return $bookmark->get_ancestor($opt{tag});
}
return $bookmark->parent;
}
sub get_paragraph_by_bookmark
{
my $self = shift;
my $name = shift;
my %opt = @_;
$opt{tag} = qr'text:(p|h)';
return $self->get_element_by_bookmark($name, %opt);
}
sub get_bookmark_text
{
my $self = shift;
my ($start, $end) = $self->get_bookmark(shift);
unless ($start && $end && $start->before($end))
{
alert "The required bookmark in not defined in the context";
return undef;
}
my $text = "";
my $n = $start->next_elt($self, TEXT_SEGMENT);
while ($n && $n->before($end))
{
$text .= $n->get_text;
$n = $n->next_elt($self, TEXT_SEGMENT);
}
return $text;
}
sub remove_reference_mark
{
my $self = shift;
return $self->remove_position_mark('text:reference-mark', shift);
}
sub check_reference_mark
{
my $self = shift;
return $self->check_position_mark('text:reference-mark', shift);
}
sub get_bibliography_marks
{
my $self = shift;
my $text = shift;
return defined $text ?
$self->get_elements
(
'text:bibliography-mark',
attribute => 'identifier',
value => $text
)
:
$self->get_elements('text:bibliography-mark');
}
#--- note retrieval ----------------------------------------------------------
sub get_note
{
my $self = shift;
my $id = shift;
unless ($id)
{
alert "Missing note identifier"; return FALSE;
}
return $self->get_element(
'text:note',
attribute => 'id',
value => $id
);
}
sub get_notes
{
my $self = shift;
my %opt = process_options(@_);
my $class = $opt{class} || $opt{note_class};
my $label = $opt{label};
my $citation = $opt{citation};
my $xp = './/text:note';
$xp .= '[@text:note-class="' . $class . '"]' if defined $class;
if (defined $label || defined $citation)
{
$xp .= '/text:note-citation';
$xp .= '[@text:label="' . $label . '"]'
if defined $label;
$xp .= '[string()="' . $citation . '"]'
if defined $citation;
my @result = ();
foreach my $n ($self->get_xpath($xp))
{
push @result, $n->parent;
}
return @result;
}
return $self->get_xpath($xp);
}
sub get_annotations
{
my $self = shift;
my %opt = @_;
my $date = $opt{date};
my $author = $opt{author};
my $xp = './/office:annotation';
$xp .= '[@dc:date="' . $date . '"]' if $date;
$xp .= '[@dc:creator="' . $author . '"]' if $author;
return $self->get_xpath($xp);
}
#--- tracked change retrieval ------------------------------------------------
sub get_changes
{
my $self = shift;
my %opt = @_;
my $context = $self;
unless ($opt{date} || $opt{author})
{
return $context->get_elements('text:changed-region');
}
my @r = ();
foreach my $ci ($context->descendants('text:changed-region'))
{
my ($elt, $text);
if ($opt{date})
{
$elt = $ci->first_descendant('dc:date') or next;
$text = $elt->get_text or next;
if (ref $opt{date})
{
my $start = ${opt{date}}[0];
my $end = ${opt{date}}[1];
next if $start && ($text lt $start);
next if $end && ($text gt $end);
}
else
{
next unless $text eq $opt{date};
}
}
if ($opt{author})
{
$elt = $ci->first_descendant('dc:creator') or next;
$text = $elt->get_text;
next unless $text eq $opt{author};
}
push @r, $ci;
}
return @r;
}
sub get_change
{
my $self = shift;
return $self->get_element(
'text:changed-region',
attribute => 'id',
value => shift
);
}
#--- section retrieval -------------------------------------------------------
sub get_section
{
my $self = shift;
return $self->get_element
('text:section', attribute => 'text:name', value => shift);
}
sub get_sections
{
my $self = shift;
return $self->get_elements('text:section', @_);
}
sub get_parent_section
{
my $self = shift;
return $self->parent('text:section');
}
#--- frame & draw page retrieval ---------------------------------------------
sub get_shape
{
my $self = shift;
my $type = shift;
$type = 'draw:' . $type unless $type =~ /:/;
return $self->get_element(
$type, attribute => 'draw:name', value => shift
);
}
sub get_rectangle
{
my $self = shift; return $self->get_shape('rect', @_);
}
sub get_rectangles
{
my $self = shift; return $self->get_elements('draw:rect', @_);
}
sub get_ellipse
{
my $self = shift; return $self->get_shape('ellipse', @_);
}
sub get_ellipses
{
my $self = shift; return $self->get_elements('draw:ellipse', @_);
}
sub get_line
{
my $self = shift; return $self->get_shape('line', @_);
}
sub get_lines
{
my $self = shift; return $self->get_elements('draw:line', @_);
}
sub get_connector
{
my $self = shift; return $self->get_shape('connector', @_);
}
sub get_connectors
{
my $self = shift; return $self->get_elements('draw:connector', @_);
}
sub get_frame
{
my $self = shift; return $self->get_shape('frame', @_);
}
sub get_parent_frame
{
my $self = shift;
return $self->parent('draw:frame');
}
sub get_frames
{
my $self = shift; return $self->get_elements('draw:frame', @_);
}
sub get_draw_page_by_position
{
my $self = shift;
return $self->get_element('draw:page', position => shift);
}
sub get_draw_page_by_name
{
my $self = shift;
return $self->get_element(
'draw:page', attribute => 'name', value => shift
);
}
sub get_draw_page
{
my $self = shift;
my $arg = shift;
return $self->get_element(
'draw:page', attribute => 'id', value => $arg
) ||
$self->get_draw_page_by_name($arg);
}
sub get_draw_pages
{
my $self = shift; return $self->get_elements('draw:page', @_);
}
#-----------------------------------------------------------------------------
sub get_attribute
{
my $self = shift;
my $name = $self->normalize_name(shift) or return undef;
my $value = $self->att($name);
return output_conversion($value);
}
sub get_attributes
{
my $self = shift;
return undef unless $self->is_element;
my $atts = $self->atts or return undef;
my %attr = %{$atts};
my %result = ();
$result{$_} = output_conversion($attr{$_}) for keys %attr;
return wantarray ? %result : { %result };
}
sub set_attribute
{
my $self = shift;
my $name = $self->normalize_name(shift) or return undef;
my $value = input_conversion(shift);
if ($name =~ /color$/)
{
$value = color_code($value);
}
return defined $value ?
$self->set_att($name, $value) : $self->del_attribute($name);
}
sub set_boolean_attribute
{
my $self = shift;
my ($name, $value) = @_;
$value = odf_boolean($value);
return $self->set_attribute($name, $value);
}
sub get_boolean_attribute
{
my $self = shift;
my $value = $self->get_attribute(shift);
given ($value)
{
when (undef)
{
return undef;
}
when ('true')
{
return TRUE;
}
when ('false')
{
return FALSE;
}
default
{
alert("Improper ODF boolean");
return undef;
}
}
}
sub input_convert_attributes
{
my $self = shift;
my $in = shift;
my %out = ();
my $prefix = $self->ns_prefix;
foreach my $kin (keys %{$in})
{
my $kout = $kin;
unless ($kout =~ /:/)
{
$kout = $prefix . ':' . $kout;
}
$kout =~ s/ /-/g;
$out{$kout} = input_conversion($in->{$kin});
}
return wantarray ? %out : { %out };
}
sub set_attributes
{
my $self = shift;
my $attr = shift or return undef;
my %attr = ref $attr ? %{$attr} : ($attr, @_);
foreach my $k (keys %attr)
{
$self->set_attribute($k, $attr{$k});
}
return $self->get_attributes;
}
sub del_attribute
{
my $self = shift;
my $name = $self->normalize_name(shift);
return $self->att($name) ? $self->del_att($name) : FALSE;
}
sub clear
{
my $self = shift;
return $self->_set_text('');
}
sub get_text
{
my $self = shift;
my %opt = (recursive => FALSE, @_);
my $text = undef;
unless ($self->is_element)
{
$text = $self->text;
}
elsif (is_true($opt{recursive}))
{
foreach my $t ($self->descendants(TEXT_SEGMENT))
{
$text .= $t->text;
}
}
else
{
$text = $self->text_only;
}
return output_conversion($text);
}
sub set_text
{
my $self = shift;
my $input = shift;
return undef unless defined $input;
my $text = caller() ne 'XML::Twig::Elt' ?
input_conversion($input) : $input;
my $r = $self->_set_text($text);
bless $_, 'ODF::lpOD::TextNode' for $self->children(TEXT_SEGMENT);
return $r;
}
sub get_text_content
{
my $self = shift;
my $t = "";
foreach my $p ($self->descendants('text:p'))
{
$t .= ($p->get_text(@_) // "");
}
return $t;
}
sub set_text_content
{
my $self = shift;
my $text = shift;
my %opt = @_;
my @paragraphs = $self->descendants('text:p');
my $p = shift @paragraphs;
unless (defined $p)
{
$p = ODF::lpOD::Element->create('text:p');
$p->paste_first_child($self);
}
else
{
$_->delete() for @paragraphs;
}
$p->set_style($opt{style}) if $opt{style};
return $p->set_text($text);
}
sub get_family {}
sub get_name
{
my $self = shift;
return $self->get_attribute('name');
}
sub set_name
{
my $self = shift;
my $name = shift;
return undef unless defined $name;
return caller() eq 'XML::Twig::Elt' ?
$self->set_tag($name) :
$self->set_attribute('name' => $name);
}
sub get_size
{
my $self = shift;
my $sep = shift // ', ';
my $w = $self->get_attribute('svg:width');
my $h = $self->get_attribute('svg:height');
return undef unless (defined $w && defined $h);
return wantarray ? ($w, $h) : join $sep, $w, $h;
}
sub set_size
{
my $self = shift;
my ($w, $h) = input_2d_value(@_);
$self->set_attribute('svg:width' => $w);
$self->set_attribute('svg:height' => $h);
return $self->get_size;
}
sub get_display
{
my $self = shift;
return is_true($self->get_attribute('display'));
}
sub set_display
{
my $self = shift;
return $self->set_attribute('display' => odf_boolean(shift));
}
sub get_position
{
my $self = shift;
my $sep = shift // ', ';
my $x = $self->get_attribute('svg:x');
my $y = $self->get_attribute('svg:y');
return undef unless (defined $x && defined $y);
if (wantarray)
{
return ($x, $y);
}
else {
my $r;
$r = join $sep, $x, $y if (defined $x && defined $y);
return $r;
}
}
sub set_position
{
my $self = shift;
my ($x, $y) = input_2d_value(@_);
$self->set_attribute('svg:x' => $x);
$self->set_attribute('svg:y' => $y);
return $self->get_position;
}
sub get_url
{
my $self = shift;
return $self->get_attribute('xlink:href');
}
sub set_url
{
my $self = shift;
return $self->set_attribute('xlink:href' => shift);
}
sub get_style
{
my $self = shift;
return $self->get_attribute('style name');
}
sub set_style
{
my $self = shift;
my $style = shift;
my $name;
if (ref $style)
{
if ($style->isa('ODF::lpOD::Style'))
{
$name = $style->get_name;
}
else
{
alert "Wrong style"; return undef;
}
}
else
{
$name = $style;
}
return $self->set_attribute('style name' => $name);
}
sub insert_element
{
my $self = shift;
my $tag = $self->normalize_name(shift) or return undef;
my %opt =
(
position => 'FIRST_CHILD',
@_
);
my $position = uc $opt{position};
$position =~ s/ /_/g;
my $new_elt;
if (ref $tag)
{
if ($tag->parent && $position ne 'PARENT')
{
alert "Element already belonging to a tree";
return FALSE;
}
$new_elt = $tag;
}
else
{
$new_elt = ODF::lpOD::Element->new($tag);
}
if (defined $opt{after})
{
$new_elt->paste_after($opt{after}); return $new_elt;
}
elsif (defined $opt{before})
{
$new_elt->paste_before($opt{before}); return $new_elt;
}
given($position)
{
when (/^(FIRST_CHILD|LAST_CHILD)$/)
{
$new_elt->paste((lc $position) => $self);
}
when ('NEXT_SIBLING')
{
$new_elt->paste_after($self);
}
when ('PREV_SIBLING')
{
$new_elt->paste_before($self);
}
when ('WITHIN')
{
if ($opt{offset})
{
$new_elt->paste_within($self, $opt{offset});
}
else
{
$new_elt->paste_first_child($self);
}
}
when ('PARENT')
{
if ($self->parent)
{
$new_elt->paste_before($self);
$self->move(last_child => $new_elt);
}
else
{
$self->paste_last_child($new_elt);
}
}
default
{
alert("Wrong insertion option");
return FALSE;
}
}
return $new_elt;
}
sub append_element
{
my $self = shift;
return $self->insert_element(shift, position => 'LAST_CHILD');
}
sub insert
{
my $self = shift;
my $target = shift or return undef;
return $target->insert_element($self, @_);
}
sub append
{
my $self = shift;
my $target = shift or return undef;
return $target->append_element($self);
}
sub set_comment
{
my $self = shift;
unless ($self->parent)
{
alert "Not allowed in free element"; return undef;
}
my $text = input_conversion(shift);
my $cmt = ODF::lpOD::Element->create('#COMMENT' => $text);
$cmt->paste_before($self);
return $cmt;
}
sub set_annotation
{
my $self = shift;
my $a = ODF::lpOD::Annotation->create(@_);
$a->paste_first_child($self);
return $a;
}
sub serialize
{
my $self = shift;
my %opt = process_options
(
empty_tags => EMPTY_TAGS,
@_
);
$opt{pretty} //= ($opt{indent} // lpod->debug);
$self->set_pretty_print(PRETTY_PRINT) if is_true($opt{pretty});
$self->set_empty_tag_style($opt{empty_tags});
delete @opt{qw(pretty indent empty_tags)};
return $self->sprint(%opt);
}
#=============================================================================
sub _search_forward
{
my $self = shift;
my $expr = shift;
my %opt = (@_);
my $offset = $opt{offset};
my ($target_node, $n, $start_pos, $end_pos, $match);
if ($self->is_text)
{
$n = $self;
}
elsif ($opt{start_mark})
{
if ($opt{start_mark}->is_text)
{
$n = $opt{start_mark};
}
else
{
$n = $opt{start_mark}
->last_descendant
->next_elt($self, TEXT_SEGMENT);
}
}
else
{
$n = $self->first_descendant(TEXT_SEGMENT);
}
my %info = $n->node_info() if $n;
if (defined $offset)
{
while ($n && $offset >= $info{size})
{
if ($opt{end_mark} && ! $n->before($opt{end_mark}))
{
$n = undef; last;
}
$offset -= $info{size};
$n = $n->next_elt($self, TEXT_SEGMENT);
%info = $n->node_info() if $n;
}
}
while ($n && !defined $start_pos)
{
if ($opt{end_mark} && ! $n->before($opt{end_mark}))
{
$n = undef; last;
}
unless (defined $expr)
{
$start_pos = $offset;
$match = defined $opt{range} ?
substr($info{text}, $start_pos, $opt{range}) :
substr($info{text}, $start_pos);
$end_pos = $start_pos + length($match);
}
else
{
($start_pos, $end_pos, $match) =
search_string
(
$info{text},
$expr,
offset => $offset,
range => $opt{range}
);
}
if (defined $start_pos)
{
$target_node = $n;
}
else
{
$n = $n->next_elt($self, TEXT_SEGMENT);
%info = $n->node_info() if $n;
$offset = 0;
}
}
return wantarray ?
($target_node, $start_pos, $match, $end_pos) :
$start_pos;
}
sub _search_backward
{
my $self = shift;
my $expr = shift;
my %opt = (@_);
my $offset = $opt{offset};
if (defined $offset && $offset > 0)
{
$offset = -abs($offset);
}
my ($target_node, $n, $start_pos, $end_pos, $match);
if ($self->is_text)
{
$n = $self;
}
elsif ($opt{start_mark})
{
unless ($opt{start_mark}->is_text)
{
$n = $opt{start_mark}->prev_elt($self, TEXT_SEGMENT);
}
else
{
$n = $opt{start_mark};
}
}
else
{
$n = $self->last_descendant(TEXT_SEGMENT);
}
my %info = $n->node_info() if $n;
if (defined $offset)
{
while ($n && abs($offset) >= $info{size})
{
if ($opt{end_mark} && ! $n->after($opt{end_mark}))
{
$n = undef; last;
}
$offset += $info{size};
$n = $n->prev_elt($self, TEXT_SEGMENT);
%info = $n->node_info() if $n;
}
}
while ($n && !defined $start_pos)
{
if ($opt{end_mark} && ! $n->before($opt{end_mark}))
{
$n = undef; last;
}
unless (defined $expr)
{
$start_pos = $offset;
$match = defined $opt{range} ?
substr($info{text}, $start_pos, $opt{range}) :
substr($info{text}, $start_pos);
$end_pos = $start_pos + length($match);
}
else
{
($start_pos, $end_pos, $match) =
search_string
(
$info{text},
$expr,
offset => $offset,
range => $opt{range}
);
}
if (defined $start_pos)
{
$target_node = $n;
}
else
{
$n = $n->next_elt($self, TEXT_SEGMENT);
%info = $n->node_info() if $n;
$offset = 0;
}
}
return wantarray ?
($target_node, $start_pos, $match, $end_pos) :
$start_pos;
}
sub search
{
my $self = shift;
my $expr = input_conversion(shift);
my %opt = process_options
(
backward => FALSE,
start_mark => undef,
end_mark => undef,
offset => undef,
range => undef,
@_
);
unless (defined $expr || defined $opt{offset})
{
alert("Missing search argument");
return undef;
}
my $backward = $opt{backward}; delete $opt{backward};
if (defined $opt{offset} && $opt{offset} < 0)
{
$backward = TRUE;
}
my %r = ();
my $match = undef;
if(is_false($backward))
{
($r{segment}, $r{offset}, $match, $r{end}) =
$self->_search_forward($expr, %opt);
}
else
{
($r{segment}, $r{offset}, $match, $r{end}) =
$self->_search_backward($expr, %opt);
}
$r{match} = output_conversion($match);
return wantarray ? %r : { %r };
}
sub replace
{
my $self = shift;
return $self->replace_element(@_) if caller() eq 'XML::Twig::Elt';
my $expr = shift;
my $repl = shift;
return $self->count_matches($expr, @_) unless defined $repl;
my %opt =
(
deep => TRUE,
@_
);
my $deep = $opt{deep}; delete $opt{deep};
my $count = 0;
foreach my $segment ($self->text_segments(deep => $deep))
{
$count += $segment->replace_in_text_segment
($expr, $repl, %opt);
}
return $count;
}
sub count_matches
{
my $self = shift;
my $expr = shift;
my %opt =
(
deep => TRUE,
@_
);
my $count = 0;
foreach my $segment ($self->text_segments(deep => $opt{deep}))
{
my $t = $segment->get_text;
$count += count_substrings($t, $expr);
}
return $count;
}
#=============================================================================
our $AUTOLOAD;
sub AUTOLOAD
{
$AUTOLOAD =~ /(.*:)(.*)/;
my $package = $1;
my $method = $2;
my $element = shift;
$method =~ /^([gs]et)_(.*)/;
my $action = $1;
no strict;
my $target = ${$package . "ATTRIBUTE"}{$2};
use strict;
unless ($action && $target)
{
alert "Unknown method $method @_";
return undef;
}
my $name = $target->{attribute};
my $type = $target->{type};
my $value = undef;
given ($action)
{
when ('get')
{
$value = $element->get_attribute($name, @_);
return ($type and ($type eq 'boolean')) ?
is_true($value) : $value;
}
when ('set')
{
$value = input_conversion(shift);
if ($type)
{
$value = check_odf_value($value, $type);
}
return defined $value ?
$element->set_att($name => $value) :
$element->del_attribute($name);
}
default
{
alert "Unknown method $method @_";
}
}
return undef;
}
sub not_allowed
{
my $self = shift;
my $tag = $self->get_tag;
my $class = ref $self;
alert "Not allowed for this $tag ($class) element";
return undef;
}
#=============================================================================
package ODF::lpOD::TextNode;
use base 'ODF::lpOD::Element';
our $VERSION = '1.000';
use constant PACKAGE_DATE => '2011-02-27T00:44:46';
use ODF::lpOD::Common;
#-----------------------------------------------------------------------------
BEGIN
{
*create = *XML::Twig::Elt::new;
*get_tag = *XML::Twig::Elt::tag;
*set_tag = *ODF::lpOD::Element::set_tag;
*set_text = *ODF::lpOD::Element::set_text;
*get_parent = *XML::Twig::Elt::parent;
*get_ancestor = *XML::Twig::Elt::parent;
*previous_sibling = *XML::Twig::Elt::prev_sibling;
*get_root = *XML::Twig::Elt::root;
*is_element = *XML::Twig::Elt::is_elt;
*is_text_segment = *XML::Twig::Elt::is_text;
*_set_text = *XML::Twig::Elt::set_text;
*_get_text = *XML::Twig::Elt::text;
*_set_tag = *XML::Twig::Elt::set_tag;
*replace_element = *XML::Twig::Elt::replace;
}
#-----------------------------------------------------------------------------
sub node_info
{
my $self = shift;
my %i = ();
$i{text} = $self->_get_text;
$i{size} = length($i{text});
$i{tag} = TEXT_SEGMENT;
$i{class} = __PACKAGE__;
$i{attributes} = undef;
return %i;
}
sub get_text
{
my $self = shift;
return output_conversion($self->text);
}
#=============================================================================
package ODF::lpOD::BibliographyMark;
use base 'ODF::lpOD::Element';
our $VERSION = '1.000';
use constant PACKAGE_DATE => '2010-12-24T13:37:35';
#=============================================================================
package ODF::lpOD::Note;
use base 'ODF::lpOD::Element';
our $VERSION = '1.002';
use constant PACKAGE_DATE => '2011-02-22T00:16:40';
use ODF::lpOD::Common;
#-----------------------------------------------------------------------------
BEGIN {
*set_text = *set_body;
}
#-----------------------------------------------------------------------------
sub _create { ODF::lpOD::Note->create(@_) }
#-----------------------------------------------------------------------------
sub create
{
my $caller = shift;
my $class = ref($caller) || $caller;
my $id = shift;
unless ($id)
{
alert "Missing mandatory note identifier";
return FALSE;
}
my %opt = process_options
(
class => 'footnote',
@_
);
my $note = ODF::lpOD::Element->create('text:note');
$note->set_id($id);
$note->set_citation($opt{citation}, $opt{label});
$note->{style} = $opt{style};
if ($opt{body})
{
$note->set_body(@{$opt{body}});
}
else
{
$note->set_body($opt{text});
}
return $note;
}
#-----------------------------------------------------------------------------
sub get_citation
{
my $self = shift;
my $c = $self->first_child('text:note-citation')
or return undef;
return $c->get_text;
}
sub set_citation
{
my $self = shift;
my $text = shift;
my $label = shift;
my $c = $self->set_child('text:note-citation');
$c->set_attribute('label' => $label) if defined $label;
$c->set_text($text);
return $c;
}
sub set_label
{
my $self = shift;
my $label = shift;
my $c = $self->set_child('text:note-citation');
$c->set_attribute('label' => $label) if defined $label;
return $c;
}
sub get_label
{
my $self = shift;
my $c = $self->first_child('text:note-citation')
or return undef;
return $c->get_attribute('label');
}
sub get_body
{
my $self = shift;
return $self->first_child('text:note-body');
}
sub set_body
{
my $self = shift;
my $body = $self->get_body();
if ($body)
{
$body->cut_children;
}
else
{
$body = $self->append_element('text:note-body');
}
foreach my $arg (@_)
{
if (ref $arg)
{
$arg->paste_last_child($body);
}
else
{
my $p = ODF::lpOD::Paragraph->create(
text => $arg, style => $self->{style}
);
$p->paste_last_child($body);
}
}
return $body;
}
#=============================================================================
package ODF::lpOD::Annotation;
use base 'ODF::lpOD::Element';
our $VERSION = '1.002';
use constant PACKAGE_DATE => '2011-02-15T11:16:59';
use ODF::lpOD::Common;
#-----------------------------------------------------------------------------
BEGIN {
*set_creator = *set_author;
*get_creator = *get_author;
}
#-----------------------------------------------------------------------------
sub _create { ODF::lpOD::Annotation->create(@_) }
#-----------------------------------------------------------------------------
sub create
{
my $caller = shift;
my %opt = @_;
my $a = ODF::lpOD::Element->create('office:annotation');
$a->set_date($opt{date});
$a->set_author($opt{author});
$a->set_style($opt{style});
$a->set_size($opt{size}) if defined $opt{size};
$a->set_position($opt{position}) if defined $opt{position};
$a->set_display($opt{display});
my $content = $opt{content};
unshift @$content, $opt{text} if defined $opt{text};
$a->set_content(@$content) if $content;
return $a;
}
#-----------------------------------------------------------------------------
sub set_date
{
my $self = shift;
my $date = shift;
my $elt = $self->set_child('dc:date');
unless ($date)
{
return $elt->set_text(iso_date);
}
else
{
my $d = check_odf_value($date, 'date');
unless ($d)
{
alert "Wrong date"; return undef;
}
return $elt->set_text($d);
}
}
sub get_date
{
my $self = shift;
my $elt = $self->first_child('dc:date') or return undef;
return $elt->get_text;
}
sub set_author
{
my $self = shift;
my $elt = $self->set_child('dc:creator');
return $elt->set_text
(
shift
//
(scalar getlogin())
//
(scalar getpwuid($<))
//
$<
);
}
sub get_author
{
my $self = shift;
my $elt = $self->first_child('dc:creator') or return undef;
return $elt->get_text;
}
sub get_content
{
my $self = shift;
return $self->children;
}
sub set_content
{
my $self = shift;
$self->cut_children(qr'^text');
foreach my $arg (@_)
{
if (ref $arg)
{
$arg->paste_last_child($self);
}
else
{
my $p = ODF::lpOD::Paragraph->create(
text => $arg, style => $self->{style}
);
$p->paste_last_child($self);
}
}
return $self->get_content;
}
sub set_style
{
my $self = shift;
return $self->{style} = shift;
}
sub get_style
{
my $self = shift;
return $self->{style};
}
sub set_text
{
my $self = shift;
return $self->set_content(@_);
}
sub get_text
{
my $self = shift;
return $self->get_text_content(@_);
}
#=============================================================================
package ODF::lpOD::ChangedRegion;
use base 'ODF::lpOD::Element';
our $VERSION = '1.000';
use constant PACKAGE_DATE => '2010-12-24T13:39:17';
use ODF::lpOD::Common;
#-----------------------------------------------------------------------------
sub get_changed_context
{
my $self = shift;
my $tcr = $self->parent('text:tracked-changes');
my $context = $tcr ? $tcr->parent() : undef;
unless ($context)
{
alert "Unknown tracked change context";
}
return $context;
}
sub get_info
{
my $self = shift;
my $tag = shift;
$tag = 'dc:' . $tag unless $tag =~ /:/;
my $info = $self->first_descendant($tag) or return undef;
return $info->get_text;
}
sub get_date
{
my $self = shift;
return $self->get_info('date');
}
sub get_author
{
my $self = shift;
return $self->get_info('creator');
}
sub get_type
{
my $self = shift;
my $t = $self->first_child or return undef;
my $type = $t->get_tag; $type =~ s/^text://;
return $type;
}
sub get_deleted_content
{
my $self = shift;
my $deleted = $self->first_child('text:deletion') or return undef;
my @content = ();
foreach my $e ($deleted->children)
{
my $tag = $e->get_tag;
push @content, $e unless $tag eq 'office:change-info';
}
return wantarray ? @content : [ @content ];
}
sub get_change_mark
{
my $self = shift;
my $id = $self->get_id;
my $context = $self->get_changed_context or return undef;
my $type = $self->get_type();
unless ($type)
{
alert "Unknown change type"; return undef;
}
my $tag = ($type eq 'deletion') ? 'text:change' : 'text:change-start';
return $context->get_element(
$tag,
attribute => 'change id',
value => $id
);
}
sub get_insertion_marks
{
my $self = shift;
my $id = $self->get_id;
my $context = $self->get_changed_context or return undef;
my $start = $context->get_element(
'text:change-start',
attribute => 'change id',
value => $id
);
my $end = $context->get_element(
'text:change-end',
attribute => 'change id',
value => $id
);
return wantarray ? ($start, $end) : [ $start, $end ];
}
#=============================================================================
package ODF::lpOD::FileEntry;
use base 'ODF::lpOD::Element';
our $VERSION = '1.000';
use constant PACKAGE_DATE => '2010-12-24T13:39:36';
use ODF::lpOD::Common;
#-----------------------------------------------------------------------------
BEGIN {
*set_text = *not_allowed;
*insert_element = *not_allowed;
*append_element = *not_allowed;
}
#-----------------------------------------------------------------------------
our @ALLOWED_ATTRIBUTES = ('manifest:media-type', 'manifest:full-path');
sub set_attribute
{
my $self = shift;
my $name = $self->normalize_name(shift);
unless ($name ~~ [ @ALLOWED_ATTRIBUTES ])
{
alert "Attribute $name is not allowed";
return FALSE;
}
return $self->SUPER::set_attribute($name, @_);
}
sub get_path
{
my $self = shift;
return $self->get_attribute('full path');
}
sub set_path
{
my $self = shift;
my $path = shift;
unless ($path)
{
alert "Missing or wrong path"; return FALSE;
}
my $old_path = $self->get_path;
my $lpod_part = $self->lpod_part;
my $other = $lpod_part ? $lpod_part->get_entry($path) : undef;
if ($other)
{
if ($other == $self)
{
return TRUE;
}
else
{
alert "Non unique entry path $path";
return FALSE;
}
}
$self->set_attribute('full path' => $path);
if ($path =~ /.\/$/)
{
$self->set_attribute('media type' => "");
}
return TRUE;
}
sub get_type
{
my $self = shift;
return $self->get_attribute('media type');
}
sub set_type
{
my $self = shift;
my $type = shift;
return $self->set_attribute('media type' => $type);
}
#=============================================================================
1;