File Coverage

blib/lib/Org/Document.pm
Criterion Covered Total %
statement 368 374 98.4
branch 161 174 92.5
condition 116 137 84.6
subroutine 25 25 100.0
pod 2 3 66.6
total 672 713 94.2


line stmt bran cond sub pod time code
1             package Org::Document;
2              
3 26     26   397664 use 5.010001;
  26         103  
4 26     26   13547 use locale;
  26         24017  
  26         169  
5 26     26   53978 use Log::ger;
  26         1677  
  26         177  
6 26     26   9095 use Moo;
  26         25203  
  26         158  
7 26     26   19025 no if $] >= 5.021_006, warnings => "locale";
  26         65  
  26         3889  
8             extends 'Org::Element';
9              
10 26     26   16462 use List::MoreUtils qw(firstidx);
  26         468184  
  26         293  
11 26     26   53834 use Time::HiRes qw(gettimeofday tv_interval);
  26         38478  
  26         200  
12              
13             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
14             our $DATE = '2023-11-06'; # DATE
15             our $DIST = 'Org-Parser'; # DIST
16             our $VERSION = '0.561'; # VERSION
17              
18             has _srclabel => (is => 'rw');
19             has tags => (is => 'rw');
20             has todo_states => (is => 'rw');
21             has done_states => (is => 'rw');
22             has priorities => (is => 'rw');
23             has drawer_names => (is => 'rw');
24             has properties => (is => 'rw');
25             has radio_targets => (is => 'rw');
26              
27             has time_zone => (is => 'rw');
28              
29             has ignore_unknown_settings => (is => 'rw');
30              
31             our $tags_re = qr/:(?:[\w@]+:)+/u;
32             my $ls_re = qr/(?:(?<=[\015\012])|\A)/; # line start
33             my $le_re = qr/(?:\R|\z)/; # line end
34             our $arg_re = qr/(?: '(?<squote> [^']*)' |
35             "(?<dquote> [^"]*)" |
36             (?<bare> \S+) )
37             /x;
38             our $args_re = qr/(?: $arg_re (?:[ \t]+ $arg_re)*)/x;
39             my $tstamp_re = qr/(?:\[\d{4}-\d{2}-\d{2} [^\n\]]*\])/x;
40             my $act_tstamp_re = qr/(?: <\d{4}-\d{2}-\d{2} [^\n>]* >)/x;
41             my $fn_name_re = qr/(?:[^ \t\n:\]]+)/x;
42             my $text_re =
43             qr{
44             (?<link> \[\[(?<link_link> [^\]\n]+)\]
45             (?:\[(?<link_desc> (?:[^\]]|\R)+)\])?\]) |
46             (?<radio_target> <<<(?<rt_target> [^>\n]+)>>>) |
47             (?<target> <<(?<t_target> [^>\n]+)>>) |
48              
49             # timestamp & time range
50             (?<trange> (?<trange_ts1> $tstamp_re)--
51             (?<trange_ts2> $tstamp_re)) |
52             (?<tstamp> $tstamp_re) |
53             (?<act_trange> (?<act_trange_ts1> $act_tstamp_re)--
54             (?<act_trange_ts2> $act_tstamp_re)) |
55             (?<act_tstamp> $act_tstamp_re) |
56              
57             # footnote (num, name + def, name + inline definition)
58             (?<fn_num> \[(?<fn_num_num>\d+)\]) |
59             (?<fn_namedef> $ls_re \[fn:(?<fn_namedef_name> $fn_name_re)\]
60             [ \t]* (?<fn_namedef_def> [^ \t\n]+)) |
61             (?<fn_nameidef> \[fn:(?<fn_nameidef_name> $fn_name_re?):?
62             (?<fn_nameidef_def> ([^\n\]]+)?)\]) |
63              
64             (?<markup_start> (?:(?<=\s|\(|\{)|\A) # whitespace, open paren, open curly paren
65             [*/+=~_]
66             (?=\S)) |
67             (?<markup_end> (?<=\S)
68             [*/+=~_]
69             # actually emacs doesn't allow ! after markup
70             (?:(?=[ \t\n:;"',.!?\)*-])|\z)) |
71              
72             (?<plain_text> (?:[^\[<*/+=~_\n]+|.+?))
73             #(?<plain_text> .+?) # too dispersy
74             }sxi;
75              
76             # XXX parser must be fixed: block elements have different precedence instead of
77             # flat like this. a headline has the highest precedence and a block or a drawer
78             # cannot contain a headline (e.g. "#+BEGIN_SRC foo\n* header\n#+END_SRC" should
79             # not contain a literal "* header" text but that is a headline. currently, a
80             # block or a drawer swallows a headline.
81              
82             my $block_elems_re = # top level elements
83             qr/(?<block> $ls_re (?<block_begin_indent>[ \t]*)
84             \#\+BEGIN_(?<block_name>\w+)
85             (?:[ \t]+(?<block_raw_arg>[^\n]*))?\R
86             (?<block_content>(?:.|\R)*?)
87             \R(?<block_end_indent>[ \t]*)
88             \#\+END_\k<block_name> $le_re) |
89             (?<setting> $ls_re (?<setting_indent>[ \t]*) \#\+
90             (?<setting_name> \w+): (?: [ \t]+
91             (?<setting_raw_arg> [^\n]*))? $le_re) |
92             (?<fixedw> (?: $ls_re [ \t]* (?::[ ][^\n]* | :$) $le_re )+ ) |
93             (?<comment> $ls_re [ \t]*\#[^\n]*(?:\R\#[^\n]*)* (?:\R|\z)) |
94             (?<headline> $ls_re (?<h_bullet>\*+) [ \t]
95             (?<h_title>[^\n]*?)
96             (?:[ \t]+(?<h_tags> $tags_re))?[ \t]* $le_re) |
97             (?<li_header> $ls_re (?<li_indent>[ \t]*)
98             (?<li_bullet>[+*-]|\d+\.) [ \t]+
99             (?<li_checkbox> \[(?<li_cbstate> [ X-])\])?
100             (?: (?<li_dt> [^\n]+?) [ ]::)?) |
101             (?<table> (?: $ls_re [ \t]* \| [ \t]* \S[^\n]* $le_re)+) |
102             (?<drawer> $ls_re [ \t]* :(?<drawer_name> \w+): [ \t]*\R
103             (?<drawer_content>(?:.|\R)*?)
104             $ls_re [ \t]* :END:) |
105             (?<text> (?:[^#|:+*0-9\n-]+|\n+|.)+?)
106             #(?<text> .+?) # too dispersy
107             /msxi;
108              
109             sub _init_pass1 {
110 95     95   237 my ($self) = @_;
111 95         449 $self->tags([]);
112 95         412 $self->todo_states([]);
113 95         319 $self->done_states([]);
114 95         325 $self->priorities([]);
115 95         311 $self->properties({});
116 95         436 $self->drawer_names([qw/CLOCK LOGBOOK PROPERTIES/]);
117             # FEEDSTATUS
118 95         361 $self->radio_targets([]);
119             }
120              
121             sub _init_pass2 {
122 93     93   438 my ($self) = @_;
123 93 50 66     204 if (!@{ $self->todo_states } && !@{ $self->done_states }) {
  93         497  
  81         395  
124 81         323 $self->todo_states(['TODO']);
125 81         266 $self->done_states(['DONE']);
126             }
127 93 100       195 if (!@{ $self->priorities }) {
  93         393  
128 89         381 $self->priorities([qw/A B C/]);
129             }
130 93         574 $self->children([]);
131             }
132              
133             sub __parse_args {
134 57     57   111 my $args = shift;
135 57 100 66     330 return [] unless defined($args) && length($args);
136             #$log->tracef("args = %s", $args);
137 55         91 my @args;
138 55         1342 while ($args =~ /$arg_re (?:\s+|\z)/xg) {
139 165 50       1023 if (defined $+{squote}) {
    50          
140 0         0 push @args, $+{squote};
141             } elsif (defined $+{dquote}) {
142 0         0 push @args, $+{dquote};
143             } else {
144 165         1247 push @args, $+{bare};
145             }
146             }
147             #$log->tracef("\\\@args = %s", \@args);
148 55         1346 \@args;
149             }
150              
151             sub __format_args {
152 2     2   4 my ($args) = @_;
153 2         2 my @s;
154 2         5 for (@$args) {
155 4 50       16 if (/\A(?:[A-Za-z0-9_:-]+|\|)\z/) {
    0          
156 4         7 push @s, $_;
157             } elsif (/"/) {
158 0         0 push @s, qq('$_');
159             } else {
160 0         0 push @s, qq("$_");
161             }
162             }
163 2         16 join " ", @s;
164             }
165              
166             sub BUILD {
167 96     96 0 859169 my ($self, $args) = @_;
168 96 50       870 $self->document($self) unless $self->document;
169              
170 96 100       448 if (defined $args->{from_string}) {
171              
172             # NOTE: parsing is done twice. first pass will set settings (e.g. custom
173             # todo keywords set by #+TODO), scan for radio targets. after that we
174             # scan again to build the elements tree.
175              
176 95         456 $self->_init_pass1();
177 95         440 $self->_parse($args->{from_string}, 1);
178 93         2450 $self->_init_pass2();
179 93         329 $self->_parse($args->{from_string}, 2);
180             }
181             }
182              
183             # parse blocky elements: setting, blocks, headline, drawer
184             sub _parse {
185 188     188   489 my ($self, $str, $pass) = @_;
186 188         884 log_trace('-> _parse(%s, pass=%d)', $str, $pass);
187 188         1076 my $t0 = [gettimeofday];
188              
189 188         431 my $last_el;
190              
191             my $last_headline;
192 188         435 my $last_headlines = [$self]; # [$doc, $last_hl_level1, $last_hl_lvl2, ...]
193 188         298 my $last_listitem;
194 188         354 my $last_lists = []; # [last_List_obj_for_indent_level0, ...]
195 188         403 my $parent;
196              
197             my @text;
198 188         3436 while ($str =~ /$block_elems_re/og) {
199 4729   100     14813 $parent = $last_listitem // $last_headline // $self;
      66        
200             #$log->tracef("TMP: parent=%s (%s)", ref($parent), $parent->_str);
201 4729         35249 my %m = %+;
202 4729 50       11879 next unless keys %m; # perlre bug?
203             #if ($log->is_trace) {
204             # # profiler shows that this is very heavy, so commenting this out
205             # $log->tracef("TMP: match block element: %s", \%+) if $pass==2;
206             #}
207              
208 4729 100       8358 if (defined $m{text}) {
209 4049         6316 push @text, $m{text};
210 4049         24988 next;
211             } else {
212 680 100       1616 if (@text) {
213 270         2320 my $text = join("", @text);
214 270 100 100     1397 if ($last_el && $last_el->isa('Org::Element::ListItem')) {
215             # a list is broken by either: a) another list (where the
216             # bullet type or indent is different; handled in the
217             # handling of $m{li_header}) or b) by two blank lines, or c)
218             # by non-blank text that is indented less than or equal to
219             # the last list item's indent.
220              
221             # a single blank line does not break a list. a text that is
222             # more indented than the last list item's indent will become
223             # the child of that list item.
224              
225 85         381 my ($firstline, $restlines) = $text =~ /(.*?\r?\n)(.+)/s;
226 85 100       200 if ($restlines) {
227 17         47 $restlines =~ /\A([ \t]*)/;
228 17         42 my $restlineslevel = length($1);
229 17         80 my $listlevel = length($last_el->parent->indent);
230 17 100       42 if ($restlineslevel <= $listlevel) {
231 11         20 my $origparent = $parent;
232             # find lesser-indented list
233 11   33     31 $parent = $last_headline // $self;
234 11         34 for (my $i=$restlineslevel-1; $i>=0; $i--) {
235 2 50       10 if ($last_lists->[$i]) {
236 2         4 $parent = $last_lists->[$i];
237 2         20 last;
238             }
239             }
240 11         25 splice @$last_lists, $restlineslevel;
241 11         41 $self->_add_text($firstline, $origparent, $pass);
242 11         32 $self->_add_text($restlines, $parent, $pass);
243 11         126 goto SKIP1;
244             }
245             }
246             }
247 259         868 $self->_add_text($text, $parent, $pass);
248 270         832 SKIP1:
249             @text = ();
250 270         475 $last_el = undef;
251             }
252             }
253              
254 680         1007 my $el;
255 680 100 100     6881 if ($m{block} && $pass == 2) {
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100          
256              
257 3         712 require Org::Element::Block;
258             $el = Org::Element::Block->new(
259             _str=>$m{block},
260             document=>$self, parent=>$parent,
261             begin_indent=>$m{block_begin_indent},
262             end_indent=>$m{block_end_indent},
263             name=>$m{block_name}, args=>__parse_args($m{block_raw_arg}),
264             raw_content=>$m{block_content},
265 3         29 );
266              
267             } elsif ($m{setting}) {
268              
269 60         5928 require Org::Element::Setting;
270 60         284 my $uc_setting_name = uc($m{setting_name});
271 60 100 100     222 if ($m{setting_indent} &&
272 8         38 !(grep { $_ eq $uc_setting_name }
273 8         32 @{Org::Element::Setting->indentable_settings})) {
274 6         16 push @text, $m{setting};
275 6         63 next;
276             } else {
277             $el = Org::Element::Setting->new(
278             pass => $pass,
279             _str=>$m{setting},
280             document=>$self, parent=>$parent,
281             indent => $m{setting_indent},
282             name=>$m{setting_name},
283             raw_arg => $m{setting_raw_arg},
284 54         264 args=>__parse_args($m{setting_raw_arg}),
285             );
286             }
287              
288             } elsif ($m{fixedw} && $pass == 2) {
289              
290 7         1154 require Org::Element::FixedWidthSection;
291             $el = Org::Element::FixedWidthSection->new(
292             pass => $pass,
293             _str=>$m{fixedw},
294 7         216 document=>$self, parent=>$parent,
295             );
296              
297             } elsif ($m{comment} && $pass == 2) {
298              
299 18         5420 require Org::Element::Comment;
300             $el = Org::Element::Comment->new(
301             _str=>$m{comment},
302 18         465 document=>$self, parent=>$parent,
303             );
304              
305             } elsif ($m{table} && $pass == 2) {
306              
307 6         1678 require Org::Element::Table;
308             $el = Org::Element::Table->new(
309             pass=>$pass,
310             _str=>$m{table},
311 6         74 document=>$self, parent=>$parent,
312             );
313              
314             } elsif ($m{drawer} && $pass == 2) {
315              
316 15         2880 require Org::Element::Drawer;
317 15         55 my $raw_content = $m{drawer_content};
318             $el = Org::Element::Drawer->new(
319             document=>$self, parent=>$parent,
320 15         323 name => uc($m{drawer_name}), pass => $pass,
321             );
322 14         75 $self->_add_text($raw_content, $el, $pass);
323              
324             # for properties, we also parse property lines from raw drawer
325             # content. this is currently separate from normal Org text parsing,
326             # i'm not clear yet on how to do this canonically.
327 14         43 $el->_parse_properties($raw_content);
328              
329             } elsif ($m{li_header} && $pass == 2) {
330              
331 90         3351 require Org::Element::List;
332 90         2641 require Org::Element::ListItem;
333              
334 90         214 my $level = length($m{li_indent});
335 90         157 my $bullet = $m{li_bullet};
336 90         126 my $indent = $m{li_indent};
337 90         133 my $dt = $m{li_dt};
338 90         119 my $cbstate = $m{li_cbstate};
339 90 100       270 my $type = defined($dt) ? 'D' :
    100          
340             $bullet =~ /^\d+\./ ? 'O' : 'U';
341 90 100       208 my $bstyle = $type eq 'O' ? '<N>.' : $bullet;
342              
343             # parent for list is the last listitem of a lesser-indented list (or
344             # last headline, or document)
345 90   66     185 $parent = $last_headline // $self;
346 90         218 for (my $i=$level-1; $i>=0; $i--) {
347 107 100       261 if ($last_lists->[$i]) {
348 27         68 $parent = $last_lists->[$i]->children->[-1];
349 27         104 last;
350             }
351             }
352              
353 90         134 my $list = $last_lists->[$level];
354 90 100 100     389 if (!$list || $list->type ne $type ||
      100        
355             $list->bullet_style ne $bstyle) {
356 51         1225 $list = Org::Element::List->new(
357             document => $self, parent => $parent,
358             indent=>$indent, type=>$type, bullet_style=>$bstyle,
359             );
360 51         13542 $last_lists->[$level] = $list;
361 51 100       186 $parent->children([]) if !$parent->children;
362 51         80 push @{ $parent->children }, $list;
  51         112  
363             }
364 90         127 $last_lists->[$level] = $list;
365              
366             # parent for list item is list
367 90         116 $parent = $list;
368              
369 90         1631 $el = Org::Element::ListItem->new(
370             document=>$self, parent=>$list,
371             indent=>$indent, bullet=>$bullet);
372 90 100       9891 $el->check_state($cbstate) if $cbstate;
373 90 100       266 $el->desc_term($self->_add_text_container($dt, $list, $pass))
374             if defined($dt);
375              
376 90         167 splice @$last_lists, $level+1;
377 90         171 $last_listitem = $el;
378              
379             } elsif ($m{headline} && $pass == 2) {
380              
381 171         10434 require Org::Element::Headline;
382 171         476 my $level = length $m{h_bullet};
383              
384             # parent is upper-level headline
385 171         321 $parent = undef;
386 171         563 for (my $i=$level-1; $i>=0; $i--) {
387 181 100       585 $parent = $last_headlines->[$i] and last;
388             }
389 171   33     372 $parent //= $self;
390              
391             $el = Org::Element::Headline->new(
392             _str=>$m{headline},
393 171         4041 document=>$self, parent=>$parent,
394             level=>$level,
395             );
396 171 100       42323 $el->tags(__split_tags($m{h_tags})) if ($m{h_tags});
397 171         333 my $title = $m{h_title};
398              
399             # recognize todo keyword
400             my $todo_kw_re = "(?:".
401 595         1647 join("|", map {quotemeta}
402             "COMMENT",
403 171         281 @{$self->todo_states}, @{$self->done_states}) . ")";
  171         480  
  171         528  
404 171 100       3528 if ($title =~ s/^($todo_kw_re)(\s+|\W)/$2/) {
405 38         101 my $state = $1;
406 38         140 $title =~ s/^\s+//;
407 38         131 $el->is_todo(1);
408 38         112 $el->todo_state($state);
409 38 100       63 $el->is_done((grep { $_ eq $state } @{ $self->done_states }) ? 1:0);
  52         259  
  38         153  
410             }
411              
412             # recognize priority cookie
413             my $prio_re = "(?:".
414 171         318 join("|", map {quotemeta} @{$self->priorities}) . ")";
  517         1171  
  171         407  
415 171 100       1310 if ($title =~ s/\[#($prio_re)\]\s*//) {
416 4         18 $el->priority($1);
417             }
418              
419             # recognize statistics cookie
420 171 100       497 if ($title =~ s!\[(\d+%|\d+/\d+)\]\s*!!o) {
421 6         20 $el->statistics_cookie($1);
422             }
423              
424 171         470 $el->title($self->_add_text_container($title, $parent, $pass));
425              
426 171         503 $last_headlines->[$el->level] = $el;
427 171         441 splice @$last_headlines, $el->level+1;
428 171         260 $last_headline = $el;
429 171         251 $last_listitem = undef;
430 171         389 $last_lists = [];
431             }
432              
433             # we haven't caught other matches to become element
434 670 50 66     45488 die "BUG1: no element" unless $el || $pass != 2;
435              
436 670 100       2205 $parent->children([]) if !$parent->children;
437 670         989 push @{ $parent->children }, $el;
  670         1627  
438 670         8744 $last_el = $el;
439             }
440              
441             # remaining text
442 184 100       575 if (@text) {
443 79         483 $self->_add_text(join("", @text), $parent, $pass);
444             }
445 181         541 @text = ();
446              
447 181         3032 log_trace('<- _parse(), elapsed time=%.3fs',
448             tv_interval($t0, [gettimeofday]));
449             }
450              
451             sub _add_text_container {
452 185     185   2235 require Org::Element::Text;
453 185         490 my ($self, $str, $parent, $pass) = @_;
454 185         4039 my $container = Org::Element::Text->new(
455             document=>$self, parent=>$parent,
456             text=>'', style=>'',
457             );
458 185         18069 $self->_add_text($str, $container, $pass);
459             $container = $container->children->[0] if
460 185 100 100     564 $container->children && @{$container->children} == 1 &&
  183   66     2096  
461             $container->children->[0]->isa('Org::Element::Text');
462 185         607 $container;
463             }
464              
465             sub _add_text {
466 591     591   16569 require Org::Element::Text;
467 591         1457 my ($self, $str, $parent, $pass) = @_;
468 591   33     1915 $parent //= $self;
469             #$log->tracef("-> _add_text(%s, pass=%d)", $str, $pass);
470              
471 591         796 my @plain_text;
472 591         4338 while ($str =~ /$text_re/og) {
473 1976         15075 my %m = %+;
474             #if ($log->is_trace) {
475             # # profiler shows that this is very heavy, so commenting this out
476             # $log->tracef("TMP: match text: %s", \%+);
477             #}
478 1976         4011 my $el;
479              
480 1976 100 100     6430 if (defined $m{plain_text} && $pass == 2) {
481 1012         1866 push @plain_text, $m{plain_text};
482 1012         4885 next;
483             } else {
484 964 100       1814 if (@plain_text) {
485 117         586 $self->_add_plain_text(join("", @plain_text), $parent, $pass);
486 117         337 @plain_text = ();
487             }
488             }
489              
490 964 100 100     11840 if ($m{link} && $pass == 2) {
    100 33        
    50 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100          
491 6         2019 require Org::Element::Link;
492             $el = Org::Element::Link->new(
493             document => $self, parent => $parent,
494             link=>$m{link_link},
495 6         124 );
496 6 100 66     6109 if (defined($m{link_desc}) && length($m{link_desc})) {
497             $el->description(
498             $self->_add_text_container($m{link_desc},
499 3         15 $el, $pass));
500             }
501             } elsif ($m{radio_target}) {
502 4         606 require Org::Element::RadioTarget;
503             $el = Org::Element::RadioTarget->new(
504             pass => $pass,
505             document => $self, parent => $parent,
506             target=>$m{rt_target},
507 4         90 );
508             } elsif ($m{target} && $pass == 2) {
509 0         0 require Org::Element::Target;
510             $el = Org::Element::Target->new(
511             document => $self, parent => $parent,
512             target=>$m{t_target},
513 0         0 );
514             } elsif ($m{fn_num} && $pass == 2) {
515 1         627 require Org::Element::Footnote;
516             $el = Org::Element::Footnote->new(
517             document => $self, parent => $parent,
518 1         10 name=>$m{fn_num_num}, is_ref=>1,
519             );
520             } elsif ($m{fn_namedef} && $pass == 2) {
521 1         7 require Org::Element::Footnote;
522             $el = Org::Element::Footnote->new(
523             document => $self, parent => $parent,
524             name=>$m{fn_namedef_name},
525 1 50       31 is_ref=>$m{fn_namedef_def} ? 0:1,
526             );
527             $el->def($self->_add_text_container($m{fn_namedef_def},
528 1         9 $parent, $pass));
529             } elsif ($m{fn_nameidef} && $pass == 2) {
530 3         17 require Org::Element::Footnote;
531             $el = Org::Element::Footnote->new(
532             document => $self, parent => $parent,
533             name=>$m{fn_nameidef_name},
534             is_ref=>($m{fn_nameidef_def} ? 0:1) ||
535 3   100     92 !length($m{fn_nameidef_name}),
536             );
537             $el->def(length($m{fn_nameidef_def}) ?
538             $self->_add_text_container($m{fn_nameidef_def},
539 3 100       34 $parent, $pass) : undef);
540             } elsif ($m{trange} && $pass == 2) {
541 3         10 require Org::Element::TimeRange;
542 3         6 require Org::Element::Timestamp;
543 3         43 $el = Org::Element::TimeRange->new(
544             document => $self, parent => $parent,
545             );
546 3         43 my $opts = {allow_event_duration=>0, allow_repeater=>0};
547             $el->ts1(Org::Element::Timestamp->new(
548 3         34 _str=>$m{trange_ts1}, document=>$self, parent=>$parent));
549 3         71 $el->ts1->_parse_timestamp($m{trange_ts1}, $opts);
550             $el->ts2(Org::Element::Timestamp->new(
551 3         64 _str=>$m{trange_ts2}, document=>$self, parent=>$parent));
552 3         75 $el->ts2->_parse_timestamp($m{trange_ts2}, $opts);
553 3         27 $el->children([$el->ts1, $el->ts2]);
554             } elsif ($m{tstamp} && $pass == 2) {
555 26         2082 require Org::Element::Timestamp;
556             $el = Org::Element::Timestamp->new(
557 26         807 _str => $m{tstamp}, document => $self, parent => $parent,
558             );
559 26         22863 $el->_parse_timestamp($m{tstamp});
560             } elsif ($m{act_trange} && $pass == 2) {
561 5         488 require Org::Element::TimeRange;
562 5         441 require Org::Element::Timestamp;
563 5         74 $el = Org::Element::TimeRange->new(
564             document => $self, parent => $parent,
565             );
566 5         1306 my $opts = {allow_event_duration=>0, allow_repeater=>0};
567             $el->ts1(Org::Element::Timestamp->new(
568 5         55 _str=>$m{act_trange_ts1}, document=>$self, parent=>$parent));
569 5         1569 $el->ts1->_parse_timestamp($m{act_trange_ts1}, $opts);
570             $el->ts2(Org::Element::Timestamp->new(
571 3         56 _str=>$m{act_trange_ts2}, document=>$self, parent=>$parent));
572 3         77 $el->ts2->_parse_timestamp($m{act_trange_ts2}, $opts);
573 3         31 $el->children([$el->ts1, $el->ts2]);
574             } elsif ($m{act_tstamp} && $pass == 2) {
575 29         8081 require Org::Element::Timestamp;
576             $el = Org::Element::Timestamp->new(
577 29         594 _str => $m{act_tstamp}, document => $self, parent => $parent,
578             );
579 29         16155 $el->_parse_timestamp($m{act_tstamp});
580             } elsif ($m{markup_start} && $pass == 2) {
581 24         77 require Org::Element::Text;
582             $el = Org::Element::Text->new(
583             document => $self, parent => $parent,
584             style=>'', text=>$m{markup_start},
585 24         458 );
586             # temporary mark, we need to apply markup later
587 24         5475 $el->{_mu_start}++;
588             } elsif ($m{markup_end} && $pass == 2) {
589 48         168 require Org::Element::Text;
590             $el = Org::Element::Text->new(
591             document => $self, parent => $parent,
592             style=>'', text=>$m{markup_end},
593 48         861 );
594             # temporary mark, we need to apply markup later
595 48         797 $el->{_mu_end}++;
596             }
597 961 50 66     3463 die "BUG2: no element" unless $el || $pass != 2;
598 961 100       2473 $parent->children([]) if !$parent->children;
599 961         1256 push @{ $parent->children }, $el;
  961         6975  
600             }
601              
602             # remaining text
603 588 100 66     1820 if (@plain_text && $pass == 2) {
604 394 100       2684 $parent->children([]) if !$parent->children;
605 394         531 push @{$parent->children}, Org::Element::Text->new(
  394         9577  
606             text => join("", @plain_text), style=>'',
607             document=>$self, parent=>$parent);
608 394         23719 @plain_text = ();
609             }
610              
611 588 100       1467 if ($pass == 2) {
612 413         1208 $self->_apply_markup($parent);
613 413 100       543 if (@{$self->radio_targets}) {
  413         1245  
614 1         2 my $re = join "|", map {quotemeta} @{$self->radio_targets};
  2         11  
  1         4  
615 1         34 $re = qr/(?:$re)/i;
616 1         6 $self->_linkify_rt_recursive($re, $parent);
617             }
618 413   100     1566 my $c = $parent->children // [];
619             }
620              
621             #$log->tracef('<- _add_text()');
622             }
623              
624             # to keep parser's regexes simple and fast, we detect markup in regex rather
625             # simplistically (as text element) and then apply some more filtering & applying
626             # logic here
627              
628             sub _apply_markup {
629             #$log->trace("-> _apply_markup()");
630 413     413   795 my ($self, $parent) = @_;
631 413         625 my $last_index = 0;
632 413 100       1201 my $c = $parent->children or return;
633              
634 407         649 while (1) {
635             #$log->tracef("text cluster = %s", [map {$_->as_string} @$c]);
636             # find a new mu_start
637 429         644 my $mu_start_index = -1;
638 429         608 my $mu;
639 429         1141 for (my $i = $last_index; $i < @$c; $i++) {
640 831 100       2384 next unless $c->[$i]->{_mu_start};
641 22         29 $mu_start_index = $i; $mu = $c->[$i]->text;
  22         54  
642             #$log->tracef("found mu_start at %d (%s)", $i, $mu);
643 22         33 last;
644             }
645 429 100       1049 unless ($mu_start_index >= 0) {
646             #$log->trace("no more mu_start found");
647 407         641 last;
648             }
649              
650             # check whether this is a valid markup (has text, has markup end, not
651             # interspersed with non-text, no more > 1 newlines)
652 22         27 my $mu_end_index = 0;
653 22         30 my $newlines = 0;
654 22         34 my $has_text;
655             my $has_unmarkable;
656 22         65 for (my $i=$mu_start_index+1; $i < @$c; $i++) {
657 60 100       176 if ($c->[$i]->isa('Org::Element::Text')) {
658 59         72 $has_text++;
659             } elsif (1) {
660             } else {
661             $has_unmarkable++; last;
662             }
663 60 100 100     218 if ($c->[$i]->{_mu_end} && $c->[$i]->text eq $mu) {
664             #$log->tracef("found mu_end at %d", $i);
665 13         20 $mu_end_index = $i; last;
  13         18  
666             }
667 47         105 my $text = $c->[$i]->as_string;
668 47         129 $newlines++ while $text =~ /\R/g;
669 47 100       143 last if $newlines > 1;
670             }
671 22   66     128 my $valid = $has_text && !$has_unmarkable
672             && $mu_end_index && $newlines <= 1;
673             #$log->tracef("mu candidate: start=%d, end=%s, ".
674             # "has_text=%s, has_unmarkable=%s, newlines=%d, valid=%s",
675             # $mu_start_index, $mu_end_index,
676             # $has_text, $has_unmarkable, $newlines, $valid
677             # );
678 22 100       43 if ($valid) {
679 26     26   149647 no warnings 'once';
  26         55  
  26         34857  
680             my $mu_el = Org::Element::Text->new(
681             document => $self, parent => $parent,
682 13         286 style=>$Org::Element::Text::mu2style{$mu}, text=>'',
683             );
684 13         239 my @c2 = splice @$c, $mu_start_index,
685             $mu_end_index-$mu_start_index+1, $mu_el;
686             #$log->tracef("grouping %s", [map {$_->text} @c2]);
687 13         41 $mu_el->children(\@c2);
688 13         15 shift @c2;
689 13         75 pop @c2;
690 13         35 for (@c2) {
691 22         38 $_->{parent} = $mu_el;
692             }
693 13         34 $self->_merge_text_elements(\@c2);
694             # squish if only one child
695 13 100       28 if (@c2 == 1) {
696 12         33 $mu_el->text($c2[0]->text);
697 12         37 $mu_el->children(undef);
698             }
699             } else {
700 9         18 undef $c->[$mu_start_index]->{_mu_start};
701 9         42 $last_index++;
702             }
703             }
704 407         982 $self->_merge_text_elements($c);
705             #$log->trace("<- _apply_markup()");
706             }
707              
708             sub _merge_text_elements {
709 420     420   782 my ($self, $els) = @_;
710             #$log->tracef("-> _merge_text_elements(%s)", [map {$_->as_string} @$els]);
711 420 100       1189 return unless @$els >= 2;
712 110         245 my $i=-1;
713 110         164 while (1) {
714 462         720 $i++;
715 462 100       1795 last if $i >= @$els;
716 352 100 100     2076 next if $els->[$i]->children || !$els->[$i]->isa('Org::Element::Text');
717 215   50     611 my $istyle = $els->[$i]->style // "";
718 215         288 while (1) {
719 298 100 100     1667 last if $i+1 >= @$els || $els->[$i+1]->children ||
      100        
720             !$els->[$i+1]->isa('Org::Element::Text');
721 104 100 50     299 last if ($els->[$i+1]->style // "") ne $istyle;
722             #$log->tracef("merging text[%d] '%s' with '%s'",
723             # $i, $els->[$i]->text, $els->[$i+1]->text);
724 83   50     210 $els->[$i]->{text} .= $els->[$i+1]->{text} // "";
725 83         265 splice @$els, $i+1, 1;
726             }
727             }
728             #$log->tracef("merge result = %s", [map {$_->as_string} @$els]);
729             #$log->trace("<- _merge_text_elements()");
730             }
731              
732             sub _linkify_rt_recursive {
733 8     8   34 require Org::Element::Text;
734 8         24 require Org::Element::Link;
735 8         20 my ($self, $re, $parent) = @_;
736 8         18 my $c = $parent->children;
737 8 100       78 return unless $c;
738 1         6 for (my $i=0; $i<@$c; $i++) {
739 12         23 my $el = $c->[$i];
740 12 100       41 if ($el->isa('Org::Element::Text')) {
741 7         129 my @split0 = split /\b($re)\b/, $el->text;
742 7 100       60 next unless @split0 > 1;
743 2         3 my @split;
744 2         6 for my $s (@split0) {
745 8 100       218 if ($s =~ /^$re$/) {
    100          
746 3         83 push @split, Org::Element::Link->new(
747             document=>$self, parent=>$parent,
748             link=>$s, description=>undef,
749             from_radio_target=>1,
750             );
751             } elsif (length $s) {
752 4         104 push @split, Org::Element::Text->new(
753             document=>$self, parent=>$parent,
754             text=>$s, style=>$el->style,
755             );
756             }
757             }
758 2         47 splice @$c, $i, 1, @split;
759             }
760 7         22 $self->_linkify_rt_recursive($re, $el);
761             }
762             }
763              
764             sub _add_plain_text {
765 117     117   510 require Org::Element::Text;
766 117         314 my ($self, $str, $parent, $pass) = @_;
767 117         2531 my $el = Org::Element::Text->new(
768             document=>$self, parent=>$parent, style=>'', text=>$str);
769 117 100       15136 $parent->children([]) if !$parent->children;
770 117         170 push @{ $parent->children }, $el;
  117         330  
771             }
772              
773             sub __split_tags {
774 7     7   59 [$_[0] =~ /:([^:]+)/g];
775             }
776              
777             sub load_element_modules {
778 2     2 1 1683 require Module::List;
779 2         53452 require Module::Load;
780              
781 2         3889 my $mm = Module::List::list_modules("Org::Element::", {list_modules=>1});
782 2         3907 for (keys %$mm) {
783 38         984 Module::Load::load($_);
784             }
785             }
786              
787             sub cmp_priorities {
788 11     11 1 95 my ($self, $p1, $p2) = @_;
789              
790 11         36 my $pp = $self->priorities;
791 11     20   105 my $pos1 = firstidx {$_ eq $p1} @$pp;
  20         47  
792 11 100       89 return undef unless $pos1 >= 0; ## no critic: Subroutines::ProhibitExplicitReturnUndef
793 9     17   72 my $pos2 = firstidx {$_ eq $p2} @$pp;
  17         31  
794 9 100       39 return undef unless $pos2 >= 0; ## no critic: Subroutines::ProhibitExplicitReturnUndef
795 7         42 $pos1 <=> $pos2;
796             }
797              
798             1;
799             # ABSTRACT: Represent an Org document
800              
801             __END__
802              
803             =pod
804              
805             =encoding UTF-8
806              
807             =head1 NAME
808              
809             Org::Document - Represent an Org document
810              
811             =head1 VERSION
812              
813             This document describes version 0.561 of Org::Document (from Perl distribution Org-Parser), released on 2023-11-06.
814              
815             =head1 SYNOPSIS
816              
817             use Org::Document;
818              
819             # create a new Org document tree from string
820             my $org = Org::Document->new(from_string => <<EOF);
821             * heading 1a
822             some text
823             ** heading 2
824             * heading 1b
825             EOF
826              
827             =head1 DESCRIPTION
828              
829             Derived from L<Org::Element>.
830              
831             =head1 ATTRIBUTES
832              
833             =head2 tags => ARRAY
834              
835             List of tags for this file, usually set via #+FILETAGS.
836              
837             =head2 todo_states => ARRAY
838              
839             List of known (action-requiring) todo states. Default is ['TODO'].
840              
841             =head2 done_states => ARRAY
842              
843             List of known done (non-action-requiring) states. Default is ['DONE'].
844              
845             =head2 priorities => ARRAY
846              
847             List of known priorities. Default is ['A', 'B', 'C'].
848              
849             =head2 drawer_names => ARRAY
850              
851             List of known drawer names. Default is [qw/CLOCK LOGBOOK PROPERTIES/].
852              
853             =head2 properties => ARRAY
854              
855             File-wide properties.
856              
857             =head2 radio_targets => ARRAY
858              
859             List of radio target text.
860              
861             =head2 time_zone => ARRAY
862              
863             If set, will be passed to DateTime->new() (e.g. by L<Org::Element::Timestamp>).
864              
865             =head2 ignore_unknown_settings => bool
866              
867             If set to true, unknown settings will not cause a parse failure.
868              
869             =head1 METHODS
870              
871             =for Pod::Coverage BUILD
872              
873             =head2 new
874              
875             Usage:
876              
877             $doc = Org::Document->new(%args);
878              
879             Create document object. If C<from_string> argument is specified, will parse
880             the string. Otherwise, will create an empty document object. Arguments:
881              
882             =over
883              
884             =item * from_string
885              
886             String. String to parse into document object tree content.
887              
888             =back
889              
890             =head2 load_element_modules()
891              
892             Load all Org::Element::* modules. This is useful when wanting to work with
893             element objects retrieved from serialization, where the element modules have not
894             been loaded.
895              
896             =head2 cmp_priorities($p1, $p2) => -1|0|-1
897              
898             Compare two priorities C<$p1> and C<$p2>. Return result like Perl's C<cmp>: 0 if
899             the two are the same, -1 if C<$p1> is of I<higher> priority (since it's more to
900             the left position in priority list, which is sorted highest-first) than C<$p2>,
901             and 1 if C<$p2> is of I<lower> priority than C<$p1>.
902              
903             If either C<$p1> or C<$p2> has unknown priority, will return undef.
904              
905             Examples:
906              
907             $doc->cmp_priorities('A', 'A') # -> 0
908             $doc->cmp_priorities('A', 'B') # -> -1 (A is higher than B)
909             $doc->cmp_priorities('C', 'B') # -> 1 (C is lower than B)
910             $doc->cmp_priorities('X', 'A') # -> undef (X is unknown)
911              
912             Note that X could be known if there is a C<#+PRIORITIES> setting which defines
913             it.
914              
915             =head1 HOMEPAGE
916              
917             Please visit the project's homepage at L<https://metacpan.org/release/Org-Parser>.
918              
919             =head1 SOURCE
920              
921             Source repository is at L<https://github.com/perlancar/perl-Org-Parser>.
922              
923             =head1 AUTHOR
924              
925             perlancar <perlancar@cpan.org>
926              
927             =head1 CONTRIBUTING
928              
929              
930             To contribute, you can send patches by email/via RT, or send pull requests on
931             GitHub.
932              
933             Most of the time, you don't need to build the distribution yourself. You can
934             simply modify the code, then test via:
935              
936             % prove -l
937              
938             If you want to build the distribution (e.g. to try to install it locally on your
939             system), you can install L<Dist::Zilla>,
940             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
941             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
942             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
943             that are considered a bug and can be reported to me.
944              
945             =head1 COPYRIGHT AND LICENSE
946              
947             This software is copyright (c) 2023, 2022, 2021, 2020, 2019, 2017, 2016, 2015, 2014, 2013, 2012, 2011 by perlancar <perlancar@cpan.org>.
948              
949             This is free software; you can redistribute it and/or modify it under
950             the same terms as the Perl 5 programming language system itself.
951              
952             =head1 BUGS
953              
954             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Org-Parser>
955              
956             When submitting a bug or request, please include a test-file or a
957             patch to an existing test-file that illustrates the bug or desired
958             feature.
959              
960             =cut