File Coverage

blib/lib/Org/Element.pm

Criterion	Covered	Total	%
statement	98	112	87.5
branch	35	50	70.0
condition	8	14	57.1
subroutine	21	22	95.4
pod	14	14	100.0
total	176	212	83.0

use 5.010;
use locale;
use Log::ger;
use Moo;
use Scalar::Util qw(refaddr);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-06-23'; # DATE
our $DIST = 'Org-Parser'; # DIST
our $VERSION = '0.558'; # VERSION

has document => (is => 'rw');
has parent => (is => 'rw');
has children => (is => 'rw');

# store the raw string (to preserve original formatting), not all elements use
# this, usually only more complex elements
has _str => (is => 'rw');
has _str_include_children => (is => 'rw');

    my ($self) = @_;
    return "" unless $self->children;
    join "", map {$_->as_string} @{$self->children};
}

    my ($self) = @_;

    if (defined $self->_str) {
        return $self->_str .
            ($self->_str_include_children ? "" : $self->children_as_string);
    } else {
        return "" . $self->children_as_string;
    }
}

    my ($self) = @_;
    my $c;
    return -4 unless $self->parent && ($c = $self->parent->children);
    my $addr = refaddr($self);
    for (my $i=0; $i < @$c; $i++) {
        return $i if refaddr($c->[$i]) == $addr;
    }
    return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
}

    my ($self) = @_;

    my $sen = $self->seniority;
    return undef unless defined($sen) && $sen > 0; ## no critic: Subroutines::ProhibitExplicitReturnUndef
    my $c = $self->parent->children;
    $c->[$sen-1];
}

    my ($self) = @_;

    my $sen = $self->seniority;
    return undef unless defined($sen); ## no critic: Subroutines::ProhibitExplicitReturnUndef
    my $c = $self->parent->children;
    return undef unless $sen < @$c-1; ## no critic: Subroutines::ProhibitExplicitReturnUndef
    $c->[$sen+1];
}


    my ($self, $code, $_level) = @_;
    $_level //= 0;
    $code->($self, $_level);
    if ($self->children) {
        # we need to copy children first to a temporary array so that in the
        # event when during walk a child is removed, all the children are still
        # walked into.
        my @children = @{ $self->children };
        for (@children) {
            $_->walk($code, $_level+1);
        }
    }
    $_->walk($code, $_level+1) for $self->extra_walkables;
}

    my ($self, $criteria) = @_;
    return unless $self->children;
    my @res;
    $self->walk(
        sub {
            my $el = shift;
            if (ref($criteria) eq 'CODE') {
                push @res, $el if $criteria->($el);
            } elsif ($criteria =~ /^\w+$/) {
                push @res, $el if $el->isa("Org::Element::$criteria");
            } else {
                push @res, $el if $el->isa($criteria);
            }
        });
    @res;
}

    my ($self, $code) = @_;
    my $parent = $self->parent;
    while ($parent) {
        return $parent unless $code->($self, $parent);
        $parent = $parent->parent;
    }
    return;
}

    my ($self) = @_;
    my $h;
    $self->walk_parents(
        sub {
            my ($el, $p) = @_;
            if ($p->isa('Org::Element::Headline')) {
                $h = $p;
                return;
            }
            1;
        });
    $h;
}

    my ($self) = @_;
    my @res;
    $self->walk_parents(
        sub {
            my ($el, $p) = @_;
            if ($p->isa('Org::Element::Headline')) {
                push @res, $p;
            }
            1;
        });
    @res;
}

    my ($self, $criteria) = @_;

    my @settings = grep { $_->isa("Org::Element::Setting") }
        @{ $self->children };
    if ($criteria) {
        if (ref $criteria eq 'CODE') {
            @settings = grep { $criteria->($_) } @settings;
        } else {
            @settings = grep { $_->name eq $criteria } @settings;
        }
    }
    @settings;
}

    my ($self) = @_;

    my $prev = $self->prev_sibling;
    if ($prev && $prev->isa('Org::Element::Text')) {
        my $text = $prev->as_string;
        if ($text =~ /(?:\A|\R)\s*(.+?)\s*:\s*\z/) {
            return $1;
        }
    }
    my $parent = $self->parent;
    if ($parent && $parent->isa('Org::Element::ListItem')) {
        my $list = $parent->parent;
        if ($list->type eq 'D') {
            return $parent->desc_term->as_string;
        }
    }
    # TODO
    #if ($parent && $parent->isa('Org::Element::Drawer') &&
    #        $parent->name eq 'PROPERTIES') {
    #}
    return;
}

    my ($self) = @_;
    my $parent = $self->parent;
    return unless $parent;
    splice @{$parent->children}, $self->seniority, 1;
}

