File Coverage

blib/lib/Org/Document.pm
Criterion Covered Total %
statement 371 377 98.4
branch 161 174 92.5
condition 116 137 84.6
subroutine 26 26 100.0
pod 2 3 66.6
total 676 717 94.2


line stmt bran cond sub pod time code
1             package Org::Document;
2              
3 24     24   5533 use 5.010001;
  24         105  
4 24     24   11356 use locale;
  24         14702  
  24         123  
5 24     24   44014 use Log::ger;
  24         1268  
  24         139  
6 24     24   6528 use Moo;
  24         14425  
  24         157  
7 24     24   24627 no if $] >= 5.021_006, warnings => "locale";
  24         314  
  24         143  
8             extends 'Org::Element';
9              
10 24     24   14647 use List::MoreUtils qw(firstidx);
  24         307172  
  24         175  
11 24     24   37952 use Time::HiRes qw(gettimeofday tv_interval);
  24         31350  
  24         123  
12              
13             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
14             our $DATE = '2023-08-05'; # DATE
15             our $DIST = 'Org-Parser'; # DIST
16             our $VERSION = '0.560'; # 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   213 my ($self) = @_;
111 95         303 $self->tags([]);
112 95         271 $self->todo_states([]);
113 95         280 $self->done_states([]);
114 95         369 $self->priorities([]);
115 95         244 $self->properties({});
116 95         424 $self->drawer_names([qw/CLOCK LOGBOOK PROPERTIES/]);
117             # FEEDSTATUS
118 95         306 $self->radio_targets([]);
119             }
120              
121             sub _init_pass2 {
122 93     93   235 my ($self) = @_;
123 93 50 66     140 if (!@{ $self->todo_states } && !@{ $self->done_states }) {
  93         391  
  81         348  
124 81         319 $self->todo_states(['TODO']);
125 81         199 $self->done_states(['DONE']);
126             }
127 93 100       180 if (!@{ $self->priorities }) {
  93         317  
128 89         309 $self->priorities([qw/A B C/]);
129             }
130 93         438 $self->children([]);
131             }
132              
133             sub __parse_args {
134 57     57   108 my $args = shift;
135 57 100 66     277 return [] unless defined($args) && length($args);
136             #$log->tracef("args = %s", $args);
137 55         84 my @args;
138 55         902 while ($args =~ /$arg_re (?:\s+|\z)/xg) {
139 24 50   24   35804 if (defined $+{squote}) {
  24 50       8945  
  24         88526  
  165         1003  
140 0         0 push @args, $+{squote};
141             } elsif (defined $+{dquote}) {
142 0         0 push @args, $+{dquote};
143             } else {
144 165         1290 push @args, $+{bare};
145             }
146             }
147             #$log->tracef("\\\@args = %s", \@args);
148 55         1096 \@args;
149             }
150              
151             sub __format_args {
152 2     2   6 my ($args) = @_;
153 2         3 my @s;
154 2         5 for (@$args) {
155 4 50       18 if (/\A(?:[A-Za-z0-9_:-]+|\|)\z/) {
    0          
156 4         11 push @s, $_;
157             } elsif (/"/) {
158 0         0 push @s, qq('$_');
159             } else {
160 0         0 push @s, qq("$_");
161             }
162             }
163 2         17 join " ", @s;
164             }
165              
166             sub BUILD {
167 96     96 0 106329 my ($self, $args) = @_;
168 96 50       729 $self->document($self) unless $self->document;
169              
170 96 100       350 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         307 $self->_init_pass1();
177 95         370 $self->_parse($args->{from_string}, 1);
178 93         1937 $self->_init_pass2();
179 93         296 $self->_parse($args->{from_string}, 2);
180             }
181             }
182              
183             # parse blocky elements: setting, blocks, headline, drawer
184             sub _parse {
185 188     188   440 my ($self, $str, $pass) = @_;
186 188         588 log_trace('-> _parse(%s, pass=%d)', $str, $pass);
187 188         912 my $t0 = [gettimeofday];
188              
189 188         347 my $last_el;
190              
191             my $last_headline;
192 188         337 my $last_headlines = [$self]; # [$doc, $last_hl_level1, $last_hl_lvl2, ...]
193 188         1808 my $last_listitem;
194 188         292 my $last_lists = []; # [last_List_obj_for_indent_level0, ...]
195 188         365 my $parent;
196              
197             my @text;
198 188         3363 while ($str =~ /$block_elems_re/og) {
199 4729   100     16931 $parent = $last_listitem // $last_headline // $self;
      66        
200             #$log->tracef("TMP: parent=%s (%s)", ref($parent), $parent->_str);
201 4729         33336 my %m = %+;
202 4729 50       15060 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       9401 if (defined $m{text}) {
209 4049         6835 push @text, $m{text};
210 4049         26105 next;
211             } else {
212 680 100       2236 if (@text) {
213 270         885 my $text = join("", @text);
214 270 100 100     1253 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         335 my ($firstline, $restlines) = $text =~ /(.*?\r?\n)(.+)/s;
226 85 100       190 if ($restlines) {
227 17         57 $restlines =~ /\A([ \t]*)/;
228 17         42 my $restlineslevel = length($1);
229 17         61 my $listlevel = length($last_el->parent->indent);
230 17 100       50 if ($restlineslevel <= $listlevel) {
231 11         18 my $origparent = $parent;
232             # find lesser-indented list
233 11   33     26 $parent = $last_headline // $self;
234 11         32 for (my $i=$restlineslevel-1; $i>=0; $i--) {
235 2 50       7 if ($last_lists->[$i]) {
236 2         4 $parent = $last_lists->[$i];
237 2         3 last;
238             }
239             }
240 11         30 splice @$last_lists, $restlineslevel;
241 11         37 $self->_add_text($firstline, $origparent, $pass);
242 11         51 $self->_add_text($restlines, $parent, $pass);
243 11         98 goto SKIP1;
244             }
245             }
246             }
247 259         717 $self->_add_text($text, $parent, $pass);
248 270         709 SKIP1:
249             @text = ();
250 270         451 $last_el = undef;
251             }
252             }
253              
254 680         956 my $el;
255 680 100 100     8965 if ($m{block} && $pass == 2) {
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100          
256              
257 3         451 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         20 );
266              
267             } elsif ($m{setting}) {
268              
269 60         4224 require Org::Element::Setting;
270 60         200 my $uc_setting_name = uc($m{setting_name});
271 60 100 100     181 if ($m{setting_indent} &&
272 8         31 !(grep { $_ eq $uc_setting_name }
273 8         25 @{Org::Element::Setting->indentable_settings})) {
274 6         14 push @text, $m{setting};
275 6         36 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         196 args=>__parse_args($m{setting_raw_arg}),
285             );
286             }
287              
288             } elsif ($m{fixedw} && $pass == 2) {
289              
290 7         969 require Org::Element::FixedWidthSection;
291             $el = Org::Element::FixedWidthSection->new(
292             pass => $pass,
293             _str=>$m{fixedw},
294 7         148 document=>$self, parent=>$parent,
295             );
296              
297             } elsif ($m{comment} && $pass == 2) {
298              
299 18         4368 require Org::Element::Comment;
300             $el = Org::Element::Comment->new(
301             _str=>$m{comment},
302 18         303 document=>$self, parent=>$parent,
303             );
304              
305             } elsif ($m{table} && $pass == 2) {
306              
307 6         1471 require Org::Element::Table;
308             $el = Org::Element::Table->new(
309             pass=>$pass,
310             _str=>$m{table},
311 6         102 document=>$self, parent=>$parent,
312             );
313              
314             } elsif ($m{drawer} && $pass == 2) {
315              
316 15         2501 require Org::Element::Drawer;
317 15         61 my $raw_content = $m{drawer_content};
318             $el = Org::Element::Drawer->new(
319             document=>$self, parent=>$parent,
320 15         298 name => uc($m{drawer_name}), pass => $pass,
321             );
322 14         64 $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         62 $el->_parse_properties($raw_content);
328              
329             } elsif ($m{li_header} && $pass == 2) {
330              
331 90         2480 require Org::Element::List;
332 90         2152 require Org::Element::ListItem;
333              
334 90         210 my $level = length($m{li_indent});
335 90         157 my $bullet = $m{li_bullet};
336 90         144 my $indent = $m{li_indent};
337 90         144 my $dt = $m{li_dt};
338 90         123 my $cbstate = $m{li_cbstate};
339 90 100       259 my $type = defined($dt) ? 'D' :
    100          
340             $bullet =~ /^\d+\./ ? 'O' : 'U';
341 90 100       194 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     193 $parent = $last_headline // $self;
346 90         222 for (my $i=$level-1; $i>=0; $i--) {
347 107 100       264 if ($last_lists->[$i]) {
348 27         63 $parent = $last_lists->[$i]->children->[-1];
349 27         45 last;
350             }
351             }
352              
353 90         139 my $list = $last_lists->[$level];
354 90 100 100     417 if (!$list || $list->type ne $type ||
      100        
355             $list->bullet_style ne $bstyle) {
356 51         995 $list = Org::Element::List->new(
357             document => $self, parent => $parent,
358             indent=>$indent, type=>$type, bullet_style=>$bstyle,
359             );
360 51         8052 $last_lists->[$level] = $list;
361 51 100       178 $parent->children([]) if !$parent->children;
362 51         72 push @{ $parent->children }, $list;
  51         114  
363             }
364 90         140 $last_lists->[$level] = $list;
365              
366             # parent for list item is list
367 90         134 $parent = $list;
368              
369 90         1611 $el = Org::Element::ListItem->new(
370             document=>$self, parent=>$list,
371             indent=>$indent, bullet=>$bullet);
372 90 100       8321 $el->check_state($cbstate) if $cbstate;
373 90 100       205 $el->desc_term($self->_add_text_container($dt, $list, $pass))
374             if defined($dt);
375              
376 90         189 splice @$last_lists, $level+1;
377 90         156 $last_listitem = $el;
378              
379             } elsif ($m{headline} && $pass == 2) {
380              
381 171         8650 require Org::Element::Headline;
382 171         492 my $level = length $m{h_bullet};
383              
384             # parent is upper-level headline
385 171         248 $parent = undef;
386 171         472 for (my $i=$level-1; $i>=0; $i--) {
387 181 100       497 $parent = $last_headlines->[$i] and last;
388             }
389 171   33     361 $parent //= $self;
390              
391             $el = Org::Element::Headline->new(
392             _str=>$m{headline},
393 171         3424 document=>$self, parent=>$parent,
394             level=>$level,
395             );
396 171 100       35369 $el->tags(__split_tags($m{h_tags})) if ($m{h_tags});
397 171         313 my $title = $m{h_title};
398              
399             # recognize todo keyword
400             my $todo_kw_re = "(?:".
401 595         1566 join("|", map {quotemeta}
402             "COMMENT",
403 171         620 @{$self->todo_states}, @{$self->done_states}) . ")";
  171         470  
  171         404  
404 171 100       1821 if ($title =~ s/^($todo_kw_re)(\s+|\W)/$2/) {
405 38         99 my $state = $1;
406 38         154 $title =~ s/^\s+//;
407 38         118 $el->is_todo(1);
408 38         97 $el->todo_state($state);
409 38 100       60 $el->is_done((grep { $_ eq $state } @{ $self->done_states }) ? 1:0);
  52         186  
  38         90  
410             }
411              
412             # recognize priority cookie
413             my $prio_re = "(?:".
414 171         316 join("|", map {quotemeta} @{$self->priorities}) . ")";
  517         1078  
  171         379  
415 171 100       991 if ($title =~ s/\[#($prio_re)\]\s*//) {
416 4         22 $el->priority($1);
417             }
418              
419             # recognize statistics cookie
420 171 100       521 if ($title =~ s!\[(\d+%|\d+/\d+)\]\s*!!o) {
421 6         21 $el->statistics_cookie($1);
422             }
423              
424 171         457 $el->title($self->_add_text_container($title, $parent, $pass));
425              
426 171         500 $last_headlines->[$el->level] = $el;
427 171         412 splice @$last_headlines, $el->level+1;
428 171         284 $last_headline = $el;
429 171         260 $last_listitem = undef;
430 171         461 $last_lists = [];
431             }
432              
433             # we haven't caught other matches to become element
434 670 50 66     34549 die "BUG1: no element" unless $el || $pass != 2;
435              
436 670 100       2613 $parent->children([]) if !$parent->children;
437 670         891 push @{ $parent->children }, $el;
  670         1395  
438 670         7251 $last_el = $el;
439             }
440              
441             # remaining text
442 184 100       519 if (@text) {
443 79         1849 $self->_add_text(join("", @text), $parent, $pass);
444             }
445 181         440 @text = ();
446              
447 181         1070 log_trace('<- _parse(), elapsed time=%.3fs',
448             tv_interval($t0, [gettimeofday]));
449             }
450              
451             sub _add_text_container {
452 185     185   2245 require Org::Element::Text;
453 185         473 my ($self, $str, $parent, $pass) = @_;
454 185         3340 my $container = Org::Element::Text->new(
455             document=>$self, parent=>$parent,
456             text=>'', style=>'',
457             );
458 185         17657 $self->_add_text($str, $container, $pass);
459             $container = $container->children->[0] if
460 185 100 100     628 $container->children && @{$container->children} == 1 &&
  183   66     1340  
461             $container->children->[0]->isa('Org::Element::Text');
462 185         592 $container;
463             }
464              
465             sub _add_text {
466 591     591   13108 require Org::Element::Text;
467 591         1485 my ($self, $str, $parent, $pass) = @_;
468 591   33     1290 $parent //= $self;
469             #$log->tracef("-> _add_text(%s, pass=%d)", $str, $pass);
470              
471 591         802 my @plain_text;
472 591         3814 while ($str =~ /$text_re/og) {
473 1976         14967 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         4225 my $el;
479              
480 1976 100 100     6280 if (defined $m{plain_text} && $pass == 2) {
481 1012         1944 push @plain_text, $m{plain_text};
482 1012         4674 next;
483             } else {
484 964 100       1944 if (@plain_text) {
485 117         591 $self->_add_plain_text(join("", @plain_text), $parent, $pass);
486 117         252 @plain_text = ();
487             }
488             }
489              
490 964 100 100     9925 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         1432 require Org::Element::Link;
492             $el = Org::Element::Link->new(
493             document => $self, parent => $parent,
494             link=>$m{link_link},
495 6         164 );
496 6 100 66     5135 if (defined($m{link_desc}) && length($m{link_desc})) {
497             $el->description(
498             $self->_add_text_container($m{link_desc},
499 3         11 $el, $pass));
500             }
501             } elsif ($m{radio_target}) {
502 4         464 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         76 );
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         442 require Org::Element::Footnote;
516             $el = Org::Element::Footnote->new(
517             document => $self, parent => $parent,
518 1         7 name=>$m{fn_num_num}, is_ref=>1,
519             );
520             } elsif ($m{fn_namedef} && $pass == 2) {
521 1         5 require Org::Element::Footnote;
522             $el = Org::Element::Footnote->new(
523             document => $self, parent => $parent,
524             name=>$m{fn_namedef_name},
525 1 50       22 is_ref=>$m{fn_namedef_def} ? 0:1,
526             );
527             $el->def($self->_add_text_container($m{fn_namedef_def},
528 1         18 $parent, $pass));
529             } elsif ($m{fn_nameidef} && $pass == 2) {
530 3         13 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     66 !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       23 $parent, $pass) : undef);
540             } elsif ($m{trange} && $pass == 2) {
541 3         13 require Org::Element::TimeRange;
542 3         9 require Org::Element::Timestamp;
543 3         58 $el = Org::Element::TimeRange->new(
544             document => $self, parent => $parent,
545             );
546 3         59 my $opts = {allow_event_duration=>0, allow_repeater=>0};
547             $el->ts1(Org::Element::Timestamp->new(
548 3         64 _str=>$m{trange_ts1}, document=>$self, parent=>$parent));
549 3         73 $el->ts1->_parse_timestamp($m{trange_ts1}, $opts);
550             $el->ts2(Org::Element::Timestamp->new(
551 3         75 _str=>$m{trange_ts2}, document=>$self, parent=>$parent));
552 3         89 $el->ts2->_parse_timestamp($m{trange_ts2}, $opts);
553 3         34 $el->children([$el->ts1, $el->ts2]);
554             } elsif ($m{tstamp} && $pass == 2) {
555 26         1112 require Org::Element::Timestamp;
556             $el = Org::Element::Timestamp->new(
557 26         552 _str => $m{tstamp}, document => $self, parent => $parent,
558             );
559 26         10074 $el->_parse_timestamp($m{tstamp});
560             } elsif ($m{act_trange} && $pass == 2) {
561 5         527 require Org::Element::TimeRange;
562 5         511 require Org::Element::Timestamp;
563 5         103 $el = Org::Element::TimeRange->new(
564             document => $self, parent => $parent,
565             );
566 5         1600 my $opts = {allow_event_duration=>0, allow_repeater=>0};
567             $el->ts1(Org::Element::Timestamp->new(
568 5         76 _str=>$m{act_trange_ts1}, document=>$self, parent=>$parent));
569 5         2135 $el->ts1->_parse_timestamp($m{act_trange_ts1}, $opts);
570             $el->ts2(Org::Element::Timestamp->new(
571 3         84 _str=>$m{act_trange_ts2}, document=>$self, parent=>$parent));
572 3         95 $el->ts2->_parse_timestamp($m{act_trange_ts2}, $opts);
573 3         41 $el->children([$el->ts1, $el->ts2]);
574             } elsif ($m{act_tstamp} && $pass == 2) {
575 29         3932 require Org::Element::Timestamp;
576             $el = Org::Element::Timestamp->new(
577 29         540 _str => $m{act_tstamp}, document => $self, parent => $parent,
578             );
579 29         15163 $el->_parse_timestamp($m{act_tstamp});
580             } elsif ($m{markup_start} && $pass == 2) {
581 24         99 require Org::Element::Text;
582             $el = Org::Element::Text->new(
583             document => $self, parent => $parent,
584             style=>'', text=>$m{markup_start},
585 24         425 );
586             # temporary mark, we need to apply markup later
587 24         1987 $el->{_mu_start}++;
588             } elsif ($m{markup_end} && $pass == 2) {
589 48         211 require Org::Element::Text;
590             $el = Org::Element::Text->new(
591             document => $self, parent => $parent,
592             style=>'', text=>$m{markup_end},
593 48         892 );
594             # temporary mark, we need to apply markup later
595 48         947 $el->{_mu_end}++;
596             }
597 961 50 66     3247 die "BUG2: no element" unless $el || $pass != 2;
598 961 100       2423 $parent->children([]) if !$parent->children;
599 961         1204 push @{ $parent->children }, $el;
  961         6132  
