lib/Org/Element.pm

   1 package Org::Element;
   2
   3 use 5.010;
   4 use locale;
   5 use Log::Any '$log';
   6 use Moo;
   7 use Scalar::Util qw(refaddr);
   8
   9 our $VERSION = '0.23'; # VERSION
  10
  11 has document => (is => 'rw');
  12 has parent => (is => 'rw');
  13 has children => (is => 'rw');
  14
  15 # store the raw string (to preserve original formatting), not all elements use
  16 # this, usually only more complex elements
  17 has _str => (is => 'rw');
  18 has _str_include_children => (is => 'rw');
  19
  20 sub children_as_string {
  21     my ($self) = @_;
  22     return "" unless $self->children;
  23     join "", map {$_->as_string} @{$self->children};
  24 }
  25
  26 sub as_string {
  27     my ($self) = @_;
  28
  29     if (defined $self->_str) {
  30         return $self->_str .
  31             ($self->_str_include_children ? "" : $self->children_as_string);
  32     } else {
  33         return "" . $self->children_as_string;
  34     }
  35 }
  36
  37 sub seniority {
  38     my ($self) = @_;
  39     my $c;
  40     return -4 unless $self->parent && ($c = $self->parent->children);
  41     my $addr = refaddr($self);
  42     for (my $i=0; $i < @$c; $i++) {
  43         return $i if refaddr($c->[$i]) == $addr;
  44     }
  45     return undef;
  46 }
  47
  48 sub prev_sibling {
  49     my ($self) = @_;
  50
  51     my $sen = $self->seniority;
  52     return undef unless defined($sen) && $sen > 0;
  53     my $c = $self->parent->children;
  54     $c->[$sen-1];
  55 }
  56
  57 sub next_sibling {
  58     my ($self) = @_;
  59
  60     my $sen = $self->seniority;
  61     return undef unless defined($sen);
  62     my $c = $self->parent->children;
  63     return undef unless $sen < @$c-1;
  64     $c->[$sen+1];
  65 }
  66
  67 sub get_property {
  68     my ($self, $name, $search_parent) = @_;
  69     #$log->tracef("-> get_property(%s, search_par=%s)", $name, $search_parent);
  70     my $p = $self->parent;
  71     my $s = $p->children if $p;
  72
  73     if ($s) {
  74         for my $d (@$s) {
  75         #$log->tracef("searching in sibling: %s (%s)", $d->as_string, ref($d));
  76             next unless $d->isa('Org::Element::Drawer')
  77                 && $d->name eq 'PROPERTIES' && $d->properties;
  78             return $d->properties->{$name} if defined $d->properties->{$name};
  79         }
  80     }
  81
  82     if ($p && $search_parent) {
  83         my $res = $p->get_property($name, 1);
  84         return $res if defined $res;
  85     }
  86
  87     $log->tracef("Getting property from document's .properties");
  88     $self->document->properties->{$name};
  89 }
  90
  91 sub walk {
  92     my ($self, $code) = @_;
  93     $code->($self);
  94     if ($self->children) {
  95         $_->walk($code) for @{$self->children};
  96     }
  97 }
  98
  99 sub find {
 100     my ($self, $criteria) = @_;
 101     return unless $self->children;
 102     my @res;
 103     $self->walk(
 104         sub {
 105             my $el = shift;
 106             if (ref($criteria) eq 'CODE') {
 107                 push @res, $el if $criteria->($el);
 108             } elsif ($criteria =~ /^\w+$/) {
 109                 push @res, $el if $el->isa("Org::Element::$criteria");
 110             } else {
 111                 push @res, $el if $el->isa($criteria);
 112             }
 113         });
 114     @res;
 115 }
 116
 117 sub walk_parents {
 118     my ($self, $code) = @_;
 119     my $parent = $self->parent;
 120     while ($parent) {
 121         return $parent unless $code->($self, $parent);
 122         $parent = $parent->parent;
 123     }
 124     return;
 125 }
 126
 127 sub headline {
 128     my ($self) = @_;
 129     my $h;
 130     $self->walk_parents(
 131         sub {
 132             my ($el, $p) = @_;
 133             if ($p->isa('Org::Element::Headline')) {
 134                 $h = $p;
 135                 return;
 136             }
 137             1;
 138         });
 139     $h;
 140 }
 141
 142 sub field_name {
 143     my ($self) = @_;
 144
 145     my $prev = $self->prev_sibling;
 146     if ($prev && $prev->isa('Org::Element::Text')) {
 147         my $text = $prev->as_string;
 148         if ($text =~ /(?:\A|\R)\s*(.+?)\s*:\s*\z/) {
 149             return $1;
 150         }
 151     }
 152     my $parent = $self->parent;
 153     if ($parent && $parent->isa('Org::Element::ListItem')) {
 154         my $list = $parent->parent;
 155         if ($list->type eq 'D') {
 156             return $parent->desc_term->as_string;
 157         }
 158     }
 159     # TODO
 160     #if ($parent && $parent->isa('Org::Element::Drawer') &&
 161     #        $parent->name eq 'PROPERTIES') {
 162     #}
 163     return;
 164 }
 165
 166 sub remove {
 167     my ($self) = @_;
 168     my $parent = $self->parent;
 169     return unless $parent;
 170     splice @{$parent->children}, $self->seniority, 1;
 171 }
 172
 173 1;
 174 # ABSTRACT: Base class for Org document elements
 175
 176
 177 __END__
 178 =pod
 179
 180 =head1 NAME
 181
 182 Org::Element - Base class for Org document elements
 183
 184 =head1 VERSION
 185
 186 version 0.23
 187
 188 =head1 SYNOPSIS
 189
 190  # Don't use directly, use the other Org::Element::* classes.
 191
 192 =head1 DESCRIPTION
 193
 194 This is the base class for all the other Org element classes.
 195
 196 =head1 ATTRIBUTES
 197
 198 =head2 document => DOCUMENT
 199
 200 Link to document object. Elements need this to access file-wide settings,
 201 properties, etc.
 202
 203 =head2 parent => undef | ELEMENT
 204
 205 Link to parent element. Undef if this element is the root element.
 206
 207 =head2 children => undef | ARRAY_OF_ELEMENTS
 208
 209 =head1 METHODS
 210
 211 =head2 $el->children_as_string() => STR
 212
 213 Return a concatenation of children's as_string(), or "" if there are no
 214 children.
 215
 216 =head2 $el->as_string() => STR
 217
 218 Return the string representation of element. The default implementation will
 219 just use _str (if defined) concatenated with children_as_string().
 220
 221 =head2 $el->seniority => INT
 222
 223 Find out the ranking of brothers/sisters of all sibling. If we are the first
 224 child of parent, return 0. If we are the second child, return 1, and so on.
 225
 226 =head2 $el->prev_sibling() => ELEMENT | undef
 227
 228 =head2 $el->next_sibling() => ELEMENT | undef
 229
 230 =head2 $el->get_property($name, $search_parent) => VALUE
 231
 232 Search for property named $name in the nearest properties drawer. If
 233 $search_parent is set to true (default is false), will also search in
 234 upper-level properties (useful for searching for inherited property, like
 235 foo_ALL). Return undef if property cannot be found in all drawers.
 236
 237 Regardless of $search_parent setting, file-wide properties will be consulted if
 238 property is not found in nearest properties drawer.
 239
 240 =head2 $el->walk(CODEREF)
 241
 242 Call CODEREF for node and all descendent nodes, depth-first. Code will be given
 243 the element object as argument.
 244
 245 =head2 $el->find(CRITERIA) => ELEMENTS
 246
 247 Find subelements. CRITERIA can be a word (e.g. 'Headline' meaning of class
 248 'Org::Element::Headline') or a class name ('Org::Element::ListItem') or a
 249 coderef (which will be given the element to test). Will return matched elements.
 250
 251 =head2 $el->walk_parents(CODE)
 252
 253 Run CODEREF for parent, and its parent, and so on until the root element (the
 254 document), or until CODEREF returns a false value. CODEREF will be supplied
 255 ($el, $parent). Will return the last parent walked.
 256
 257 =head2 $el->headline() => ELEMENT
 258
 259 Get current headline.
 260
 261 =head2 $el->field_name() => STR
 262
 263 Try to extract "field name", being defined as either some text on the left side:
 264
 265  DEADLINE: <2011-06-09 >
 266
 267 or a description term in a description list:
 268
 269  - wedding anniversary :: <2011-06-10 >
 270
 271 =head2 $el->remove()
 272
 273 Remove element from the tree. Basically just remove the element from its parent.
 274
 275 =head1 AUTHOR
 276
 277 Steven Haryanto <stevenharyanto@gmail.com>
 278
 279 =head1 COPYRIGHT AND LICENSE
 280
 281 This software is copyright (c) 2012 by Steven Haryanto.
 282
 283 This is free software; you can redistribute it and/or modify it under
 284 the same terms as the Perl 5 programming language system itself.
 285
 286 =cut
 287