1;
# ABSTRACT: Base class for Org document elements


=pod

=encoding UTF-8

=head1 NAME

Org::Element - Base class for Org document elements

=head1 VERSION

This document describes version 0.558 of Org::Element (from Perl distribution Org-Parser), released on 2022-06-23.

=head1 SYNOPSIS

 # Don't use directly, use the other Org::Element::* classes.

=head1 DESCRIPTION

This is the base class for all the other Org element classes.

=head1 ATTRIBUTES

=head2 document => DOCUMENT

Link to document object. Elements need this to access file-wide settings,
properties, etc.

=head2 parent => undef | ELEMENT

Link to parent element. Undef if this element is the root element.

=head2 children => undef | ARRAY_OF_ELEMENTS

=head1 METHODS

=head2 $el->children_as_string() => STR

Return a concatenation of children's as_string(), or "" if there are no
children.

=head2 $el->as_string() => STR

Return the string representation of element. The default implementation will
just use _str (if defined) concatenated with children_as_string().

=head2 $el->seniority => INT

Find out the ranking of brothers/sisters of all sibling. If we are the first
child of parent, return 0. If we are the second child, return 1, and so on.

=head2 $el->prev_sibling() => ELEMENT | undef

=head2 $el->next_sibling() => ELEMENT | undef

=head2 $el->extra_walkables => LIST

Return extra walkable elements. The default is to return an empty list, but some
elements can have this, for L<Org::Element::Headline>'s title is also a walkable
element.

=head2 $el->walk(CODEREF)

Call CODEREF for node and all descendent nodes (and extra walkables),
depth-first. Code will be given the element object as argument.

=head2 $el->find(CRITERIA) => ELEMENTS

Find subelements. CRITERIA can be a word (e.g. 'Headline' meaning of class
'Org::Element::Headline') or a class name ('Org::Element::ListItem') or a
coderef (which will be given the element to test). Will return matched elements.

=head2 $el->walk_parents(CODE)

Run CODEREF for parent, and its parent, and so on until the root element (the
document), or until CODEREF returns a false value. CODEREF will be supplied
($el, $parent). Will return the last parent walked.

=head2 $el->headline() => ELEMENT

Get current headline. Return undef if element is not under any headline.

=head2 $el->headlines() => ELEMENTS

Get current headline (in the first element of the result list), its parent, its
parent's parent, and so on until the topmost headline. Return empty list if
element is not under any headline.

=head2 $el->settings(CRITERIA) => ELEMENTS

Get L<Org::Element::Setting> nodes directly under the element. Equivalent to:

 my @settings = grep { $_->isa("Org::Element::Setting") } @{ $el->children };

If CRITERIA is specified, will filter based on some criteria. CRITERIA can be a
coderef, or a string to filter by setting's name, example:

 my ($doc_title) = $doc->settings('TITLE');

Take note of the list operator on the left because C<settings()> return a list.

=head2 $el->field_name() => STR

Try to extract "field name", being defined as either some text on the left side:

 DEADLINE: <2011-06-09 >

or a description term in a description list:

 - wedding anniversary :: <2011-06-10 >

=head2 $el->remove()

Remove element from the tree. Basically just remove the element from its parent.

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Org-Parser>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Org-Parser>.

=head1 AUTHOR

perlancar <[e-mail]>

=head1 CONTRIBUTING


To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.

Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:

 % prove -l

If you want to build the distribution (e.g. to try to install it locally on your
system), you can install L<Dist::Zilla>,
L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
beyond that are considered a bug and can be reported to me.

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2022, 2021, 2020, 2019, 2017, 2016, 2015, 2014, 2013, 2012, 2011 by perlancar <[e-mail]>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Org-Parser>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=cut