600             }
601              
602             # remaining text
603 588 100 66     1888 if (@plain_text && $pass == 2) {
604 394 100       1502 $parent->children([]) if !$parent->children;
605 394         606 push @{$parent->children}, Org::Element::Text->new(
  394         8277  
606             text => join("", @plain_text), style=>'',
607             document=>$self, parent=>$parent);
608 394         18988 @plain_text = ();
609             }
610              
611 588 100       1957 if ($pass == 2) {
612 413         1120 $self->_apply_markup($parent);
613 413 100       582 if (@{$self->radio_targets}) {
  413         1149  
614 1         2 my $re = join "|", map {quotemeta} @{$self->radio_targets};
  2         18  
  1         5  
615 1         37 $re = qr/(?:$re)/i;
616 1         11 $self->_linkify_rt_recursive($re, $parent);
617             }
618 413   100     1484 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   838 my ($self, $parent) = @_;
631 413         601 my $last_index = 0;
632 413 100       1116 my $c = $parent->children or return;
633              
634 407         583 while (1) {
635             #$log->tracef("text cluster = %s", [map {$_->as_string} @$c]);
636             # find a new mu_start
637 429         573 my $mu_start_index = -1;
638 429         547 my $mu;
639 429         1007 for (my $i = $last_index; $i < @$c; $i++) {
640 831 100       2134 next unless $c->[$i]->{_mu_start};
641 22         31 $mu_start_index = $i; $mu = $c->[$i]->text;
  22         56  
642             #$log->tracef("found mu_start at %d (%s)", $i, $mu);
643 22         34 last;
644             }
645 429 100       917 unless ($mu_start_index >= 0) {
646             #$log->trace("no more mu_start found");
647 407         632 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         30 my $mu_end_index = 0;
653 22         30 my $newlines = 0;
654 22         36 my $has_text;
655             my $has_unmarkable;
656 22         60 for (my $i=$mu_start_index+1; $i < @$c; $i++) {
657 60 100       166 if ($c->[$i]->isa('Org::Element::Text')) {
658 59         111 $has_text++;
659             } elsif (1) {
660             } else {
661             $has_unmarkable++; last;
662             }
663 60 100 100     175 if ($c->[$i]->{_mu_end} && $c->[$i]->text eq $mu) {
664             #$log->tracef("found mu_end at %d", $i);
665 13         24 $mu_end_index = $i; last;
  13         20  
666             }
667 47         102 my $text = $c->[$i]->as_string;
668 47         171 $newlines++ while $text =~ /\R/g;
669 47 100       143 last if $newlines > 1;
670             }
671 22   66     105 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       44 if ($valid) {
679 24     24   244 no warnings 'once';
  24         53  
  24         26622  
680             my $mu_el = Org::Element::Text->new(
681             document => $self, parent => $parent,
682 13         252 style=>$Org::Element::Text::mu2style{$mu}, text=>'',
683             );
684 13         289 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         43 $mu_el->children(\@c2);
688 13         22 shift @c2;
689 13         37 pop @c2;
690 13         33 for (@c2) {
691 22         37 $_->{parent} = $mu_el;
692             }
693 13         33 $self->_merge_text_elements(\@c2);
694             # squish if only one child
695 13 100       38 if (@c2 == 1) {
696 12         36 $mu_el->text($c2[0]->text);
697 12         40 $mu_el->children(undef);
698             }
699             } else {
700 9         17 undef $c->[$mu_start_index]->{_mu_start};
701 9         23 $last_index++;
702             }
703             }
704 407         893 $self->_merge_text_elements($c);
705             #$log->trace("<- _apply_markup()");
706             }
707              
708             sub _merge_text_elements {
709 420     420   746 my ($self, $els) = @_;
710             #$log->tracef("-> _merge_text_elements(%s)", [map {$_->as_string} @$els]);
711 420 100       1000 return unless @$els >= 2;
712 110         229 my $i=-1;
713 110         207 while (1) {
714 462         629 $i++;
715 462 100       928 last if $i >= @$els;
716 352 100 100     1762 next if $els->[$i]->children || !$els->[$i]->isa('Org::Element::Text');
717 215   50     627 my $istyle = $els->[$i]->style // "";
718 215         293 while (1) {
719 298 100 100     1599 last if $i+1 >= @$els || $els->[$i+1]->children ||
      100        
720             !$els->[$i+1]->isa('Org::Element::Text');
721 104 100 50     301 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     250 $els->[$i]->{text} .= $els->[$i+1]->{text} // "";
725 83         271 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   43 require Org::Element::Text;
734 8         20 require Org::Element::Link;
735 8         18 my ($self, $re, $parent) = @_;
736 8         13 my $c = $parent->children;
737 8 100       35 return unless $c;
738 1         5 for (my $i=0; $i<@$c; $i++) {
739 12         17 my $el = $c->[$i];
740 12 100       47 if ($el->isa('Org::Element::Text')) {
741 7         72 my @split0 = split /\b($re)\b/, $el->text;
742 7 100       40 next unless @split0 > 1;
743 2         4 my @split;
744 2         6 for my $s (@split0) {
745 8 100       184 if ($s =~ /^$re$/) {
    100          
746 3         64 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         77 push @split, Org::Element::Text->new(
753             document=>$self, parent=>$parent,
754             text=>$s, style=>$el->style,
755             );
756             }
757             }
758 2         43 splice @$c, $i, 1, @split;
759             }
760 7         16 $self->_linkify_rt_recursive($re, $el);
761             }
762             }
763              
764             sub _add_plain_text {
765 117     117   484 require Org::Element::Text;
766 117         333 my ($self, $str, $parent, $pass) = @_;
767 117         2226 my $el = Org::Element::Text->new(
768             document=>$self, parent=>$parent, style=>'', text=>$str);
769 117 100       11953 $parent->children([]) if !$parent->children;
770 117         176 push @{ $parent->children }, $el;
  117         394  
771             }
772              
773             sub __split_tags {
774 7     7   70 [$_[0] =~ /:([^:]+)/g];
775             }
776              
777             sub load_element_modules {
778 2     2 1 921 require Module::List;
779 2         33063 require Module::Load;
780              
781 2         2352 my $mm = Module::List::list_modules("Org::Element::", {list_modules=>1});
782 2         2749 for (keys %$mm) {
783 38         704 Module::Load::load($_);
784             }
785             }
786              
787             sub cmp_priorities {
788 11     11 1 69 my ($self, $p1, $p2) = @_;
789              
790 11         25 my $pp = $self->priorities;
791 11     20   78 my $pos1 = firstidx {$_ eq $p1} @$pp;
  20         42  
792 11 100       51 return undef unless $pos1 >= 0; ## no critic: Subroutines::ProhibitExplicitReturnUndef
793 9     17   29 my $pos2 = firstidx {$_ eq $p2} @$pp;
  17         24  
794 9 100       33 return undef unless $pos2 >= 0; ## no critic: Subroutines::ProhibitExplicitReturnUndef
795 7         39 $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.560 of Org::Document (from Perl distribution Org-Parser), released on 2023-08-05.
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