From: Don Armstrong Date: Tue, 3 Jul 2012 00:48:56 +0000 (-0700) Subject: Import original source of Org-Parser 0.23 X-Git-Tag: upstream/0.23 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=ea1cb9802c83250629ea1f5003756988d03452d8;p=liborg-parser-perl.git Import original source of Org-Parser 0.23 --- ea1cb9802c83250629ea1f5003756988d03452d8 diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..4d206df --- /dev/null +++ b/Build.PL @@ -0,0 +1,41 @@ + +use strict; +use warnings; + +use Module::Build 0.3601; + + +my %module_build_args = ( + "build_requires" => { + "Module::Build" => "0.3601" + }, + "configure_requires" => { + "Module::Build" => "0.3601" + }, + "dist_abstract" => "Parse Org documents", + "dist_author" => [ + "Steven Haryanto " + ], + "dist_name" => "Org-Parser", + "dist_version" => "0.23", + "license" => "perl", + "module_name" => "Org::Parser", + "recommends" => {}, + "recursive_test_files" => 1, + "requires" => { + "DateTime" => 0, + "DateTime::Event::Recurrence" => 0, + "File::Slurp" => 0, + "Log::Any" => 0, + "Moo" => 0, + "String::Escape" => 0, + "Test::More" => "0.96", + "perl" => "5.010000" + }, + "script_files" => [] +); + + +my $build = Module::Build->new(%module_build_args); + +$build->create_build_script; diff --git a/Changes b/Changes new file mode 100644 index 0000000..774b407 --- /dev/null +++ b/Changes @@ -0,0 +1,248 @@ +Revision history for Org-Parser + +0.23 2012-04-14 + + No functional changes. Another increase in parsing speed by avoiding + doing unnecessary stuffs in first pass and adding m//o flag. A speedup + of about 1.25x is expected. + + +0.22 2012-04-13 + + No functional changes. Faster parsing (reduce overheads from logging + statements and %+ access). A speedup of about 2x is expected. + + +0.21 2011-09-23 + + No functional changes. Remove debug message. + + +0.20 2011-09-23 + + [ENHANCEMENTS] + + - Allow setting time zone (for timestamps). + + +0.19 2011-09-22 + + [ENHANCEMENTS] + + - Table: Add as_aoa(). + + - Table row: Add as_array(). + + +0.18 2011-08-11 + + [INCOMPATIBLE CHANGES] + + - Rename Org::Element::ShortExample to Org::Element::FixedWidthSection. + + - Allow /^\s*:$/ line as a special case in fixed width section (ref: + [org-mode feb52f9028e73f0f49390780bb2e61cc9da04303]) + + +0.17 2011-07-27 + + [INCOMPATIBLE CHANGES] + + - Rename Org::Element::Base to Org::Element. + + [ENHANCEMENTS] + + - Allow decimal fraction on timestamp repeater & warning period. + + - Base: add method remove(). + + - Headline: add methods {promote,demote}_{node,branch}(). + + +0.16 2011-06-16 + + - Relax timestamp parsing for Chinese/French timestamps. + + +0.15 2011-06-09 + + [REMOVED] + + - dump-org-structure script moved to App::OrgUtils. + + [ENHANCEMENTS] + + - Base: Add field_name(). + + - Headline: Add is_leaf(). + + +0.14 2011-06-06 + + [ENHANCEMENTS] + + - Headline: Add get_active_timestamp(). + + +0.13 2011-06-06 + + No functional changes for the parser. + + [REMOVED] + + - Spin off 'remind-due-todos' script into App::ListOrgHeadlines. + + +0.12 2011-05-25 + + [ENHANCEMENTS] + + - Compliance: Parse .+/++ repeater forms and warning period in timestamp + [thanks Louis B. Moore] + + [BUG FIXES] + + - Fix regex for parsing table [RT#68442, thanks Slaven Rezic] + + [ETC] + + - Use utf8 in dump-org-structure script. + + +0.11 2011-05-23 + + [ENHANCEMENTS] + + - Compliance: blocks can be indented. + + - Compliance: some settings can be indented. + + - Parse short example (one-line literal example with colon+space prefix + syntax). See Org::Element::ShortExample. + + +0.10 2011-04-21 + + [FIXES] + + - Fixes to POD documentation. + + - More specific regex for tag. + + [ETC] + + - Update todo.org (some questions cleared up by Carsten Dominik) + + +0.09 2011-03-31 + + [FIXES] + + - Fix SYNOPSIS, use a slightly more complex Org document example. + + +0.08 2011-03-23 + + [FIXES] + + - Update bin/remind-due-todos. + + +0.07 2011-03-23 + + [ENHANCEMENTS] + + - Org::Element::Base: add find(), walk_parents(), headline() + + - Org::Element::Headline: add get_tags() + + + [FIXES] + + - Link description can contain markups. + + +0.06 2011-03-23 + + [FIXES] + + - Some regex fixes. + + +0.05 2011-03-23 + + [INCOMPATIBLE CHANGES] + + - Org::Element::TimeRange: datetime1 & datetime2 attributes removed, + replaced with ts1 & ts2 (timestamp elements). + + [ENHANCEMENTS] + + - Parses event duration and repeater interval in timestamps. + + +0.04 2011-03-22 + + This release is a major refactoring from the previous one. + + [INCOMPATIBLE CHANGES] + + - Org::Parser: handler() removed, use Org::Document's walk() instead. + + - Refactoring: some classes removed/merged, some added. + + [ENHANCEMENTS] + + - Dual-pass parsing for more correct behaviour. + + - Parse link, plain list (including ordered/unordered/description list), + target, radio target, comment, footnote. + + - Add a couple of utility methods in Element::Base: seniority(), + prev_sibling(), next_sibling(), walk(), get_property(). + + [ETC] + + - Project todo list now in distribution's todo.org + + +0.03 2011-03-18 + + [ENHANCEMENTS] + + Parse text markups (bold, italic, etc). + + bin/dump-org-structure outputs nicer format. + + [FIXES] + + Todo keyword can also be separated from title with \W (not just \s), + e.g. '* TODO/quit smoking'. + + +0.02 2011-03-17 + + [INCOMPATIBLE CHANGES] + + Refactoring: parser now returns Org::Document instance, which contains + Org::Element instances. handler sub parameter changed. + + [ENHANCEMENTS] + + Parse tables. + + Headline titles can now contain inline elements (normal text as well as + other elements, such as timestamps, etc). + + Add another example script: dump-org-structure. + + Recognize blocks: HTML, LATEX, ASCII. + + [FIXES] + + Setting/block/drawer/property names are case-insensitive. + + +0.01 2011-03-16 + + First release. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..3747404 --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +Terms of the Perl programming language system itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +--- The GNU General Public License, Version 1, February 1989 --- + +This software is Copyright (c) 2012 by Steven Haryanto. + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +This software is Copyright (c) 2012 by Steven Haryanto. + +This is free software, licensed under: + + The Artistic License 1.0 + +The Artistic License + +Preamble + +The intent of this document is to state the conditions under which a Package +may be copied, such that the Copyright Holder maintains some semblance of +artistic control over the development of the package, while giving the users of +the package the right to use and distribute the Package in a more-or-less +customary fashion, plus the right to make reasonable modifications. + +Definitions: + + - "Package" refers to the collection of files distributed by the Copyright + Holder, and derivatives of that collection of files created through + textual modification. + - "Standard Version" refers to such a Package if it has not been modified, + or has been modified in accordance with the wishes of the Copyright + Holder. + - "Copyright Holder" is whoever is named in the copyright or copyrights for + the package. + - "You" is you, if you're thinking about copying or distributing this Package. + - "Reasonable copying fee" is whatever you can justify on the basis of media + cost, duplication charges, time of people involved, and so on. (You will + not be required to justify it to the Copyright Holder, but only to the + computing community at large as a market that must bear the fee.) + - "Freely Available" means that no fee is charged for the item itself, though + there may be fees involved in handling the item. It also means that + recipients of the item may redistribute it under the same conditions they + received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications derived +from the Public Domain or from the Copyright Holder. A Package modified in such +a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided that +you insert a prominent notice in each changed file stating how and when you +changed that file, and provided that you do at least ONE of the following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or an + equivalent medium, or placing the modifications on a major archive site + such as ftp.uu.net, or by allowing the Copyright Holder to include your + modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict with + standard executables, which must also be provided, and provide a separate + manual page for each non-standard executable that clearly documents how it + differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or executable +form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where to + get the Standard Version. + + b) accompany the distribution with the machine-readable source of the Package + with your modifications. + + c) accompany any non-standard executables with their corresponding Standard + Version executables, giving the non-standard executables non-standard + names, and clearly documenting the differences in manual pages (or + equivalent), together with instructions on where to get the Standard + Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this Package. You +may not charge a fee for this Package itself. However, you may distribute this +Package in aggregate with other (possibly commercial) programs as part of a +larger (possibly commercial) software distribution provided that you do not +advertise this Package as a product of your own. + +6. The scripts and library files supplied as input to or produced as output +from the programs of this Package do not automatically fall under the copyright +of this Package, but belong to whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED +WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +The End + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..87a07cd --- /dev/null +++ b/MANIFEST @@ -0,0 +1,60 @@ +Build.PL +Changes +LICENSE +MANIFEST +MANIFEST.SKIP +META.yml +README +dist.ini +lib/Org/Document.pm +lib/Org/Dump.pm +lib/Org/Element.pm +lib/Org/Element/Block.pm +lib/Org/Element/Comment.pm +lib/Org/Element/Drawer.pm +lib/Org/Element/FixedWidthSection.pm +lib/Org/Element/Footnote.pm +lib/Org/Element/Headline.pm +lib/Org/Element/Link.pm +lib/Org/Element/List.pm +lib/Org/Element/ListItem.pm +lib/Org/Element/RadioTarget.pm +lib/Org/Element/Setting.pm +lib/Org/Element/Table.pm +lib/Org/Element/TableCell.pm +lib/Org/Element/TableRow.pm +lib/Org/Element/TableVLine.pm +lib/Org/Element/Target.pm +lib/Org/Element/Text.pm +lib/Org/Element/TimeRange.pm +lib/Org/Element/Timestamp.pm +lib/Org/Parser.pm +t/00-compile.t +t/01-basics.t +t/base_element-field_name.t +t/base_element-get_property.t +t/base_element.t +t/block.t +t/comment.t +t/data/custom_todo_kw.org +t/data/listitem.org +t/data/various.org +t/drawer.t +t/fixed_width_section.t +t/footnote.t +t/headline.t +t/link_and_target.t +t/list.t +t/radio_target.t +t/regression-rt68443.t +t/release-pod-coverage.t +t/release-pod-syntax.t +t/setting-todo.t +t/setting.t +t/table.t +t/testlib.pl +t/text.t +t/timerange.t +t/timestamp.t +t/various.t +todo.org diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..2e58f07 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1 @@ +~$ diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..7ecd3c1 --- /dev/null +++ b/META.yml @@ -0,0 +1,28 @@ +--- +abstract: 'Parse Org documents' +author: + - 'Steven Haryanto ' +build_requires: + Module::Build: 0.3601 +configure_requires: + Module::Build: 0.3601 +dynamic_config: 0 +generated_by: 'Dist::Zilla version 4.300002, CPAN::Meta::Converter version 2.112150' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Org-Parser +requires: + DateTime: 0 + DateTime::Event::Recurrence: 0 + File::Slurp: 0 + Log::Any: 0 + Moo: 0 + String::Escape: 0 + Test::More: 0.96 + perl: 5.010000 +resources: + homepage: http://search.cpan.org/dist/Org-Parser/ + repository: http://github.com/sharyanto/perl-Org-Parser +version: 0.23 diff --git a/README b/README new file mode 100644 index 0000000..6f96124 --- /dev/null +++ b/README @@ -0,0 +1,127 @@ +NAME + Org::Parser - Parse Org documents + +VERSION + version 0.23 + +SYNOPSIS + use 5.010; + use Org::Parser; + my $orgp = Org::Parser->new(); + + # parse a file + my $doc = $orgp->parse_file("$ENV{HOME}/todo.org"); + + # parse a string + $doc = $orgp->parse(<>> + * heading1a + ** TODO heading2a + SCHEDULED: <2011-03-31 Thu> + [[some][link]] + ** DONE heading2b + [2011-03-18 ] + this will become a link: radio target + * TODO heading1b *bold* + - some + - plain + - list + - [ ] with /checkbox/ + * and + * sublist + * CANCELLED heading1c + + definition :: list + + another :: def + EOF + + # walk the document tree + $doc->walk(sub { + my ($el) = @_; + return unless $el->isa('Org::Element::Headline'); + say "heading level ", $el->level, ": ", $el->title->as_string; + }); + + will print something like: + + heading level 1: heading1a + heading level 2: heading2a + heading level 2: heading2b *bold* + heading level 1: heading1b + heading level 1: heading1c + + A command-line utility (in a separate distribution: App::OrgUtils) is + available for debugging: + + % dump-org-structure ~/todo.org + Document: + Setting: "#+TODO: TODO | DONE CANCELLED\n" + RadioTarget: "<<>>" + Text: "\n" + Headline: l=1 + (title) + Text: "heading1a" + (children) + Headline: l=2 todo=TODO + (title) + Text: "heading2a" + (children) + Text: "SCHEDULED: " + ... + +DESCRIPTION + This module parses Org documents. See http://orgmode.org/ for more + details on Org documents. + + This module uses Log::Any logging framework. + + This module uses Moo object system. + + See "todo.org" in the distribution for the list of already- and not yet + implemented stuffs. + +ATTRIBUTES +METHODS + new() + Create a new parser instance. + + $orgp->parse($str | $arrayref | $coderef | $filehandle, $opts) => $doc + Parse document (which can be contained in a scalar $str, an array of + lines $arrayref, a subroutine which will be called for chunks until it + returns undef, or a filehandle). + + Returns Org::Document object. + + If 'handler' attribute is specified, will call handler repeatedly during + parsing. See the 'handler' attribute for more details. + + Will die if there are syntax errors in documents. + + $opts is a hashref and can contain these keys: "time_zone" (will be + passed to Org::Document's constructor). + + $orgp->parse_file($filename, $opts) => $doc + Just like parse(), but will load document from file instead. + +FAQ + Why? Just as only perl can parse Perl, only org-mode can parse Org anyway! + True. I'm only targetting good enough. As long as I can parse/process + all my Org notes and todo files, I have no complaints. + + It's too slow! + Parser is completely regex-based at the moment (I plan to use Marpa + someday). Performance is quite lousy but I'm not annoyed enough at the + moment to overhaul it. + +SEE ALSO + Org::Document + +AUTHOR + Steven Haryanto + +COPYRIGHT AND LICENSE + This software is copyright (c) 2012 by Steven Haryanto. + + This is free software; you can redistribute it and/or modify it under + the same terms as the Perl 5 programming language system itself. + diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..f54d8d2 --- /dev/null +++ b/dist.ini @@ -0,0 +1,47 @@ +name = Org-Parser +version = 0.23 +author = Steven Haryanto +license = Perl_5 +copyright_holder = Steven Haryanto + +[MetaResources] +homepage = http://search.cpan.org/dist/Org-Parser/ +repository = http://github.com/sharyanto/perl-Org-Parser + +[@Filter] +bundle = @Classic +remove = MakeMaker +remove = PodVersion +remove = PkgVersion +[OurPkgVersion] +[ModuleBuild] + +[ReadmeFromPod] +[PodWeaver] +[CheckChangeLog] + +[Test::Compile] +[InstallRelease] +install_command = cpanm -n . +;[Twitter] +;hash_tags = #perl #cpan #orgmode #emacs +;url_shortener = Metamark + +;[@Git] + +[Prereqs] +; for testing +Test::More = 0.96 + +; for runtime +perl = 5.010000 +DateTime = 0 +DateTime::Event::Recurrence = 0 +File::Slurp = 0 +Log::Any = 0 +Moo = 0 +String::Escape = 0 + +[Run::Release] +;notexist_fatal = 0 +run = archive-perl-release %s diff --git a/lib/Org/Document.pm b/lib/Org/Document.pm new file mode 100644 index 0000000..43a805a --- /dev/null +++ b/lib/Org/Document.pm @@ -0,0 +1,801 @@ +package Org::Document; + +use 5.010; +use locale; +use Log::Any '$log'; +use Moo; +extends 'Org::Element'; + +use Time::HiRes qw(gettimeofday tv_interval); + +our $VERSION = '0.23'; # VERSION + +has tags => (is => 'rw'); +has todo_states => (is => 'rw'); +has done_states => (is => 'rw'); +has priorities => (is => 'rw'); +has drawer_names => (is => 'rw'); +has properties => (is => 'rw'); +has radio_targets => (is => 'rw'); + +has time_zone => (is => 'rw'); + +our $tags_re = qr/:(?:[A-Za-z0-9_@#%]+:)+/; +my $ls_re = qr/(?:(?<=[\015\012])|\A)/; +my $le_re = qr/(?:\R|\z)/; +our $arg_re = qr/(?: '(? [^']*)' | + "(? [^"]*)" | + (? \S+) ) + /x; +our $args_re = qr/(?: $arg_re (?:[ \t]+ $arg_re)*)/x; +my $tstamp_re = qr/(?:\[\d{4}-\d{2}-\d{2} [ ] [^\n\]]*\])/x; +my $act_tstamp_re = qr/(?: <\d{4}-\d{2}-\d{2} [ ] [^\n>]* >)/x; +my $fn_name_re = qr/(?:[^ \t\n:\]]+)/x; +my $text_re = + qr( + (? \[\[(? [^\]\n]+)\] + (?:\[(? (?:[^\]]|\R)+)\])?\]) | + (? <<<(? [^>\n]+)>>>) | + (? <<(? [^>\n]+)>>) | + + # timestamp & time range + (? (? $tstamp_re)-- + (? $tstamp_re)) | + (? $tstamp_re) | + (? (? $act_tstamp_re)-- + (? $act_tstamp_re)) | + (? $act_tstamp_re) | + + # footnote (num, name + def, name + inline definition) + (? \[(?\d+)\]) | + (? $ls_re \[fn:(? $fn_name_re)\] + [ \t]* (? [^ \t\n]+)) | + (? \[fn:(? $fn_name_re?):? + (? ([^\n\]]+)?)\]) | + + (? (?:(?<=\s)|\A) + [*/+=~_] + (?=\S)) | + (? (?<=\S) + [*/+=~_] + # actually emacs doesn't allow ! after markup + (?:(?=[ \t\n:;"',.!?\)*-])|\z)) | + + (? (?:[^\[<*/+=~_\n]+|.+?)) + #(? .+?) # too dispersy + )sxi; + +my $block_elems_re = # top level elements + qr/(? $ls_re (?[ \t]*) + \#\+BEGIN_(?\w+) + (?:[ \t]+(?[^\n]*))?\R + (?(?:.|\R)*?) + \R(?[ \t]*) + \#\+END_\k $le_re) | + (? $ls_re (?[ \t]*) \#\+ + (? \w+): [ \t]+ + (? [^\n]+) $le_re) | + (? (?: $ls_re [ \t]* (?::[ ][^\n]* | :$) $le_re )+ ) | + (? $ls_re \#[^\n]*(?:\R\#[^\n]*)* (?:\R|\z)) | + (? $ls_re (?\*+) [ \t] + (?[^\n]*?) + (?:[ \t]+(? $tags_re))?[ \t]* $le_re) | + (? $ls_re (?[ \t]*) + (?[+*-]|\d+\.) [ \t]+ + (? \[(? [ X-])\])? + (?: (? [^\n]+?) [ \t]+ ::)?) | + (? (?: $ls_re [ \t]* \| [ \t]* \S[^\n]* $le_re)+) | + (? $ls_re [ \t]* :(? \w+): [ \t]*\R + (?(?:.|\R)*?) + $ls_re [ \t]* :END:) | + (? (?:[^#|:+*0-9\n-]+|\n|.)+?) + #(? .+?) # too dispersy + /msxi; + +sub _init_pass1 { + my ($self) = @_; + $self->tags([]); + $self->todo_states([]); + $self->done_states([]); + $self->priorities([]); + $self->properties({}); + $self->drawer_names([qw/CLOCK LOGBOOK PROPERTIES/]); + # FEEDSTATUS + $self->radio_targets([]); +} + +sub _init_pass2 { + my ($self) = @_; + if (!@{ $self->todo_states } && !@{ $self->done_states }) { + $self->todo_states(['TODO']); + $self->done_states(['DONE']); + } + if (!@{ $self->priorities }) { + $self->priorities([qw/A B C/]); + } + $self->children([]); +} + +sub __parse_args { + my $args = shift; + return [] unless defined($args) && length($args); + #$log->tracef("args = %s", $args); + my @args; + while ($args =~ /$arg_re (?:\s+|\z)/xg) { + if (defined $+{squote}) { + push @args, $+{squote}; + } elsif (defined $+{dquote}) { + push @args, $+{dquote}; + } else { + push @args, $+{bare}; + } + } + #$log->tracef("\\\@args = %s", \@args); + \@args; +} + +sub __format_args { + my ($args) = @_; + my @s; + for (@$args) { + if (/\A[A-Za-z0-9_:-]+\z/) { + push @s, $_; + } elsif (/"/) { + push @s, qq('$_'); + } else { + push @s, qq("$_"); + } + } + join " ", @s; +} + +sub BUILD { + my ($self, $args) = @_; + $self->document($self) unless $self->document; + + if (defined $args->{from_string}) { + + # NOTE: parsing is done twice. first pass will set settings (e.g. custom + # todo keywords set by #+TODO), scan for radio targets. after that we + # scan again to build the elements tree. + + $self->_init_pass1(); + $self->_parse($args->{from_string}, 1); + $self->_init_pass2(); + $self->_parse($args->{from_string}, 2); + } +} + +# parse blocky elements: setting, blocks, headline, drawer +sub _parse { + my ($self, $str, $pass) = @_; + $log->tracef('-> _parse(%s, pass=%d)', $str, $pass); + my $t0 = [gettimeofday]; + + my $last_headline; + my $last_headlines = [$self]; # [$doc, $last_hl_level1, $last_hl_lvl2, ...] + my $last_listitem; + my $last_lists = []; # [last_List_obj_for_indent_level0, ...] + my $parent; + + my @text; + while ($str =~ /$block_elems_re/og) { + $parent = $last_listitem // $last_headline // $self; + #$log->tracef("TMP: parent=%s (%s)", ref($parent), $parent->_str); + my %m = %+; + next unless keys %m; # perlre bug? + #if ($log->is_trace) { + # # profiler shows that this is very heavy + # $log->tracef("match block element: %s", \%+); + #} + + if (defined $m{text}) { + push @text, $m{text}; + next; + } else { + if (@text) { + $self->_add_text(join("", @text), $parent, $pass); + } + @text = (); + } + + my $el; + if ($m{block} && $pass == 2) { + + require Org::Element::Block; + $el = Org::Element::Block->new( + _str=>$m{block}, + document=>$self, parent=>$parent, + begin_indent=>$m{block_begin_indent}, + end_indent=>$m{block_end_indent}, + name=>$m{block_name}, args=>__parse_args($m{block_raw_arg}), + raw_content=>$m{block_content}, + ); + + } elsif ($m{setting}) { + + require Org::Element::Setting; + if ($m{setting_indent} && + !(uc($m{setting_name}) ~~ + @{Org::Element::Setting->indentable_settings})) { + push @text, $m{setting}; + next; + } else { + $el = Org::Element::Setting->new( + pass => $pass, + _str=>$m{setting}, + document=>$self, parent=>$parent, + indent => $m{setting_indent}, + name=>$m{setting_name}, + args=>__parse_args($m{setting_raw_arg}), + ); + } + + } elsif ($m{fixedw} && $pass == 2) { + + require Org::Element::FixedWidthSection; + $el = Org::Element::FixedWidthSection->new( + pass => $pass, + _str=>$m{fixedw}, + document=>$self, parent=>$parent, + ); + + } elsif ($m{comment} && $pass == 2) { + + require Org::Element::Comment; + $el = Org::Element::Comment->new( + _str=>$m{comment}, + document=>$self, parent=>$parent, + ); + + } elsif ($m{table} && $pass == 2) { + + require Org::Element::Table; + $el = Org::Element::Table->new( + pass=>$pass, + _str=>$m{table}, + document=>$self, parent=>$parent, + ); + + } elsif ($m{drawer} && $pass == 2) { + + require Org::Element::Drawer; + my $raw_content = $m{drawer_content}; + $el = Org::Element::Drawer->new( + document=>$self, parent=>$parent, + name => uc($m{drawer_name}), pass => $pass, + ); + $self->_add_text($raw_content, $el, $pass); + + # for properties, we also parse property lines from raw drawer + # content. this is currently separate from normal Org text parsing, + # i'm not clear yet on how to do this canonically. + $el->_parse_properties($raw_content); + + } elsif ($m{li_header} && $pass == 2) { + + require Org::Element::List; + require Org::Element::ListItem; + + my $level = length($m{li_indent}); + my $bullet = $m{li_bullet}; + my $indent = $m{li_indent}; + my $dt = $m{li_dt}; + my $cbstate = $m{li_cbstate}; + my $type = defined($dt) ? 'D' : + $bullet =~ /^\d+\./ ? 'O' : 'U'; + my $bstyle = $type eq 'O' ? '.' : $bullet; + + # parent for list is lesser-indented list (or last headline) + $parent = $last_headline // $self; + for (my $i=$level-1; $i>=0; $i--) { + if ($last_lists->[$i]) { + $parent = $last_lists->[$i]; + last; + } + } + + my $list = $last_lists->[$level]; + if (!$list || $list->type ne $type || + $list->bullet_style ne $bstyle) { + $list = Org::Element::List->new( + document => $self, parent => $parent, + indent=>$indent, type=>$type, bullet_style=>$bstyle, + ); + $last_lists->[$level] = $list; + $parent->children([]) if !$parent->children; + push @{ $parent->children }, $list; + } + $last_lists->[$level] = $list; + + # parent for list item is list + $parent = $list; + + $el = Org::Element::ListItem->new( + document=>$self, parent=>$list, + indent=>$indent, bullet=>$bullet); + $el->check_state($cbstate) if $cbstate; + $el->desc_term($self->_add_text_container($dt, $list, $pass)) + if defined($dt); + + splice @$last_lists, $level+1; + $last_listitem = $el; + + } elsif ($m{headline} && $pass == 2) { + + require Org::Element::Headline; + my $level = length $m{h_bullet}; + + # parent is upper-level headline + $parent = undef; + for (my $i=$level-1; $i>=0; $i--) { + $parent = $last_headlines->[$i] and last; + } + $parent //= $self; + + $el = Org::Element::Headline->new( + _str=>$m{headline}, + document=>$self, parent=>$parent, + level=>$level, + ); + $el->tags(__split_tags($m{h_tags})) if ($m{h_tags}); + my $title = $m{h_title}; + + # recognize todo keyword. XXX cache re + my $todo_kw_re = "(?:". + join("|", map {quotemeta} + @{$self->todo_states}, @{$self->done_states}) . ")"; + if ($title =~ s/^($todo_kw_re)(\s+|\W)/$2/) { + my $state = $1; + $title =~ s/^\s+//; + $el->is_todo(1); + $el->todo_state($state); + $el->is_done($state ~~ @{ $self->done_states } ? 1:0); + + # recognize priority. XXX cache re + my $prio_re = "(?:". + join("|", map {quotemeta} @{$self->priorities}) . ")"; + if ($title =~ s/\[#($prio_re)\]\s*//) { + $el->todo_priority($1); + } + } + + $el->title($self->_add_text_container($title, $parent, $pass)); + + $last_headlines->[$el->level] = $el; + splice @$last_headlines, $el->level+1; + $last_headline = $el; + $last_listitem = undef; + $last_lists = []; + } + + # we haven't caught other matches to become element + die "BUG1: no element" unless $el || $pass != 2; + + $parent->children([]) if !$parent->children; + push @{ $parent->children }, $el; + } + + # remaining text + if (@text) { + $self->_add_text(join("", @text), $parent, $pass); + } + @text = (); + + $log->tracef('<- _parse(), elapsed time=%.3fs', + tv_interval($t0, [gettimeofday])); +} + +sub _add_text_container { + require Org::Element::Text; + my ($self, $str, $parent, $pass) = @_; + my $container = Org::Element::Text->new( + document=>$self, parent=>$parent, + text=>'', style=>'', + ); + $self->_add_text($str, $container, $pass); + $container = $container->children->[0] if + $container->children && @{$container->children} == 1 && + $container->children->[0]->isa('Org::Element::Text'); + $container; +} + +sub _add_text { + require Org::Element::Text; + my ($self, $str, $parent, $pass) = @_; + $parent //= $self; + #$log->tracef("-> _add_text(%s, pass=%d)", $str, $pass); + + my @plain_text; + while ($str =~ /$text_re/og) { + my %m = %+; + #if ($log->is_trace) { + # # profiler shows that this is very heavy + # $log->tracef("match text: %s", \%+); + #} + my $el; + + if (defined $m{plain_text} && $pass == 2) { + push @plain_text, $m{plain_text}; + next; + } else { + if (@plain_text) { + $self->_add_plain_text(join("", @plain_text), $parent, $pass); + @plain_text = (); + } + } + + if ($m{link} && $pass == 2) { + require Org::Element::Link; + $el = Org::Element::Link->new( + document => $self, parent => $parent, + link=>$m{link_link}, + ); + if (defined($m{link_desc}) && length($m{link_desc})) { + $el->description( + $self->_add_text_container($m{link_desc}, + $el, $pass)); + } + } elsif ($m{radio_target}) { + require Org::Element::RadioTarget; + $el = Org::Element::RadioTarget->new( + pass => $pass, + document => $self, parent => $parent, + target=>$m{rt_target}, + ); + } elsif ($m{target} && $pass == 2) { + require Org::Element::Target; + $el = Org::Element::Target->new( + document => $self, parent => $parent, + target=>$m{t_target}, + ); + } elsif ($m{fn_num} && $pass == 2) { + require Org::Element::Footnote; + $el = Org::Element::Footnote->new( + document => $self, parent => $parent, + name=>$m{fn_num_num}, is_ref=>1, + ); + } elsif ($m{fn_namedef} && $pass == 2) { + require Org::Element::Footnote; + $el = Org::Element::Footnote->new( + document => $self, parent => $parent, + name=>$m{fn_namedef_name}, + is_ref=>$m{fn_namedef_def} ? 0:1, + ); + $el->def($self->_add_text_container($m{fn_namedef_def}, + $parent, $pass)); + } elsif ($m{fn_nameidef} && $pass == 2) { + require Org::Element::Footnote; + $el = Org::Element::Footnote->new( + document => $self, parent => $parent, + name=>$m{fn_nameidef_name}, + is_ref=>($m{fn_nameidef_def} ? 0:1) || + !length($m{fn_nameidef_name}), + ); + $el->def(length($m{fn_nameidef_def}) ? + $self->_add_text_container($m{fn_nameidef_def}, + $parent, $pass) : undef); + } elsif ($m{trange} && $pass == 2) { + require Org::Element::TimeRange; + require Org::Element::Timestamp; + $el = Org::Element::TimeRange->new( + document => $self, parent => $parent, + ); + my $opts = {allow_event_duration=>0, allow_repeater=>0}; + $el->ts1(Org::Element::Timestamp->new( + document=>$self, parent=>$parent)); + $el->ts1->_parse_timestamp($m{trange_ts1}, $opts); + $el->ts2(Org::Element::Timestamp->new( + document=>$self, parent=>$parent)); + $el->ts2->_parse_timestamp($m{trange_ts2}, $opts); + $el->children([$el->ts1, $el->ts2]); + } elsif ($m{tstamp} && $pass == 2) { + require Org::Element::Timestamp; + $el = Org::Element::Timestamp->new( + document => $self, parent => $parent, + ); + $el->_parse_timestamp($m{tstamp}); + } elsif ($m{act_trange} && $pass == 2) { + require Org::Element::TimeRange; + require Org::Element::Timestamp; + $el = Org::Element::TimeRange->new( + document => $self, parent => $parent, + ); + my $opts = {allow_event_duration=>0, allow_repeater=>0}; + $el->ts1(Org::Element::Timestamp->new( + document=>$self, parent=>$parent)); + $el->ts1->_parse_timestamp($m{act_trange_ts1}, $opts); + $el->ts2(Org::Element::Timestamp->new( + document=>$self, parent=>$parent)); + $el->ts2->_parse_timestamp($m{act_trange_ts2}, $opts); + $el->children([$el->ts1, $el->ts2]); + } elsif ($m{act_tstamp} && $pass == 2) { + require Org::Element::Timestamp; + $el = Org::Element::Timestamp->new( + document => $self, parent => $parent, + ); + $el->_parse_timestamp($m{act_tstamp}); + } elsif ($m{markup_start} && $pass == 2) { + require Org::Element::Text; + $el = Org::Element::Text->new( + document => $self, parent => $parent, + style=>'', text=>$m{markup_start}, + ); + # temporary mark, we need to apply markup later + $el->{_mu_start}++; + } elsif ($m{markup_end} && $pass == 2) { + require Org::Element::Text; + $el = Org::Element::Text->new( + document => $self, parent => $parent, + style=>'', text=>$m{markup_end}, + ); + # temporary mark, we need to apply markup later + $el->{_mu_end}++; + } + die "BUG2: no element" unless $el || $pass != 2; + $parent->children([]) if !$parent->children; + push @{ $parent->children }, $el; + } + + # remaining text + if (@plain_text && $pass == 2) { + $parent->children([]) if !$parent->children; + push @{$parent->children}, Org::Element::Text->new( + text => join("", @plain_text), style=>'', + document=>$self, parent=>$parent); + @plain_text = (); + } + + if ($pass == 2) { + $self->_apply_markup($parent); + if (@{$self->radio_targets}) { + my $re = join "|", map {quotemeta} @{$self->radio_targets}; + $re = qr/(?:$re)/i; + $self->_linkify_rt_recursive($re, $parent); + } + my $c = $parent->children // []; + } + + #$log->tracef('<- _add_text()'); +} + +# to keep parser's regexes simple and fast, we detect markup in regex rather +# simplistically (as text element) and then apply some more filtering & applying +# logic here + +sub _apply_markup { + #$log->trace("-> _apply_markup()"); + my ($self, $parent) = @_; + my $last_index = 0; + my $c = $parent->children or return; + + while (1) { + #$log->tracef("text cluster = %s", [map {$_->as_string} @$c]); + # find a new mu_start + my $mu_start_index = -1; + my $mu; + for (my $i = $last_index; $i < @$c; $i++) { + next unless $c->[$i]->{_mu_start}; + $mu_start_index = $i; $mu = $c->[$i]->text; + #$log->tracef("found mu_start at %d (%s)", $i, $mu); + last; + } + unless ($mu_start_index >= 0) { + #$log->trace("no more mu_start found"); + last; + } + + # check whether this is a valid markup (has text, has markup end, not + # interspersed with non-text, no more > 1 newlines) + my $mu_end_index = 0; + my $newlines = 0; + my $has_text; + my $has_unmarkable; + for (my $i=$mu_start_index+1; $i < @$c; $i++) { + if ($c->[$i]->isa('Org::Element::Text')) { + $has_text++; + } elsif (1) { + } else { + $has_unmarkable++; last; + } + if ($c->[$i]->{_mu_end} && $c->[$i]->text eq $mu) { + #$log->tracef("found mu_end at %d", $i); + $mu_end_index = $i; last; + } + my $text = $c->[$i]->as_string; + $newlines++ while $text =~ /\R/g; + last if $newlines > 1; + } + my $valid = $has_text && !$has_unmarkable + && $mu_end_index && $newlines <= 1; + #$log->tracef("mu candidate: start=%d, end=%s, ". + # "has_text=%s, has_unmarkable=%s, newlines=%d, valid=%s", + # $mu_start_index, $mu_end_index, + # $has_text, $has_unmarkable, $newlines, $valid + # ); + if ($valid) { + my $mu_el = Org::Element::Text->new( + document => $self, parent => $parent, + style=>$Org::Element::Text::mu2style{$mu}, text=>'', + ); + my @c2 = splice @$c, $mu_start_index, + $mu_end_index-$mu_start_index+1, $mu_el; + #$log->tracef("grouping %s", [map {$_->text} @c2]); + $mu_el->children(\@c2); + shift @c2; + pop @c2; + for (@c2) { + $_->{parent} = $mu_el; + } + $self->_merge_text_elements(\@c2); + # squish if only one child + if (@c2 == 1) { + $mu_el->text($c2[0]->text); + $mu_el->children(undef); + } + } else { + undef $c->[$mu_start_index]->{_mu_start}; + $last_index++; + } + } + $self->_merge_text_elements($c); + #$log->trace("<- _apply_markup()"); +} + +sub _merge_text_elements { + my ($self, $els) = @_; + #$log->tracef("-> _merge_text_elements(%s)", [map {$_->as_string} @$els]); + return unless @$els >= 2; + my $i=-1; + while (1) { + $i++; + last if $i >= @$els; + next if $els->[$i]->children || !$els->[$i]->isa('Org::Element::Text'); + my $istyle = $els->[$i]->style // ""; + while (1) { + last if $i+1 >= @$els || $els->[$i+1]->children || + !$els->[$i+1]->isa('Org::Element::Text'); + last if ($els->[$i+1]->style // "") ne $istyle; + #$log->tracef("merging text[%d] '%s' with '%s'", + # $i, $els->[$i]->text, $els->[$i+1]->text); + $els->[$i]->{text} .= $els->[$i+1]->{text} // ""; + splice @$els, $i+1, 1; + } + } + #$log->tracef("merge result = %s", [map {$_->as_string} @$els]); + #$log->trace("<- _merge_text_elements()"); +} + +sub _linkify_rt_recursive { + require Org::Element::Text; + require Org::Element::Link; + my ($self, $re, $parent) = @_; + my $c = $parent->children; + return unless $c; + for (my $i=0; $i<@$c; $i++) { + my $el = $c->[$i]; + if ($el->isa('Org::Element::Text')) { + my @split0 = split /\b($re)\b/, $el->text; + next unless @split0 > 1; + my @split; + for my $s (@split0) { + if ($s =~ /^$re$/) { + push @split, Org::Element::Link->new( + document=>$self, parent=>$parent, + link=>$s, description=>undef, + from_radio_target=>1, + ); + } elsif (length $s) { + push @split, Org::Element::Text->new( + document=>$self, parent=>$parent, + text=>$s, style=>$el->style, + ); + } + } + splice @$c, $i, 1, @split; + } + $self->_linkify_rt_recursive($re, $el); + } +} + +sub _add_plain_text { + require Org::Element::Text; + my ($self, $str, $parent, $pass) = @_; + my $el = Org::Element::Text->new( + document=>$self, parent=>$parent, style=>'', text=>$str); + $parent->children([]) if !$parent->children; + push @{ $parent->children }, $el; +} + +sub __split_tags { + [$_[0] =~ /:([^:]+)/g]; +} + +1; +# ABSTRACT: Represent an Org document + + +=pod + +=head1 NAME + +Org::Document - Represent an Org document + +=head1 VERSION + +version 0.23 + +=head1 SYNOPSIS + + use Org::Document; + + # create a new Org document tree from string + my $org = Org::Document->new(from_string => <. + +=head1 ATTRIBUTES + +=head2 tags => ARRAY + +List of tags for this file, usually set via #+FILETAGS. + +=head2 todo_states => ARRAY + +List of known (action-requiring) todo states. Default is ['TODO']. + +=head2 done_states => ARRAY + +List of known done (non-action-requiring) states. Default is ['DONE']. + +=head2 priorities => ARRAY + +List of known priorities. Default is ['A', 'B', 'C']. + +=head2 drawer_names => ARRAY + +List of known drawer names. Default is [qw/CLOCK LOGBOOK PROPERTIES/]. + +=head2 properties => ARRAY + +File-wide properties. + +=head2 radio_targets => ARRAY + +List of radio target text. + +=head2 time_zone => ARRAY + +If set, will be passed to DateTime->new() (e.g. by L). + +=head1 METHODS + +=for Pod::Coverage BUILD + +=head2 new(from_string => ...) + +Create object from string. + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Dump.pm b/lib/Org/Dump.pm new file mode 100644 index 0000000..1ccc459 --- /dev/null +++ b/lib/Org/Dump.pm @@ -0,0 +1,153 @@ +package Org::Dump; + +use 5.010; +use strict; +use warnings; +use Log::Any qw($log); + +use String::Escape qw(elide printable); + +our $VERSION = '0.23'; # VERSION + +sub _dump_ts { + my ($self, $ts) = @_; + my $dump = ""; + $dump .= "A " if $ts->is_active; + my $dt = $ts->datetime; + my $tz = $dt->time_zone; + $dump .= $dt. + ($tz->is_floating ? "F" : $tz->short_name_for_datetime($dt)); + $dump; +} + +sub dump_element { + my ($el, $indent_level) = @_; + __PACKAGE__->new->_dump($el, $indent_level); +} + +sub new { + my ($class) = @_; + bless {}, $class; +} + +sub _dump { + my ($self, $el, $indent_level) = @_; + $indent_level //= 0; + my @res; + + my $line = " " x $indent_level; + my $type = ref($el); + $type =~ s/^Org::(?:Element::)?//; + $line .= "$type:"; + # per-element important info + if ($type eq 'Headline') { + $line .= " l=".$el->level; + $line .= " tags ".join(",", @{$el->tags}) if $el->tags; + $line .= " todo=".$el->todo_state if $el->todo_state; + } elsif ($type eq 'Footnote') { + $line .= " name=".($el->name // ""); + } elsif ($type eq 'Block') { + $line .= " name=".($el->name // ""); + } elsif ($type eq 'List') { + $line .= " ".$el->type; + $line .= "(".$el->bullet_style.")"; + $line .= " indent=".length($el->indent); + } elsif ($type eq 'ListItem') { + $line .= " ".$el->bullet; + $line .= " [".$el->check_state."]" if $el->check_state; + } elsif ($type eq 'Text') { + #$line .= " mu_start" if $el->{_mu_start}; #TMP + #$line .= " mu_end" if $el->{_mu_end}; #TMP + $line .= " ".$el->style if $el->style; + } elsif ($type eq 'Timestamp') { + $line .= " ".$self->_dump_ts($el); + } elsif ($type eq 'TimeRange') { + } elsif ($type eq 'Drawer') { + $line .= " ".$el->name; + $line .= " "._format_properties($el->properties) + if $el->name eq 'PROPERTIES' && $el->properties; + } + unless ($el->children) { + $line .= " \"". + printable(elide(($el->_str // $el->as_string), 50))."\""; + } + push @res, $line, "\n"; + + if ($type eq 'Headline') { + push @res, " " x ($indent_level+1), "(title)\n"; + push @res, $self->_dump($el->title, $indent_level+1); + push @res, " " x ($indent_level+1), "(children)\n" if $el->children; + } elsif ($type eq 'Footnote') { + if ($el->def) { + push @res, " " x ($indent_level+1), "(definition)\n"; + push @res, $self->_dump($el->def, $indent_level+1); + } + push @res, " " x ($indent_level+1), "(children)\n" if $el->children; + } elsif ($type eq 'ListItem') { + if ($el->desc_term) { + push @res, " " x ($indent_level+1), "(description term)\n"; + push @res, $self->_dump($el->desc_term, $indent_level+1); + } + push @res, " " x ($indent_level+1), "(children)\n" if $el->children; + } + + if ($el->children) { + push @res, $self->_dump($_, $indent_level+1) for @{ $el->children }; + } + + join "", @res; +} + +sub _format_properties { + my ($props) = @_; + #use Data::Dump::OneLine qw(dump1); return dump1($props); + my @s; + for my $k (sort keys %$props) { + my $v = $props->{$k}; + if (ref($v) eq 'ARRAY') { + $v = "[" . join(",", map {printable($_)} @$v). "]"; + } else { + $v = printable($v); + } + push @s, "$k=$v"; + } + "{" . join(", ", @s) . "}"; +} + +1; +#ABSTRACT: Show Org document/element object in a human-friendly format + + + +__END__ +=pod + +=head1 NAME + +Org::Dump - Show Org document/element object in a human-friendly format + +=head1 VERSION + +version 0.23 + +=head1 FUNCTIONS + +None are exported. + +=for Pod::Coverage new + +=head2 dump_element($elem) => STR + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Org/Element.pm b/lib/Org/Element.pm new file mode 100644 index 0000000..c208dc8 --- /dev/null +++ b/lib/Org/Element.pm @@ -0,0 +1,287 @@ +package Org::Element; + +use 5.010; +use locale; +use Log::Any '$log'; +use Moo; +use Scalar::Util qw(refaddr); + +our $VERSION = '0.23'; # VERSION + +has document => (is => 'rw'); +has parent => (is => 'rw'); +has children => (is => 'rw'); + +# store the raw string (to preserve original formatting), not all elements use +# this, usually only more complex elements +has _str => (is => 'rw'); +has _str_include_children => (is => 'rw'); + +sub children_as_string { + my ($self) = @_; + return "" unless $self->children; + join "", map {$_->as_string} @{$self->children}; +} + +sub as_string { + my ($self) = @_; + + if (defined $self->_str) { + return $self->_str . + ($self->_str_include_children ? "" : $self->children_as_string); + } else { + return "" . $self->children_as_string; + } +} + +sub seniority { + my ($self) = @_; + my $c; + return -4 unless $self->parent && ($c = $self->parent->children); + my $addr = refaddr($self); + for (my $i=0; $i < @$c; $i++) { + return $i if refaddr($c->[$i]) == $addr; + } + return undef; +} + +sub prev_sibling { + my ($self) = @_; + + my $sen = $self->seniority; + return undef unless defined($sen) && $sen > 0; + my $c = $self->parent->children; + $c->[$sen-1]; +} + +sub next_sibling { + my ($self) = @_; + + my $sen = $self->seniority; + return undef unless defined($sen); + my $c = $self->parent->children; + return undef unless $sen < @$c-1; + $c->[$sen+1]; +} + +sub get_property { + my ($self, $name, $search_parent) = @_; + #$log->tracef("-> get_property(%s, search_par=%s)", $name, $search_parent); + my $p = $self->parent; + my $s = $p->children if $p; + + if ($s) { + for my $d (@$s) { + #$log->tracef("searching in sibling: %s (%s)", $d->as_string, ref($d)); + next unless $d->isa('Org::Element::Drawer') + && $d->name eq 'PROPERTIES' && $d->properties; + return $d->properties->{$name} if defined $d->properties->{$name}; + } + } + + if ($p && $search_parent) { + my $res = $p->get_property($name, 1); + return $res if defined $res; + } + + $log->tracef("Getting property from document's .properties"); + $self->document->properties->{$name}; +} + +sub walk { + my ($self, $code) = @_; + $code->($self); + if ($self->children) { + $_->walk($code) for @{$self->children}; + } +} + +sub find { + my ($self, $criteria) = @_; + return unless $self->children; + my @res; + $self->walk( + sub { + my $el = shift; + if (ref($criteria) eq 'CODE') { + push @res, $el if $criteria->($el); + } elsif ($criteria =~ /^\w+$/) { + push @res, $el if $el->isa("Org::Element::$criteria"); + } else { + push @res, $el if $el->isa($criteria); + } + }); + @res; +} + +sub walk_parents { + my ($self, $code) = @_; + my $parent = $self->parent; + while ($parent) { + return $parent unless $code->($self, $parent); + $parent = $parent->parent; + } + return; +} + +sub headline { + my ($self) = @_; + my $h; + $self->walk_parents( + sub { + my ($el, $p) = @_; + if ($p->isa('Org::Element::Headline')) { + $h = $p; + return; + } + 1; + }); + $h; +} + +sub field_name { + my ($self) = @_; + + my $prev = $self->prev_sibling; + if ($prev && $prev->isa('Org::Element::Text')) { + my $text = $prev->as_string; + if ($text =~ /(?:\A|\R)\s*(.+?)\s*:\s*\z/) { + return $1; + } + } + my $parent = $self->parent; + if ($parent && $parent->isa('Org::Element::ListItem')) { + my $list = $parent->parent; + if ($list->type eq 'D') { + return $parent->desc_term->as_string; + } + } + # TODO + #if ($parent && $parent->isa('Org::Element::Drawer') && + # $parent->name eq 'PROPERTIES') { + #} + return; +} + +sub remove { + my ($self) = @_; + my $parent = $self->parent; + return unless $parent; + splice @{$parent->children}, $self->seniority, 1; +} + +1; +# ABSTRACT: Base class for Org document elements + + +__END__ +=pod + +=head1 NAME + +Org::Element - Base class for Org document elements + +=head1 VERSION + +version 0.23 + +=head1 SYNOPSIS + + # Don't use directly, use the other Org::Element::* classes. + +=head1 DESCRIPTION + +This is the base class for all the other Org element classes. + +=head1 ATTRIBUTES + +=head2 document => DOCUMENT + +Link to document object. Elements need this to access file-wide settings, +properties, etc. + +=head2 parent => undef | ELEMENT + +Link to parent element. Undef if this element is the root element. + +=head2 children => undef | ARRAY_OF_ELEMENTS + +=head1 METHODS + +=head2 $el->children_as_string() => STR + +Return a concatenation of children's as_string(), or "" if there are no +children. + +=head2 $el->as_string() => STR + +Return the string representation of element. The default implementation will +just use _str (if defined) concatenated with children_as_string(). + +=head2 $el->seniority => INT + +Find out the ranking of brothers/sisters of all sibling. If we are the first +child of parent, return 0. If we are the second child, return 1, and so on. + +=head2 $el->prev_sibling() => ELEMENT | undef + +=head2 $el->next_sibling() => ELEMENT | undef + +=head2 $el->get_property($name, $search_parent) => VALUE + +Search for property named $name in the nearest properties drawer. If +$search_parent is set to true (default is false), will also search in +upper-level properties (useful for searching for inherited property, like +foo_ALL). Return undef if property cannot be found in all drawers. + +Regardless of $search_parent setting, file-wide properties will be consulted if +property is not found in nearest properties drawer. + +=head2 $el->walk(CODEREF) + +Call CODEREF for node and all descendent nodes, depth-first. Code will be given +the element object as argument. + +=head2 $el->find(CRITERIA) => ELEMENTS + +Find subelements. CRITERIA can be a word (e.g. 'Headline' meaning of class +'Org::Element::Headline') or a class name ('Org::Element::ListItem') or a +coderef (which will be given the element to test). Will return matched elements. + +=head2 $el->walk_parents(CODE) + +Run CODEREF for parent, and its parent, and so on until the root element (the +document), or until CODEREF returns a false value. CODEREF will be supplied +($el, $parent). Will return the last parent walked. + +=head2 $el->headline() => ELEMENT + +Get current headline. + +=head2 $el->field_name() => STR + +Try to extract "field name", being defined as either some text on the left side: + + DEADLINE: <2011-06-09 > + +or a description term in a description list: + + - wedding anniversary :: <2011-06-10 > + +=head2 $el->remove() + +Remove element from the tree. Basically just remove the element from its parent. + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Org/Element/Block.pm b/lib/Org/Element/Block.pm new file mode 100644 index 0000000..5bc9fbf --- /dev/null +++ b/lib/Org/Element/Block.pm @@ -0,0 +1,96 @@ +package Org::Element::Block; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has name => (is => 'rw'); +has args => (is => 'rw'); +has raw_content => (is => 'rw'); +has begin_indent => (is => 'rw'); +has end_indent => (is => 'rw'); + +my @known_blocks = qw( + ASCII CENTER COMMENT EXAMPLE HTML + LATEX QUOTE SRC VERSE + ); + +sub BUILD { + my ($self, $args) = @_; + $self->name(uc $self->name); + $self->name ~~ @known_blocks or die "Unknown block name: ".$self->name; +} + +sub element_as_string { + my ($self) = @_; + return $self->_str if defined $self->_str; + join("", + $self->begin_indent // "", + "#+BEGIN_".uc($self->name), + $self->args && @{$self->args} ? + " ".Org::Document::__format_args($self->args) : "", + "\n", + $self->raw_content, + $self->end_indent // "", + "#+END_".uc($self->name)."\n"); +} + +1; +# ABSTRACT: Represent Org block + + +=pod + +=head1 NAME + +Org::Element::Block - Represent Org block + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 name => STR + +Block name. For example, #+begin_src ... #+end_src is an 'SRC' block. + +=head2 args => ARRAY + +=head2 raw_content => STR + +=head2 begin_indent => STR + +Indentation on begin line (before C<#+BEGIN>), or empty string if none. + +=head2 end_indent => STR + +Indentation on end line (before C<#+END>), or empty string if none. + +=head1 METHODS + +=for Pod::Coverage element_as_string BUILD + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Comment.pm b/lib/Org/Element/Comment.pm new file mode 100644 index 0000000..1b37d70 --- /dev/null +++ b/lib/Org/Element/Comment.pm @@ -0,0 +1,47 @@ +package Org::Element::Comment; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +1; +# ABSTRACT: Represent Org comment + + +=pod + +=head1 NAME + +Org::Element::Comment - Represent Org comment + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head1 METHODS + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Drawer.pm b/lib/Org/Element/Drawer.pm new file mode 100644 index 0000000..5d702f3 --- /dev/null +++ b/lib/Org/Element/Drawer.pm @@ -0,0 +1,89 @@ +package Org::Element::Drawer; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has name => (is => 'rw'); +has properties => (is => 'rw'); + +sub BUILD { + my ($self, $args) = @_; + my $doc = $self->document; + my $pass = $args->{pass} // 1; + + if ($pass == 2) { + die "Unknown drawer name: ".$self->name + unless $self->name ~~ @{$doc->drawer_names}; + } +} + +sub _parse_properties { + my ($self, $raw_content) = @_; + $self->properties({}) unless $self->properties; + while ($raw_content =~ /^[ \t]*:(\w+):[ \t]+ + ($Org::Document::args_re)[ \t]*(?:\R|\z)/mxg) { + my $args = Org::Document::__parse_args($2); + $self->properties->{$1} = @$args == 1 ? $args->[0] : $args; + } +} + +sub as_string { + my ($self) = @_; + join("", + ":", $self->name, ":\n", + $self->children_as_string, + ":END:\n"); +} + +1; +# ABSTRACT: Represent Org drawer + + +=pod + +=head1 NAME + +Org::Element::Drawer - Represent Org drawer + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 name => STR + +Drawer name. + +=head2 properties => HASH + +Collected properties in the drawer. + +=head1 METHODS + +=for Pod::Coverage BUILD as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/FixedWidthSection.pm b/lib/Org/Element/FixedWidthSection.pm new file mode 100644 index 0000000..c753055 --- /dev/null +++ b/lib/Org/Element/FixedWidthSection.pm @@ -0,0 +1,84 @@ +package Org::Element::FixedWidthSection; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +sub text { + my ($self) = @_; + my $res = $self->_str; + $res =~ s/^[ \t]*: ?//mg; + $res; +} + +1; +# ABSTRACT: Represent Org fixed-width section + + +=pod + +=head1 NAME + +Org::Element::FixedWidthSection - Represent Org fixed-width section + +=head1 VERSION + +version 0.23 + +=head1 SYNOPSIS + + use Org::Element::FixedWidthSection; + my $el = Org::Element::FixedWidthSection->new(_str => ": line1\n: line2\n"); + +=head1 DESCRIPTION + +Fixed width section is a block of text where each line is prefixed by colon + +space (or just a colon + space or a colon). Example: + + Here is an example: + : some example from a text file. + : second line. + : + : fourth line, after the empty above. + +which is functionally equivalent to: + + Here is an example: + #+BEGIN_EXAMPLE + some example from a text file. + another example. + + fourth line, after the empty above. + #+END_EXAMPLE + +Derived from L. + +=head1 ATTRIBUTES + +=head1 METHODS + +=head2 $el->text => STR + +The text (without colon prefix). + +=for Pod::Coverage as_string BUILD + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Footnote.pm b/lib/Org/Element/Footnote.pm new file mode 100644 index 0000000..f60315f --- /dev/null +++ b/lib/Org/Element/Footnote.pm @@ -0,0 +1,79 @@ +package Org::Element::Footnote; + +use 5.010; +use locale; +use Log::Any '$log'; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has name => (is => 'rw'); +has is_ref => (is => 'rw'); +has def => (is => 'rw'); + +sub BUILD { + my ($self, $args) = @_; + $log->tracef("name = %s", $self->name); +} + +sub as_string { + my ($self) = @_; + + join("", + "[fn:", ($self->name // ""), + defined($self->def) ? ":".$self->def->as_string : "", + "]"); +} + +1; +# ABSTRACT: Represent Org footnote reference and/or definition + + +__END__ +=pod + +=head1 NAME + +Org::Element::Footnote - Represent Org footnote reference and/or definition + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 name => STR|undef + +Can be undef, for anonymous footnote (but in case of undef, is_ref must be +true and def must also be set). + +=head2 is_ref => BOOL + +Set to true to make this a footnote reference. + +=head2 def => TEXT ELEMENT + +Set to make this a footnote definition. + +=head1 METHODS + +=for Pod::Coverage as_string BUILD + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Org/Element/Headline.pm b/lib/Org/Element/Headline.pm new file mode 100644 index 0000000..83ac4c3 --- /dev/null +++ b/lib/Org/Element/Headline.pm @@ -0,0 +1,332 @@ +package Org::Element::Headline; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has level => (is => 'rw'); +has title => (is => 'rw'); +has todo_priority => (is => 'rw'); +has tags => (is => 'rw'); +has is_todo => (is => 'rw'); +has is_done => (is => 'rw'); +has todo_state => (is => 'rw'); +has progress => (is => 'rw'); + +sub header_as_string { + my ($self) = @_; + return $self->_str if defined $self->_str; + join("", + "*" x $self->level, + " ", + $self->is_todo ? $self->todo_state." " : "", + $self->todo_priority ? "[#".$self->todo_priority."] " : "", + $self->title->as_string, + $self->tags && @{$self->tags} ? + " :".join(":", @{$self->tags}).":" : "", + "\n"); +} + +sub as_string { + my ($self) = @_; + $self->header_as_string . $self->children_as_string; +} + +sub get_tags { + my ($self, $name, $search_parent) = @_; + my @res = @{ $self->tags // [] }; + $self->walk_parents( + sub { + my ($el, $parent) = @_; + return 1 unless $parent->isa('Org::Element::Headline'); + if ($parent->tags) { + for (@{ $parent->tags }) { + push @res, $_ unless $_ ~~ @res; + } + } + 1; + }); + for (@{ $self->document->tags }) { + push @res, $_ unless $_ ~~ @res; + } + @res; +} + +sub get_active_timestamp { + my ($self) = @_; + + for my $s ($self->title, $self) { + my $ats; + $s->walk( + sub { + my ($el) = @_; + return if $ats; + $ats = $el if $el->isa('Org::Element::Timestamp') && + $el->is_active; + } + ); + return $ats if $ats; + } + return; +} + +sub is_leaf { + my ($self) = @_; + + return 1 unless $self->children; + + my $res; + for my $child (@{ $self->children }) { + $child->walk( + sub { + return if defined($res); + my ($el) = @_; + if ($el->isa('Org::Element::Headline')) { + $res = 0; + goto EXIT_WALK; + } + } + ); + } + EXIT_WALK: + $res //= 1; + $res; +} + +sub promote_node { + my ($self, $num_levels) = @_; + $num_levels //= 1; + return if $num_levels == 0; + die "Please specify a positive number of levels" if $num_levels < 0; + + for my $i (1..$num_levels) { + + my $l = $self->level; + last if $l <= 1; + $l--; + $self->level($l); + + $self->_str(undef); + + my $parent = $self->parent; + my $siblings = $parent->children; + my $pos = $self->seniority; + + # our children stay as children + + # our right sibling headline(s) become children + while (1) { + my $s = $siblings->[$pos+1]; + last unless $s && $s->isa('Org::Element::Headline') + && $s->level > $l; + $self->children([]) unless defined $self->children; + push @{$self->children}, $s; + splice @$siblings, $pos+1, 1; + $s->parent($self); + } + + # our parent headline can become sibling if level is the same + if ($parent->isa('Org::Element::Headline') && $parent->level == $l) { + splice @$siblings, $pos, 1; + my $gparent = $parent->parent; + splice @{$gparent->children}, $parent->seniority+1, 0, $self; + $self->parent($gparent); + } + + } +} + +sub demote_node { + my ($self, $num_levels) = @_; + $num_levels //= 1; + return if $num_levels == 0; + die "Please specify a positive number of levels" if $num_levels < 0; + + for my $i (1..$num_levels) { + + my $l = $self->level; + $l++; + $self->level($l); + + $self->_str(undef); + + # prev sibling can become parent + my $ps = $self->prev_sibling; + if ($ps && $ps->isa('Org::Element::Headline') && $ps->level < $l) { + splice @{$self->parent->children}, $self->seniority, 1; + $ps->children([]) if !defined($ps->children); + push @{$ps->children}, $self; + $self->parent($ps); + } + + } +} + +sub promote_branch { + my ($self, $num_levels) = @_; + $num_levels //= 1; + return if $num_levels == 0; + die "Please specify a positive number of levels" if $num_levels < 0; + + for my $i (1..$num_levels) { + last if $self->level <= 1; + $_->promote_node() for $self->find('Headline'); + } +} + +sub demote_branch { + my ($self, $num_levels) = @_; + $num_levels //= 1; + return if $num_levels == 0; + die "Please specify a positive number of levels" if $num_levels < 0; + + for my $i (1..$num_levels) { + $_->demote_node() for $self->find('Headline'); + } +} + +1; +# ABSTRACT: Represent Org headline + + +=pod + +=head1 NAME + +Org::Element::Headline - Represent Org headline + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 level => INT + +Level of headline (e.g. 1, 2, 3). Corresponds to the number of bullet stars. + +=head2 title => OBJ + +L representing the headline title + +=head2 todo_priority => STR + +String (optional) representing priority. + +=head2 tags => ARRAY + +Arrayref (optional) containing list of defined tags. + +=head2 is_todo => BOOL + +Whether this headline is a TODO item. + +=head2 is_done => BOOL + +Whether this TODO item is in a done state (state which requires no more action, +e.g. DONE). Only meaningful if headline is a TODO item. + +=head2 todo_state => STR + +TODO state. + +=head2 progress => STR + +Progress. + +=head1 METHODS + +=for Pod::Coverage header_as_string as_string + +=head2 $el->get_tags() => ARRAY + +Get tags for this headline. A headline can define tags or inherit tags from its +parent headline (or from document). + +=head2 $el->get_active_timestamp() => ELEMENT + +Get the first active timestamp element for this headline, either in the title or +in the child elements. + +=head2 $el->is_leaf() => BOOL + +Returns true if element doesn't contain subtrees. + +=head2 $el->promote_node([$num_levels]) + +Promote (decrease the level) of this headline node. $level specifies number of +levels, defaults to 1. Won't further promote if already at level 1. +Illustration: + + * h1 + ** h2 <-- promote 1 level + *** h3 + *** h3b + ** h4 + * h5 + +becomes: + + * h1 + * h2 + *** h3 + *** h3b + ** h4 + * h5 + +=head2 $el->demote_node([$num_levels]) + +Does the opposite of promote_node(). + +=head2 $el->promote_branch([$num_levels]) + +Like promote_node(), but all children headlines will also be promoted. +Illustration: + + * h1 + ** h2 <-- promote 1 level + *** h3 + **** grandkid + *** h3b + + ** h4 + * h5 + +becomes: + + * h1 + * h2 + ** h3 + *** grandkid + ** h3b + + ** h4 + * h5 + +=head2 $el->demote_branch([$num_levels]) + +Does the opposite of promote_branch(). + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Link.pm b/lib/Org/Element/Link.pm new file mode 100644 index 0000000..3dab23e --- /dev/null +++ b/lib/Org/Element/Link.pm @@ -0,0 +1,70 @@ +package Org::Element::Link; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has link => (is => 'rw'); +has description => (is => 'rw'); +has from_radio_target => (is => 'rw'); + +sub as_string { + my ($self) = @_; + return $self->_str if defined $self->_str; + join("", + "[", + "[", $self->link, "]", + (defined($self->description) && length($self->description) ? + ("[", $self->description, "]") : ()), + "]"); +} + +1; +# ABSTRACT: Represent Org hyperlink + + +=pod + +=head1 NAME + +Org::Element::Link - Represent Org hyperlink + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 link => STR + +=head2 description => STR + +=head2 from_radio_target => BOOL + +=head1 METHODS + +=for Pod::Coverage as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/List.pm b/lib/Org/Element/List.pm new file mode 100644 index 0000000..70492b5 --- /dev/null +++ b/lib/Org/Element/List.pm @@ -0,0 +1,73 @@ +package Org::Element::List; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has indent => (is => 'rw'); +has type => (is => 'rw'); +has bullet_style => (is => 'rw'); + +1; +# ABSTRACT: Represent Org list + + +=pod + +=head1 NAME + +Org::Element::List - Represent Org list + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Must have L (or another ::List) as children. + +Derived from L. + +=head1 ATTRIBUTES + +=head2 indent + +Indent (e.g. " " x 2). + +=head2 type + +'U' for unordered list (-, +, * for bullets), 'D' for description list, 'O' for +ordered list (1., 2., 3., and so on). + +=head2 bullet_style + +E.g. '-', '*', '+'. For ordered list, currently just use '.' + +=head1 METHODS + +=begin Pod::Coverage + + + + +=end Pod::Coverage + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/ListItem.pm b/lib/Org/Element/ListItem.pm new file mode 100644 index 0000000..9ba16e7 --- /dev/null +++ b/lib/Org/Element/ListItem.pm @@ -0,0 +1,77 @@ +package Org::Element::ListItem; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has bullet => (is => 'rw'); +has check_state => (is => 'rw'); +has desc_term => (is => 'rw'); + +sub header_as_string { + my ($self) = @_; + join("", + $self->parent->indent, + $self->bullet, " ", + defined($self->check_state) ? "[".$self->check_state."]" : "", + ); +} + +sub as_string { + my ($self) = @_; + $self->header_as_string . $self->children_as_string; +} + +1; +#ABSTRACT: Represent Org list item + + +__END__ +=pod + +=head1 NAME + +Org::Element::ListItem - Represent Org list item + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Must have L as parent. + +Derived from L. + +=head1 ATTRIBUTES + +=head2 bullet + +=head2 check_state + +undef, " ", "X" or "-". + +=head2 desc_term + +Description term (for description list). + +=head1 METHODS + +=for Pod::Coverage header_as_string as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Org/Element/RadioTarget.pm b/lib/Org/Element/RadioTarget.pm new file mode 100644 index 0000000..0a8dfe7 --- /dev/null +++ b/lib/Org/Element/RadioTarget.pm @@ -0,0 +1,69 @@ +package Org::Element::RadioTarget; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has target => (is => 'rw'); + +sub BUILD { + my ($self, $args) = @_; + my $pass = $args->{pass} // 1; + my $doc = $self->document; + if ($pass == 1) { + push @{ $doc->radio_targets }, + $self->target; + } +} + +sub as_string { + my ($self) = @_; + join("", + "<<<", $self->target, ">>>"); +} + +1; +# ABSTRACT: Represent Org radio target + + +=pod + +=head1 NAME + +Org::Element::RadioTarget - Represent Org radio target + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 target + +=head1 METHODS + +=for Pod::Coverage as_string BUILD + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Setting.pm b/lib/Org/Element/Setting.pm new file mode 100644 index 0000000..6156c4b --- /dev/null +++ b/lib/Org/Element/Setting.pm @@ -0,0 +1,174 @@ +package Org::Element::Setting; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has name => (is => 'rw'); +has args => (is => 'rw'); +has indent => (is => 'rw'); + +sub indentable_settings { + state $data = [qw/TBLFM/]; + $data; +} + +sub BUILD { + require Org::Document; + my ($self, $build_args) = @_; + my $doc = $self->document; + my $pass = $build_args->{pass} // 1; + + my $name = uc $self->name; + $self->name($name); + + my $args = $self->args; + if ($name eq 'ARCHIVE') { + } elsif ($name eq 'AUTHOR') { + } elsif ($name eq 'BABEL') { + } elsif ($name eq 'CALL') { + } elsif ($name eq 'CAPTION') { + } elsif ($name eq 'BIND') { + } elsif ($name eq 'CATEGORY') { + } elsif ($name eq 'COLUMNS') { + } elsif ($name eq 'CONSTANTS') { + } elsif ($name eq 'DATE') { + } elsif ($name eq 'DESCRIPTION') { + } elsif ($name eq 'DRAWERS') { + if ($pass == 1) { + for (@$args) { + push @{ $doc->drawer_names }, $_ + unless $_ ~~ @{ $doc->drawer_names }; + } + } + } elsif ($name eq 'EMAIL') { + } elsif ($name eq 'EXPORT_EXCLUDE_TAGS') { + } elsif ($name eq 'EXPORT_SELECT_TAGS') { + } elsif ($name eq 'FILETAGS') { + if ($pass == 1) { + $args->[0] =~ /^$Org::Document::tags_re$/ or + die "Invalid argument for FILETAGS: $args->[0]"; + for (split /:/, $args->[0]) { + next unless length; + push @{ $doc->tags }, $_ + unless $_ ~~ @{ $doc->tags }; + } + } + } elsif ($name eq 'INCLUDE') { + } elsif ($name eq 'INDEX') { + } elsif ($name eq 'KEYWORDS') { + } elsif ($name eq 'LABEL') { + } elsif ($name eq 'LANGUAGE') { + } elsif ($name eq 'LATEX_HEADER') { + } elsif ($name eq 'LINK') { + } elsif ($name eq 'LINK_HOME') { + } elsif ($name eq 'LINK_UP') { + } elsif ($name eq 'OPTIONS') { + } elsif ($name eq 'PLOT') { + } elsif ($name eq 'PRIORITIES') { + if ($pass == 1) { + for (@$args) { + push @{ $doc->priorities }, $_; + } + } + } elsif ($name eq 'PROPERTY') { + if ($pass == 1) { + @$args >= 2 or die "Not enough argument for PROPERTY, minimum 2"; + my $name = shift @$args; + $doc->properties->{$name} = @$args > 1 ? [@$args] : $args->[0]; + } + } elsif ($name =~ /^(SEQ_TODO|TODO|TYP_TODO)$/) { + if ($pass == 1) { + my $done; + for (my $i=0; $i<@$args; $i++) { + my $arg = $args->[$i]; + if ($arg eq '|') { $done++; next } + $done++ if !$done && @$args > 1 && $i == @$args-1; + my $ary = $done ? $doc->done_states : $doc->todo_states; + push @$ary, $arg unless $arg ~~ @$ary; + } + } + } elsif ($name eq 'SETUPFILE') { + } elsif ($name eq 'STARTUP') { + } elsif ($name eq 'STYLE') { + } elsif ($name eq 'TAGS') { + } elsif ($name eq 'TBLFM') { + } elsif ($name eq 'TEXT') { + } elsif ($name eq 'TITLE') { + } elsif ($name eq 'XSLT') { + } else { + die "Unknown setting $name"; + } +} + +sub as_string { + my ($self) = @_; + join("", + $self->indent // "", + "#+".uc($self->name), + $self->args && @{$self->args} ? + " ".Org::Document::__format_args($self->args) : "", + "\n" + ); +} + +1; +# ABSTRACT: Represent Org in-buffer settings + + +=pod + +=head1 NAME + +Org::Element::Setting - Represent Org in-buffer settings + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 name => STR + +Setting name. + +=head2 args => ARRAY + +Setting's arguments. + +=head2 indent => STR + +Indentation (whitespaces before C<#+>), or empty string if none. + +=head1 METHODS + +=for Pod::Coverage as_string BUILD + +=head2 Org::Element::Setting->indentable_settings -> arrayref + +Return the list of setting names that can be indented. In Org, some settings can +be indented and some can't. Setting names are all in uppercase. + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Table.pm b/lib/Org/Element/Table.pm new file mode 100644 index 0000000..2f6ed28 --- /dev/null +++ b/lib/Org/Element/Table.pm @@ -0,0 +1,166 @@ +package Org::Element::Table; + +use 5.010; +use locale; +use Log::Any '$log'; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has _dummy => (is => 'rw'); # workaround Moo bug + +sub BUILD { + require Org::Element::TableRow; + require Org::Element::TableVLine; + require Org::Element::TableCell; + my ($self, $args) = @_; + my $pass = $args->{pass} // 1; + + # parse _str into rows & cells + my $_str = $args->{_str}; + if (defined $_str && !defined($self->children)) { + + if (!defined($self->_str_include_children)) { + $self->_str_include_children(1); + } + + my $doc = $self->document; + my @rows0 = split /\R/, $_str; + $self->children([]); + for my $row0 (@rows0) { + $log->tracef("table line: %s", $row0); + next unless $row0 =~ /\S/; + my $row; + if ($row0 =~ /^\s*\|--+(?:\+--+)*\|?\s*$/) { + $row = Org::Element::TableVLine->new(parent => $self); + } elsif ($row0 =~ /^\s*\|\s*(.+?)\s*\|?\s*$/) { + my $s = $1; + $row = Org::Element::TableRow->new( + parent => $self, children=>[]); + for my $cell0 (split /\s*\|\s*/, $s) { + my $cell = Org::Element::TableCell->new( + parent => $row, children=>[]); + $doc->_add_text($cell0, $cell, $pass); + push @{ $row->children }, $cell; + } + } else { + die "Invalid line in table: $row0"; + } + push @{$self->children}, $row; + } + } +} + +sub rows { + my ($self) = @_; + return [] unless $self->children; + my $rows = []; + for my $el (@{$self->children}) { + push @$rows, $el if $el->isa('Org::Element::TableRow'); + } + $rows; +} + +sub row_count { + my ($self) = @_; + return 0 unless $self->children; + my $n = 0; + for my $el (@{$self->children}) { + $n++ if $el->isa('Org::Element::TableRow'); + } + $n; +} + +sub column_count { + my ($self) = @_; + return 0 unless $self->children; + + # get first row + my $row; + for my $el (@{$self->children}) { + if ($el->isa('Org::Element::TableRow')) { + $row = $el; + last; + } + } + return 0 unless $row; # table doesn't have any row + + my $n = 0; + for my $el (@{$row->children}) { + $n++ if $el->isa('Org::Element::TableCell'); + } + $n; +} + +sub as_aoa { + my ($self) = @_; + return [] unless $self->children; + + my @rows; + for my $row (@{$self->children}) { + next unless $row->isa('Org::Element::TableRow'); + push @rows, $row->as_array; + } + \@rows; +} + +1; +# ABSTRACT: Represent Org table + + +=pod + +=head1 NAME + +Org::Element::Table - Represent Org table + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. Must have L or +L instances as its children. + +=head1 ATTRIBUTES + +=head1 METHODS + +=for Pod::Coverage BUILD + +=head2 $table->rows() => ELEMENTS + +Return the rows of the table. + +=head2 $table->as_aoa() => ARRAYREF + +Return the rows of the table, each row already an array of cells produced using +as_array() method. Vertical lines will be skipped/ignored. + +=head2 $table->row_count() => INT + +Return the number of rows that the table has. + +=head2 $table->column_count() => INT + +Return the number of columns that the table has. It is counted from the first +row. + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/TableCell.pm b/lib/Org/Element/TableCell.pm new file mode 100644 index 0000000..5304bb6 --- /dev/null +++ b/lib/Org/Element/TableCell.pm @@ -0,0 +1,47 @@ +package Org::Element::TableCell; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +1; +# ABSTRACT: Represent Org table cell + + +=pod + +=head1 NAME + +Org::Element::TableCell - Represent Org table cell + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head1 METHODS + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/TableRow.pm b/lib/Org/Element/TableRow.pm new file mode 100644 index 0000000..9938cbc --- /dev/null +++ b/lib/Org/Element/TableRow.pm @@ -0,0 +1,86 @@ +package Org::Element::TableRow; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +sub as_string { + my ($self) = @_; + return $self->_str if defined $self->_str; + + join("", + "|", + join("|", map {$_->as_string} @{$self->children}), + "\n"); +} + +sub as_array { + my ($self) = @_; + + [map {$_->as_string} @{$self->children}]; +} + +sub cells { + my ($self) = @_; + return [] unless $self->children; + + my $cells = []; + for my $el (@{$self->children}) { + push @$cells, $el if $el->isa('Org::Element::TableCell'); + } + $cells; +} + +1; +# ABSTRACT: Represent Org table row + + +=pod + +=head1 NAME + +Org::Element::TableRow - Represent Org table row + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. Must have L +instances as its children. + +=head1 ATTRIBUTES + +=head1 METHODS + +=for Pod::Coverage as_string + +=head2 $table->cells() => ELEMENTS + +Return the cells of the row. + +=head2 $table->as_array() => ARRAYREF + +Return an arrayref containing the cells of the row, each cells already +stringified with as_string(). + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/TableVLine.pm b/lib/Org/Element/TableVLine.pm new file mode 100644 index 0000000..754f745 --- /dev/null +++ b/lib/Org/Element/TableVLine.pm @@ -0,0 +1,53 @@ +package Org::Element::TableVLine; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +sub as_string { + my ($self) = @_; + return $self->_str if $self->_str; + "|---\n"; +} + +1; +#ABSTRACT: Represent Org table vertical line + + +__END__ +=pod + +=head1 NAME + +Org::Element::TableVLine - Represent Org table vertical line + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head1 METHODS + +=for Pod::Coverage as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/lib/Org/Element/Target.pm b/lib/Org/Element/Target.pm new file mode 100644 index 0000000..7c2c908 --- /dev/null +++ b/lib/Org/Element/Target.pm @@ -0,0 +1,59 @@ +package Org::Element::Target; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has target => (is => 'rw'); + +sub as_string { + my ($self) = @_; + join("", + "<<", ($self->target // ""), ">>"); +} + +1; +# ABSTRACT: Represent Org target + + +=pod + +=head1 NAME + +Org::Element::Target - Represent Org target + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 target + +=head1 METHODS + +=for Pod::Coverage as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Text.pm b/lib/Org/Element/Text.pm new file mode 100644 index 0000000..84459ea --- /dev/null +++ b/lib/Org/Element/Text.pm @@ -0,0 +1,74 @@ +package Org::Element::Text; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has text => (is => 'rw'); +has style => (is => 'rw'); + +our %mu2style = (''=>'', '*'=>'B', '_'=>'U', '/'=>'I', + '+'=>'S', '='=>'C', '~'=>'V'); +our %style2mu = reverse(%mu2style); + +sub as_string { + my ($self) = @_; + my $muchar = $style2mu{$self->style // ''} // ''; + + join("", + $muchar, + $self->text // '', $self->children_as_string, + $muchar); +} + +1; +# ABSTRACT: Represent text + + +=pod + +=head1 NAME + +Org::Element::Text - Represent text + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 text + +=head2 style + +''=normal, I=italic, B=bold, U=underline, S=strikethrough, V=verbatim, +C=code + +=head1 METHODS + +=for Pod::Coverage as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + + diff --git a/lib/Org/Element/TimeRange.pm b/lib/Org/Element/TimeRange.pm new file mode 100644 index 0000000..b537147 --- /dev/null +++ b/lib/Org/Element/TimeRange.pm @@ -0,0 +1,70 @@ +package Org::Element::TimeRange; + +use 5.010; +use locale; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has ts1 => (is => 'rw'); +has ts2 => (is => 'rw'); + +sub as_string { + my ($self) = @_; + return $self->_str if $self->_str; + join("", + $self->ts1->as_string, + "--", + $self->ts2->as_string + ); +} + +1; +# ABSTRACT: Represent Org time range (TS1--TS2) + + +=pod + +=head1 NAME + +Org::Element::TimeRange - Represent Org time range (TS1--TS2) + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 ts1 => TIMESTAMP ELEMENT + +Starting timestamp. + +=head2 ts2 => TIMESTAMP ELEMENT + +Ending timestamp. + +=head1 METHODS + +=for Pod::Coverage as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Element/Timestamp.pm b/lib/Org/Element/Timestamp.pm new file mode 100644 index 0000000..110f9fe --- /dev/null +++ b/lib/Org/Element/Timestamp.pm @@ -0,0 +1,228 @@ +package Org::Element::Timestamp; + +use 5.010; +use locale; +use utf8; +use Moo; +extends 'Org::Element'; + +our $VERSION = '0.23'; # VERSION + +has datetime => (is => 'rw'); +has has_time => (is => 'rw'); +has event_duration => (is => 'rw'); +has recurrence => (is => 'rw'); +has _repeater => (is => 'rw'); # stores the raw repeater spec +has _warning_period => (is => 'rw'); # stores the raw warning period spec +has is_active => (is => 'rw'); + +our @dow = (undef, qw(Mon Tue Wed Thu Fri Sat Sun)); + +sub as_string { + my ($self) = @_; + return $self->_str if $self->_str; + my $dt = $self->datetime; + my ($hour2, $min2); + if ($self->event_duration) { + my $hour = $dt->hour; + my $min = $dt->minute; + my $mins = $self->event_duration / 60; + $min2 = $min + $mins; + my $hours = int ($min2 / 60); + $hour2 = $hour + $hours; + $min2 = $min2 % 60; + } + join("", + $self->is_active ? "<" : "[", + $dt->ymd, " ", + $dow[$dt->day_of_week], + $self->has_time ? ( + " ", + sprintf("%02d:%02d", $dt->hour, $dt->minute), + defined($hour2) ? ( + "-", + sprintf("%02d:%02d", $hour2, $min2), + ) : (), + $self->_repeater ? ( + " ", + $self->_repeater, + ) : (), + $self->_warning_period ? ( + " ", + $self->_warning_period, + ) : (), + ) : (), + $self->is_active ? ">" : "]", + ); +} + +sub _parse_timestamp { + require DateTime; + require DateTime::Event::Recurrence; + my ($self, $str, $opts) = @_; + $opts //= {}; + $opts->{allow_event_duration} //= 1; + $opts->{allow_repeater} //= 1; + + my $num_re = qr/\d+(?:\.\d+)?/; + + my $dow_re = qr/\w{1,3} | # common, chinese 四, english thu + \w{3}\. # french, e.g. mer. + /x; + + $str =~ /^(? \[|<) + (? \d{4})-(? \d{2})-(? \d{2}) \s+ + (?: + (? $dow_re) \s*? + (?:\s+ + (? \d{2}):(? \d{2}) + (?:- + (? + (? \d{2}):(? \d{2})) + )? + )? + (?:\s+(? + (? \+\+|\.\+|\+) + (? $num_re) + (? [dwmy]) + ) + )? + (?:\s+(? + - + (? $num_re) + (? [dwmy]) + ) + )? + )? + (? \]|>) + $/x + or die "Can't parse timestamp string: $str"; + # just for sanity. usually doesn't happen though because Document gives us + # either "[...]" or "<...>" + die "Mismatch open/close brackets in timestamp: $str" + if $+{open_bracket} eq '<' && $+{close_bracket} eq ']' || + $+{open_bracket} eq '[' && $+{close_bracket} eq '>'; + die "Duration not allowed in timestamp: $str" + if !$opts->{allow_event_duration} && $+{event_duration}; + die "Repeater ($+{repeater}) not allowed in timestamp: $str" + if !$opts->{allow_repeater} && $+{repeater}; + + $self->is_active($+{open_bracket} eq '<' ? 1:0) + unless defined $self->is_active; + + if ($+{event_duration} && !defined($self->event_duration)) { + $self->event_duration( + ($+{hour2}-$+{hour})*3600 + + ($+{min2} -$+{min} )*60 + ); + } + + my %dt_args = (year => $+{year}, month=>$+{mon}, day=>$+{day}); + if (defined($+{hour})) { + $dt_args{hour} = $+{hour}; + $dt_args{minute} = $+{min}; + $self->has_time(1); + } else { + $self->has_time(0); + } + if ($self->document->time_zone) { + $dt_args{time_zone} = $self->document->time_zone; + } + #use Data::Dump; dd \%dt_args; + my $dt = DateTime->new(%dt_args); + + if ($+{repeater} && !$self->recurrence) { + my $r; + my $i = $+{repeater_interval}; + my $u = $+{repeater_unit}; + if ($u eq 'd') { + $r = DateTime::Event::Recurrence->daily( + interval=>$i, start=>$dt); + } elsif ($u eq 'w') { + $r = DateTime::Event::Recurrence->weekly( + interval=>$i, start=>$dt); + } elsif ($u eq 'm') { + $r = DateTime::Event::Recurrence->monthly( + interval=>$i, start=>$dt); + } elsif ($u eq 'y') { + $r = DateTime::Event::Recurrence->yearly( + interval=>$i, start=>$dt); + } else { + die "BUG: Unknown repeater unit $u in timestamp $str"; + } + $self->recurrence($r); + $self->_repeater($+{repeater}); + } + + if ($+{warning_period}) { + my $i = $+{warning_period_interval}; + my $u = $+{warning_period_unit}; + if ($u eq 'd') { + } elsif ($u eq 'w') { + } elsif ($u eq 'm') { + } elsif ($u eq 'y') { + } else { + die "BUG: Unknown warning period unit $u in timestamp $str"; + } + $self->_warning_period($+{warning_period}); + } + + $self->datetime($dt); +} + +1; +# ABSTRACT: Represent Org timestamp + + +=pod + +=head1 NAME + +Org::Element::Timestamp - Represent Org timestamp + +=head1 VERSION + +version 0.23 + +=head1 DESCRIPTION + +Derived from L. + +=head1 ATTRIBUTES + +=head2 datetime => DATETIME_OBJ + +=head2 has_time => BOOL + +=head2 event_duration => INT + +Event duration in seconds, e.g. for event timestamp like this: + + <2011-03-23 10:15-13:25> + +event_duration is 7200+600=7800 (2 hours 10 minutes). + +=head2 recurrence => DateTime::Event::Recurrence object + +=head2 is_active => BOOL + +=head1 METHODS + +=for Pod::Coverage as_string + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + diff --git a/lib/Org/Parser.pm b/lib/Org/Parser.pm new file mode 100644 index 0000000..47dd995 --- /dev/null +++ b/lib/Org/Parser.pm @@ -0,0 +1,198 @@ +package Org::Parser; + +use 5.010; +use Moo; + +use File::Slurp; +use Org::Document; +use Scalar::Util qw(blessed); + +our $VERSION = '0.23'; # VERSION + +sub parse { + my ($self, $arg, $opts) = @_; + die "Please specify a defined argument to parse()\n" unless defined($arg); + + $opts //= {}; + + my $str; + my $r = ref($arg); + if (!$r) { + $str = $arg; + } elsif ($r eq 'ARRAY') { + $str = join "", @$arg; + } elsif ($r eq 'GLOB' || blessed($arg) && $arg->isa('IO::Handle')) { + $str = join "", <$arg>; + } elsif ($r eq 'CODE') { + my @chunks; + while (defined(my $chunk = $arg->())) { + push @chunks, $chunk; + } + $str = join "", @chunks; + } else { + die "Invalid argument, please supply a ". + "string|arrayref|coderef|filehandle\n"; + } + Org::Document->new(from_string=>$str, time_zone=>$opts->{time_zone}); +} + +sub parse_file { + my ($self, $filename, $opts) = @_; + $self->parse(scalar read_file($filename), $opts); +} + +1; +# ABSTRACT: Parse Org documents + + +=pod + +=head1 NAME + +Org::Parser - Parse Org documents + +=head1 VERSION + +version 0.23 + +=head1 SYNOPSIS + + use 5.010; + use Org::Parser; + my $orgp = Org::Parser->new(); + + # parse a file + my $doc = $orgp->parse_file("$ENV{HOME}/todo.org"); + + # parse a string + $doc = $orgp->parse(<>> + * heading1a + ** TODO heading2a + SCHEDULED: <2011-03-31 Thu> + [[some][link]] + ** DONE heading2b + [2011-03-18 ] + this will become a link: radio target + * TODO heading1b *bold* + - some + - plain + - list + - [ ] with /checkbox/ + * and + * sublist + * CANCELLED heading1c + + definition :: list + + another :: def + EOF + + # walk the document tree + $doc->walk(sub { + my ($el) = @_; + return unless $el->isa('Org::Element::Headline'); + say "heading level ", $el->level, ": ", $el->title->as_string; + }); + +will print something like: + + heading level 1: heading1a + heading level 2: heading2a + heading level 2: heading2b *bold* + heading level 1: heading1b + heading level 1: heading1c + +A command-line utility (in a separate distribution: L) is +available for debugging: + + % dump-org-structure ~/todo.org + Document: + Setting: "#+TODO: TODO | DONE CANCELLED\n" + RadioTarget: "<<>>" + Text: "\n" + Headline: l=1 + (title) + Text: "heading1a" + (children) + Headline: l=2 todo=TODO + (title) + Text: "heading2a" + (children) + Text: "SCHEDULED: " + ... + +=head1 DESCRIPTION + +This module parses Org documents. See http://orgmode.org/ for more details on +Org documents. + +This module uses L logging framework. + +This module uses L object system. + +See C in the distribution for the list of already- and not yet +implemented stuffs. + +=head1 ATTRIBUTES + +=head1 METHODS + +=head2 new() + +Create a new parser instance. + +=head2 $orgp->parse($str | $arrayref | $coderef | $filehandle, $opts) => $doc + +Parse document (which can be contained in a scalar $str, an array of lines +$arrayref, a subroutine which will be called for chunks until it returns undef, +or a filehandle). + +Returns L object. + +If 'handler' attribute is specified, will call handler repeatedly during +parsing. See the 'handler' attribute for more details. + +Will die if there are syntax errors in documents. + +$opts is a hashref and can contain these keys: C (will be passed to +Org::Document's constructor). + +=head2 $orgp->parse_file($filename, $opts) => $doc + +Just like parse(), but will load document from file instead. + +=head1 FAQ + +=head2 Why? Just as only perl can parse Perl, only org-mode can parse Org anyway! + +True. I'm only targetting good enough. As long as I can parse/process all my Org +notes and todo files, I have no complaints. + +=head2 It's too slow! + +Parser is completely regex-based at the moment (I plan to use L someday). +Performance is quite lousy but I'm not annoyed enough at the moment to overhaul +it. + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Steven Haryanto + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Steven Haryanto. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + + +__END__ + + +1; diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..6771e12 --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,73 @@ +#!perl + +use strict; +use warnings; + +use Test::More; + + + +use File::Find; +use File::Temp qw{ tempdir }; + +my @modules; +find( + sub { + return if $File::Find::name !~ /\.pm\z/; + my $found = $File::Find::name; + $found =~ s{^lib/}{}; + $found =~ s{[/\\]}{::}g; + $found =~ s/\.pm$//; + # nothing to skip + push @modules, $found; + }, + 'lib', +); + +sub _find_scripts { + my $dir = shift @_; + + my @found_scripts = (); + find( + sub { + return unless -f; + my $found = $File::Find::name; + # nothing to skip + open my $FH, '<', $_ or do { + note( "Unable to open $found in ( $! ), skipping" ); + return; + }; + my $shebang = <$FH>; + return unless $shebang =~ /^#!.*?\bperl\b\s*$/; + push @found_scripts, $found; + }, + $dir, + ); + + return @found_scripts; +} + +my @scripts; +do { push @scripts, _find_scripts($_) if -d $_ } + for qw{ bin script scripts }; + +my $plan = scalar(@modules) + scalar(@scripts); +$plan ? (plan tests => $plan) : (plan skip_all => "no tests to run"); + +{ + # fake home for cpan-testers + # no fake requested ## local $ENV{HOME} = tempdir( CLEANUP => 1 ); + + like( qx{ $^X -Ilib -e "require $_; print '$_ ok'" }, qr/^\s*$_ ok/s, "$_ loaded ok" ) + for sort @modules; + + SKIP: { + eval "use Test::Script 1.05; 1;"; + skip "Test::Script needed to test script compilation", scalar(@scripts) if $@; + foreach my $file ( @scripts ) { + my $script = $file; + $script =~ s!.*/!!; + script_compiles( $file, "$script script compiles" ); + } + } +} diff --git a/t/01-basics.t b/t/01-basics.t new file mode 100644 index 0000000..3447691 --- /dev/null +++ b/t/01-basics.t @@ -0,0 +1,78 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use File::Temp qw/tempfile/; +use File::Slurp; +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +my $doc = <<_; +#+TODO: A B | C +* test1 +** test11 +* test2 +_ +my $ary = [split /(?<=\n)/, $doc]; +sub org { + state $ary2 = [@$ary]; + shift @$ary2; +} + +test_parse( + name => "parse() accepts str", + parse_args => [$doc], +); +test_parse( + name => "parse() accepts arrayref", + parse_args => [$ary], +); +test_parse( + name => "parse() accepts coderef", + parse_args => [\&org], +); +my ($fh, $filename) = tempfile(); +write_file($filename, $doc); +open $fh, "<", $filename; +test_parse( + name => "parse() accepts filehandle", + parse_args => [$fh], +); +test_parse( + name => "parse_file() accepts file name", + parse_file_args => [$filename], +); + +test_parse( + name => "parse() doesnt accept hashref", + parse_args => [{}], + dies => 1, +); +test_parse( + name => "parse() requires argument", + parse_args => [], + dies => 1, +); +test_parse( + name => "parse() requires defined argument", + parse_args => [undef], + dies => 1, +); + +test_parse( + name => "parse() returns Org::Document instance", + doc => "* test\n", + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + isa_ok($doc, "Org::Document"); + }, +); + +done_testing(); diff --git a/t/base_element-field_name.t b/t/base_element-field_name.t new file mode 100644 index 0000000..ebcf143 --- /dev/null +++ b/t/base_element-field_name.t @@ -0,0 +1,68 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'field_name() (text)', + doc => <<'_', +DEADLINE: <2011-06-09 > +DEADLINE <2011-06-09 > +foo + bar baz : <2011-06-09 > + +- item +- item 2: <2011-06-09 > +_ + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + + my ($ts1, $ts2, $ts3, $ts4) = $doc->find('Timestamp'); + is( $ts1->field_name, "DEADLINE"); + ok(!$ts2->field_name); + is( $ts3->field_name, "bar baz"); + is( $ts4->field_name, "item 2"); + }, +); + +test_parse( + name => 'field_name() (desc_term)', + doc => <<'_', +- name1 :: value +- name2 :: <2011-06-09 > +_ + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + + my ($ts1) = $doc->find('Timestamp'); + is( $ts1->field_name, "name2"); + }, +); + +# TODO +test_parse( + name => 'field_name() (properties)', + doc => <<'_', +* first last +:PROPERTIES: + :birthday: (5 7 1970) + :email: foo@bar.com +:END: +_ + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + }, +); + +done_testing(); diff --git a/t/base_element-get_property.t b/t/base_element-get_property.t new file mode 100644 index 0000000..82a51ce --- /dev/null +++ b/t/base_element-get_property.t @@ -0,0 +1,43 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'get_property()', + doc => <<'_', +#+PROPERTY: x 1 +#+PROPERTY: y 1 +* head1 + some text + :PROPERTIES: + :x: 2 + :END: +_ + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + + my $text = $doc->children->[2]->children->[0]; + is(ref($text), "Org::Element::Text", "got text"); + is($text->as_string, " some text\n", "got correct text"); + is($text->get_property('x'), 2, + "text->get_property(x)"); + is($text->get_property('y'), 1, + "text->get_property(y)"); + ok(!$text->get_property('z'), + "text->get_property(z)"); + + # TODO: search_parent=1 + }, +); + +done_testing(); diff --git a/t/base_element.t b/t/base_element.t new file mode 100644 index 0000000..2484531 --- /dev/null +++ b/t/base_element.t @@ -0,0 +1,131 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'seniority(), prev_sibling(), next_sibling()', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* h1 +** h2a +** h2b +** h2c +_ + num => 4, + test_after_parse => sub { + my (%args) = @_; + my $h = $args{elements}; + is($h->[0]->seniority, 0, "h1's seniority=0"); + is($h->[1]->seniority, 0, "h2a's seniority=0"); + is($h->[2]->seniority, 1, "h2b's seniority=1"); + is($h->[3]->seniority, 2, "h2c's seniority=2"); + + ok(!defined($h->[0]->prev_sibling), "h1 doesnt have prev_sibling"); + ok(!defined($h->[1]->prev_sibling), "h2a doesnt have prev_sibling"); + is($h->[2]->prev_sibling->title->as_string, "h2a", + "h2b's prev_sibling=h2a"); + is($h->[3]->prev_sibling->title->as_string, "h2b", + "h2c's pre_sibling=h2b"); + + ok(!defined($h->[0]->prev_sibling), "h1 doesnt have next_sibling"); + is($h->[1]->next_sibling->title->as_string, "h2b", + "h2a's next_sibling=h2b"); + is($h->[2]->next_sibling->title->as_string, "h2c", + "h2b's next_sibling=h2c"); + ok(!defined($h->[3]->next_sibling), "h2c doesnt have next_sibling"); + }, +); + +test_parse( + name => 'walk()', + doc => <<'_', +#comment +* h <2011-03-22 > +text +_ + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + + my $n=0; + $doc->walk(sub{$n++}); + # +1 is for document itself + # timestamp not walked (part of headline) + is($n, 3+1, "num of walked elements"); + }, +); + +test_parse( + name => 'find(), walk_parents(), headline()', + doc => <<'_', +* a +** b +*** c +**** d +text +**** d2 +_ + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + my @res = $doc->find( + sub { + $_[0]->isa('Org::Element::Headline') && + $_[0]->title->as_string =~ /^d/; + }); + is(scalar(@res), 2, "find num results"); + ok($res[1]->isa("Org::Element::Headline") && + $res[1]->title->as_string eq 'd2', "find result #2"); + + my $d = $res[0]; + my $res = ""; + $d->walk_parents( + sub { + my ($el, $parent) = @_; + return if $parent->isa('Org::Document'); + $res .= $parent->title->as_string; + }); + is($res, "cba", "walk_parents()"); + + is($d->headline->title->as_string, "c", "headline() 1"); + is($d->children->[0]->headline->title->as_string, "d", "headline() 2"); + }, +); + +test_parse( + name => 'remove()', + doc => <<'_', +* a +* b +** b2 +*** b3 +* c +_ + filter_elements => 'Org::Element::Headline', + num => 5, + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my ($a, $b, $b2, $b3, $c) = @$elems; + + $b->remove; + my @res = $doc->find('Headline'); + is(scalar(@res), 2, "remove() removes children"); + is(scalar(@{$doc->children}), 2, + "remove() removes from parent's children"); + is($a->next_sibling, $c, "a's next_sibling becomes c"); + is($c->prev_sibling, $a, "c's prev_sibling becomes a"); + }, +); + +done_testing(); diff --git a/t/block.t b/t/block.t new file mode 100644 index 0000000..03e70bf --- /dev/null +++ b/t/block.t @@ -0,0 +1,77 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'unknown block', + filter_elements => 'Org::Element::Block', + doc => <<'_', +#+BEGIN_FOO +bar +#+END_FOO +_ + dies => 1, +); + +test_parse( + name => 'EXAMPLE: undetected (no END, becomes comment)', + filter_elements => 'Org::Element::Block', + doc => <<'_', +#+BEGIN_EXAMPLE +1 +2 +#+xEND_EXAMPLE +_ + dies => 0, + num => 0, +); + +# also checks case-sensitiveness +test_parse( + name => 'EXAMPLE: basic tests', + filter_elements => 'Org::Element::Block', + doc => <<'_', +#+BEGIN_EXAMPLE -t -w 40 +#+INSIDE +line 2 +#+end_EXAMPLE +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my $bl = $elems->[0]; + is($bl->name, "EXAMPLE", "name"); + is_deeply($bl->args, ["-t", "-w", 40], "args"); + is($bl->raw_content, "#+INSIDE\nline 2", "raw_content"); + }, +); + +test_parse( + name => 'block is indentable', + filter_elements => 'Org::Element::Block', + doc => <<'_', + #+BEGIN_EXAMPLE +foo + #+END_EXAMPLE +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $elems = $args{elements}; + is($elems->[0]->begin_indent, " ", "begin_indent attribute"); + is($elems->[0]->end_indent, " ", "end_indent attribute"); + }, +); + +done_testing(); diff --git a/t/comment.t b/t/comment.t new file mode 100644 index 0000000..e79eac4 --- /dev/null +++ b/t/comment.t @@ -0,0 +1,43 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'comment basic tests', + filter_elements => 'Org::Element::Comment', + doc => <<'_', +# single line comment + +# *multi* +#line +# comment +# + + # not comment (not started on line 1) +_ + num => 2, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + #diag(explain [map {$_->as_string} @$elems]); + is( $elems->[0]->as_string, "# single line comment\n", + "comment[0] content"); + is( $elems->[1]->as_string, "# *multi*\n#line\n# comment\n#\n", + "comment[1] content"); + ok(!$elems->[1]->children, + "markup not parsed in comment"); + }, +); + +done_testing(); + diff --git a/t/data/custom_todo_kw.org b/t/data/custom_todo_kw.org new file mode 100644 index 0000000..be3c822 --- /dev/null +++ b/t/data/custom_todo_kw.org @@ -0,0 +1,19 @@ +#+TODO: TODO AA BB | FIXED CC + +* These are todo items (red) +** TODO ID=1; RES=todo; NOTE=default and defined above +** AA ID=2; RES=todo; NOTE=defined above +** BB ID=3; RES=todo; NOTE=defined above +** ab ID=4; RES=todo; NOTE=defined below + +* These are done todo items (green) +** FIXED ID=5; RES=todo,done; NOTE=defined after vertical bar +** CC ID=6; RES=todo,done; NOTE=defined after vertical bar +** ac ID=7; RES=todo,done; NOTE=last keyword defined is assumed a done state + +* These are not todo items +** DONE ID=8; RES=; NOTE=default but not defined +** Bb ID=9; RES=; NOTE=different case +** Cc ID=10; RES=; NOTE=different case + +#+TODO: ab ac diff --git a/t/data/listitem.org b/t/data/listitem.org new file mode 100644 index 0000000..05c8ac6 --- /dev/null +++ b/t/data/listitem.org @@ -0,0 +1,18 @@ + - (0) PARENT=; SEQ=1; NOTE=indented right away is okay + some text under list item +* heading + - (1) PARENT=; SEQ=1; NOTE=headline resets last listitem +* heading + - (2) PARENT=; SEQ=1 + - (3) PARENT=2; SEQ=1 + + (4) PARENT=2; SEQ=1; NOTE=different bullet style belongs to different list + + (5) PARENT=2; SEQ=2 + + (6) dt :: PARENT=2; SEQ=1; NOTE=description list differs from (un)ordered list + - [X](7) PARENT=2; SEQ=1; NOTE=different bullet style belongs to different list + * (8) PARENT=7; SEQ=1 + 1. (9) PARENT=8; SEQ=1 + 3. (10) PARENT=8; SEQ=2 + 4. (11) PARENT=8; SEQ=3 + + (12) PARENT=11 + - (13) PARENT=; SEQ=2 + * (14) PARENT=13; SEQ=1 diff --git a/t/data/various.org b/t/data/various.org new file mode 100644 index 0000000..90add21 --- /dev/null +++ b/t/data/various.org @@ -0,0 +1,31 @@ +# this document will contain various elements + +* heading +** heading1a's text contains timestamps :tag1:tag2: +timestamp <2011-03-23 Wed> + +inactive timestamp [2011-03-23 Wed 11:55] + +some text +with newlines +and something :resembling:tag: +:and: property + +*** heading2a +*** heading2b +** heading1b contains inactive timestamp [2011-03-23 Wed] +** heading1c contains active timestamp <2011-03-23 Wed> +** TODO heading1d +<2011-03-23 Wed 23:23> +** DONE heading1e + +* properties + :PROPERTIES: + :a: 1 + :b: 2 + :END: +** subdrawer + :PROPERTIES: + :a: 1b + :b: 2b + :END: diff --git a/t/drawer.t b/t/drawer.t new file mode 100644 index 0000000..1e0a745 --- /dev/null +++ b/t/drawer.t @@ -0,0 +1,77 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'non-drawer (missing end)', + filter_elements => 'Org::Element::Drawer', + doc => <<'_', +* foo + :CLOCK: +_ + num => 0, +); + +test_parse( + name => 'non-drawer (extra text before opening line)', + filter_elements => 'Org::Element::Drawer', + doc => <<'_', +* foo + :CLOCK: extra + :END: +_ + num => 0, +); + +test_parse( + name => 'non-drawer (extra text after opening line)', + filter_elements => 'Org::Element::Drawer', + doc => <<'_', +* foo + extra :CLOCK: + :END: +_ + num => 0, +); + +test_parse( + name => 'unknown drawer name', + filter_elements => 'Org::Element::Drawer', + doc => <<'_', +* foo + :FOO: + :END: +_ + dies => 1, +); + +test_parse( + name => 'properties basic tests', + filter_elements => 'Org::Element::Drawer', + doc => <<'_', + :PROPERTIES: + :foo: 1 "2 3" + :bar: 2 + :END: +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my $d = $elems->[0]; + is($d->name, "PROPERTIES", "name"); + is_deeply($d->properties, {foo=>[1, "2 3"], bar=>2}, "properties"); + }, +); + +done_testing(); diff --git a/t/fixed_width_section.t b/t/fixed_width_section.t new file mode 100644 index 0000000..3dafd09 --- /dev/null +++ b/t/fixed_width_section.t @@ -0,0 +1,45 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'non-fixed-width-section (missing space after colon)', + filter_elements => 'Org::Element::FixedWidthSection', + doc => <<'_', +:foo +_ + num => 0, +); + +test_parse( + name => 'basic tests', + filter_elements => 'Org::Element::FixedWidthSection', + doc => <<'_', + : this is *an* example + + : this is another example + +: yet another +: +: with empty line +_ + num => 3, + test_after_parse => sub { + my %args = @_; + my $elems = $args{elements}; + is($elems->[0]->text, " this is *an* example\n", "#0: text()"); + is($elems->[1]->text, "this is another example\n", "#1: text()"); + is($elems->[2]->text, "yet another\n\nwith empty line\n", "#2: text()"); + }, +); + +done_testing(); diff --git a/t/footnote.t b/t/footnote.t new file mode 100644 index 0000000..1275c61 --- /dev/null +++ b/t/footnote.t @@ -0,0 +1,63 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'footnote basic tests', + filter_elements => 'Org::Element::Footnote', + doc => <<'_', +# footnotes + + [1] +[fn:a] +[fn:b:inline definition] +[fn:c] definition +[fn::anon inline definition] + +# non-footnotes + +[fn:name +with newline] + +[fn:name:definition +with newline] +_ + num => 5, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $fn = $args{elements}; + + is( $fn->[0]->name, 1, "fn0 name"); + ok( $fn->[0]->is_ref, "fn0 is ref"); + ok(!$fn->[0]->def, "fn0 no def"); + + is( $fn->[1]->name, "a", "fn1 name"); + ok( $fn->[1]->is_ref, "fn1 is ref"); + ok(!$fn->[1]->def, "fn1 no def"); + + is( $fn->[2]->name, "b", "fn2 name"); + ok(!$fn->[2]->is_ref, "fn2 not ref"); + is( $fn->[2]->def->as_string, "inline definition", "fn2 def"); + + is( $fn->[3]->name, "c", "fn3 name"); + ok(!$fn->[3]->is_ref, "fn3 not ref"); + is( $fn->[3]->def->as_string, "definition", "fn3 def"); + + ok(!$fn->[4]->name, "fn4 anon"); + ok( $fn->[4]->is_ref, "fn4 is ref"); + is( $fn->[4]->def->as_string, "anon inline definition", "fn4 def"); + }, +); + +done_testing(); + diff --git a/t/headline.t b/t/headline.t new file mode 100644 index 0000000..f1380b2 --- /dev/null +++ b/t/headline.t @@ -0,0 +1,394 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +#use Org::Dump; +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'non-headline (missing space)', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +*h +_ + num => 0, +); + +test_parse( + name => 'non-headline (not on first column)', + filter_elements => 'Org::Element::Headline', + doc => <<'_', + * h +_ + num => 0, +); + +test_parse( + name => 'non-headline (no title)', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* +_ + num => 0, +); + +test_parse( + name => 'headline basic tests', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* h1 1 +** h2 1 :tag1:tag2: +*** h3 1 :invalid-tag: +text +*** TODO [#A] h3 2 + text +** DONE h2 2 +* h1 2 +_ + num => 6, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + is($elems->[0]->title->as_string, " h1 1", "0: title not trimmed"); + is($elems->[0]->level, 1, "0: level"); + + is($elems->[1]->title->as_string, "h2 1", "1: title"); + is($elems->[1]->level, 2, "1: level"); + is_deeply($elems->[1]->tags, ['tag1', 'tag2'], "1: tags"); + + is($elems->[2]->title->as_string, "h3 1 :invalid-tag:", "2: title"); + is($elems->[2]->level, 3, "2: level"); + + is( $elems->[3]->title->as_string, "h3 2", "3: title"); + is( $elems->[3]->level, 3, "3: level"); + is( $elems->[3]->is_todo, 1, "3: is_todo"); + ok(!$elems->[3]->is_done, "3: is_done"); + is( $elems->[3]->todo_state, "TODO", "3: todo_state"); + is( $elems->[3]->todo_priority, "A", "3: todo_priority"); + + is($elems->[4]->title->as_string, "h2 2", "4: title"); + is($elems->[4]->level, 2, "4: level"); + is($elems->[4]->is_todo, 1, "4: is_todo"); + is($elems->[4]->is_done, 1, "4: is_done"); + is($elems->[4]->todo_state, "DONE", "4: todo_state"); + # XXX default priority + + is($elems->[5]->title->as_string, "h1 2", "5: title"); + is($elems->[5]->level, 1, "5: level"); + }, +); + +test_parse( + name => 'headline levels', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* h1 +** h2 +*** h3 +**** h4 +***** h5 +* h1b +*** h3b +_ + num => 7, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + is($elems->[1]->parent->title->as_string, "h1", "parent of h2=h1"); + is($elems->[2]->parent->title->as_string, "h2", "parent of h3=h2"); + is($elems->[3]->parent->title->as_string, "h3", "parent of h4=h3"); + is($elems->[4]->parent->title->as_string, "h4", "parent of h5=h4"); + is($elems->[6]->parent->title->as_string, "h1b", "parent of h3b=h1b"); + }, +); + +test_parse( + name => 'todo keyword is case sensitive', + filter_elements => sub { $_[0]->isa('Org::Element::Headline') && + $_[0]->is_todo }, + doc => <<'_', +* TODO 1 +* Todo 2 +* todo 3 +* toDO 4 +_ + num => 1, +); + +test_parse( + name => 'todo keyword can be separated by other \W aside from \s', + filter_elements => sub { $_[0]->isa('Org::Element::Headline') && + $_[0]->is_todo }, + doc => <<"_", +* TODO 1 +* TODO\t2 +* TODO+3a +* TODO+ 3b +* TODO/4a +* TODO//4b + +* TODO5a +* TODO_5b +_ + num => 6, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + is($elems->[0]->title->as_string, "1", "title 1"); + is($elems->[1]->title->as_string, "2", "title 2"); + is($elems->[2]->title->as_string, "+3a", "title 3"); + is($elems->[3]->title->as_string, "+ 3b", "title 4"); + is($elems->[4]->title->as_string, "/4a", "title 5"); + is($elems->[5]->title->as_string, "//4b", "title 6"); + }, +); + +test_parse( + name => 'inline elements in headline title', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* this headline contains timestamp <2011-03-17 > as well as text +_ + num => 1, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + my $hl = $elems->[0]; + my $title = $hl->title; + isa_ok($title->children->[0], "Org::Element::Text"); + isa_ok($title->children->[1], "Org::Element::Timestamp"); + isa_ok($title->children->[2], "Org::Element::Text"); + }, +); + +test_parse( + name => 'get_tags()', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +#+FILETAGS: :t1:t2: +* a :t3: +** b :t4: +* c +_ + num => 3, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + my $tags; + $tags = [$elems->[0]->get_tags]; + is_deeply($tags, [qw/t3 t1 t2/], "get_tags 0") or diag explain $tags; + $tags = [$elems->[1]->get_tags]; + is_deeply($tags, [qw/t4 t3 t1 t2/], "get_tags 1") or diag explain $tags; + $tags = [$elems->[2]->get_tags]; + is_deeply($tags, [qw/t1 t2/], "get_tags 2") or diag explain $tags; + }, +); + +test_parse( + name => 'get_active_timestamp()', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* TODO <2011-06-06 > t0 +* TODO t1 <2011-06-06 > +* TODO t2 + DEADLINE: <2011-06-06 > + DEADLINE: <2011-06-07 > +* TODO [2011-06-06 ] t3 +* TODO t4 +_ + num => 5, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + ok( $elems->[0]->get_active_timestamp, "t0 has active timestamp"); + ok( $elems->[1]->get_active_timestamp, "t1 has active timestamp"); + ok( $elems->[2]->get_active_timestamp, "t2 has active timestamp"); + # XXX check only the first timestamp is returned + ok(!$elems->[3]->get_active_timestamp, + "t3 doesn't have active timestamp"); + ok(!$elems->[4]->get_active_timestamp, + "t4 doesn't have active timestamp"); + }, +); + +test_parse( + name => 'is_leaf()', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* a +** b +*** c +* d +_ + num => 4, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + ok(!$elems->[0]->is_leaf, "a is not leaf"); + ok(!$elems->[1]->is_leaf, "b is not leaf"); + ok( $elems->[2]->is_leaf, "c is leaf"); + ok( $elems->[3]->is_leaf, "d is leaf"); + }, +); + +test_parse( + name => 'promote_node() 1', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* h1 +** h2 +* h3 +_ + num => 3, + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my ($h1, $h2, $h3) = @$elems; + + $h1->promote_node; + is($h1->level, 1, "level 1 won't be promoted further"); + + $h2->promote_node; + is($h2->level, 1, "level 2 becomes level 1 after being promoted"); + is($h2->as_string, "* h2\n", "_str reset after being promoted"); + is($h2->prev_sibling, $h1, "parent becomes sibling (1)"); + is($h2->next_sibling, $h3, "parent becomes sibling (2)"); + }, +); +test_parse( + name => 'promote_node() 2', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +** h1 +** h2 +** h3 +_ + num => 3, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + my ($h1, $h2, $h3) = @$elems; + + $h2->promote_node; + ok(!$h2->next_sibling, "no more sibling after promote (2)") + or diag explain $h2->next_sibling->as_string; + is($h2->children->[0], $h3, "sibling becomes child"); + }, +); +test_parse( + name => 'promote_node() 3', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +*** h1 +_ + num => 1, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + my ($h1) = @$elems; + + $h1->promote_node(2); + is($h1->level, 1, "promote with argument, level 3 -> 1"); + }, +); + +test_parse( + name => 'demote_node() 1', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* h1 +* h2 +* h3 +_ + num => 3, + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my ($h1, $h2, $h3) = @$elems; + + $h2->demote_node; + is($h2->level, 2, "level 1 becomes level 2"); + is($h2->parent, $h1, "prev_sibling becomes parent"); + is($h1->next_sibling, $h3, "h1's next_sibling becomes h3"); + is($h3->prev_sibling, $h1, "h3's prev_sibling becomes h1"); + }, +); +test_parse( + name => 'demote_node() 2', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +* h1 +_ + num => 1, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + my ($h1) = @$elems; + + $h1->demote_node(3); + is($h1->level, 4, "demote 3 means level 1 becomes 4"); + }, +); + +test_parse( + name => 'promote_branch()', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +** h1 +*** h2 +**** h3 +*** h4 +** h5 +_ + num => 5, + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my ($h1, $h2, $h3, $h4, $h5) = @$elems; + + $h1->promote_branch; + is($h1->level, 1, "h1 becomes level 1"); + is($h2->level, 2, "h2 becomes level 2"); + is($h3->level, 3, "h3 becomes level 3"); + is($h4->level, 2, "h4 becomes level 2"); + is($h5->level, 2, "h5 stays at level 2"); + }, +); + +test_parse( + name => 'demote_branch()', + filter_elements => 'Org::Element::Headline', + doc => <<'_', +** h1 +*** h2 +**** h3 +*** h4 +** h5 +_ + num => 5, + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my ($h1, $h2, $h3, $h4, $h5) = @$elems; + + $h1->demote_branch; + is($h1->level, 3, "h1 becomes level 3"); + is($h2->level, 4, "h2 becomes level 4"); + is($h3->level, 5, "h3 becomes level 5"); + is($h4->level, 4, "h4 becomes level 4"); + is($h5->level, 2, "h5 stays at level 2"); + }, +); + +done_testing(); diff --git a/t/link_and_target.t b/t/link_and_target.t new file mode 100644 index 0000000..b21e00a --- /dev/null +++ b/t/link_and_target.t @@ -0,0 +1,51 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'link basic tests', + filter_elements => 'Org::Element::Link', + doc => <<'_', +# links +[[link1]] +[[link2][description2]] +[[link3][description +*can* contain markups]] + +# non-links +[[]] # empty link +[[x][]] # empty description +[[x] [x]] # there should not be a space between link & description +[[x +y] [x]] # link cannot contain newline +_ + num => 3, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is( $elems->[0]->link , "link1", "0: link"); + ok(!$elems->[0]->description, "0: description"); + is( $elems->[1]->link , "link2", "1: link"); + is( $elems->[1]->description->as_string, + "description2", "1: description"); + is( $elems->[2]->link , "link3", "2: link"); + is( $elems->[2]->description->as_string, + "description\n*can* contain markups", "2: description"); + }, +); + +# TODO: target cannot contain newline +# TODO: radio target cannot contain newline + +done_testing(); + diff --git a/t/list.t b/t/list.t new file mode 100644 index 0000000..c33be51 --- /dev/null +++ b/t/list.t @@ -0,0 +1,44 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + parse_file_args => ["t/data/listitem.org"], + name => 'list tests', + filter_elements => 'Org::Element::ListItem', + num => 15, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + + my $i=0; + is($elems->[$i]->parent->indent, " "x2, "item[$i]->list->indent"); + is($elems->[$i]->bullet, "-", "item[$i]->bullet"); + is($elems->[$i]->parent->type, "U", "item[$i]->list->type"); + + $i=6; + is($elems->[$i]->parent->type, "D", "item[$i]->list->type"); + + $i=7; + is($elems->[$i]->check_state, "X", "item[$i]->check_state"); + # TODO: only check_states " ", "X", "-" are valid + + $i=9; + is($elems->[$i]->parent->indent, " "x8, "item[$i]->list->indent"); + is($elems->[$i]->bullet, "1.", "item[$i]->bullet"); + is($elems->[$i]->parent->type, "O", "item[$i]->list->type"); + + # XXX the rest of 1..14 + }, +); + +done_testing(); diff --git a/t/radio_target.t b/t/radio_target.t new file mode 100644 index 0000000..2c1302e --- /dev/null +++ b/t/radio_target.t @@ -0,0 +1,52 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'radio target basic tests', + filter_elements => 'Org::Element::Link', + doc => <<'_', +target1, nottarget 1 +target 2, nottarget 2 + +not target +2 + +not +target + +<<>> <<>> +<<>> + +target1 + +[[normal link]] +_ + num => 3 +1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is($elems->[0]->link, "target1" , "link[0]"); + is($elems->[1]->link, "target 2", "link[1]"); + is($elems->[2]->link, "target1" , "link[2]"); + + ok( $elems->[0]->from_radio_target, "from_radio_target[0]"); + ok( $elems->[1]->from_radio_target, "from_radio_target[1]"); + ok( $elems->[2]->from_radio_target, "from_radio_target[2]"); + ok(!$elems->[3]->from_radio_target, "from_radio_target[3]"); + }, +); + +done_testing(); + diff --git a/t/regression-rt68443.t b/t/regression-rt68443.t new file mode 100644 index 0000000..e2e9c2a --- /dev/null +++ b/t/regression-rt68443.t @@ -0,0 +1,27 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'regression test RT#68443', + filter_elements => 'Org::Element::Table', + doc => <<'_', +* test + | some text in a table | column | + |----------------------+--------| + | | | + something outside a table +_ + num => 1, +); + +done_testing(); diff --git a/t/release-pod-coverage.t b/t/release-pod-coverage.t new file mode 100644 index 0000000..3a81849 --- /dev/null +++ b/t/release-pod-coverage.t @@ -0,0 +1,21 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +use Test::More; + +eval "use Test::Pod::Coverage 1.08"; +plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" + if $@; + +eval "use Pod::Coverage::TrustPod"; +plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" + if $@; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/t/release-pod-syntax.t b/t/release-pod-syntax.t new file mode 100644 index 0000000..d46a955 --- /dev/null +++ b/t/release-pod-syntax.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + +use Test::More; + +eval "use Test::Pod 1.41"; +plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; + +all_pod_files_ok(); diff --git a/t/setting-todo.t b/t/setting-todo.t new file mode 100644 index 0000000..e9c2411 --- /dev/null +++ b/t/setting-todo.t @@ -0,0 +1,53 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +my $NUM_TEST_ITEMS = 4+3+3; + +test_parse( + parse_file_args => ["t/data/custom_todo_kw.org"], + name => 'setting: TODO', + filter_elements => 'Org::Element::Headline', + num => 3 + $NUM_TEST_ITEMS, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + my $num_test_items = 0; + + for my $el (@$elems) { + my $title = $el->title->as_string; + my $re = qr/(?: (?:([A-Z]+)=([^;]*)) (?:;\s|\z) )/x; + my $h = $el->as_string; $h =~ s/\R.*//s; + #diag "heading='$h', ". + # "is_todo=".($el->is_todo//0).", is_done=".($el->is_done//0); + next unless $title =~ /$re/; + $num_test_items++; + my %v; + while ($title =~ s/$re//) { $v{$1} = $2 } + #diag explain \%v; + if ($v{RES} =~ /todo/) { + ok( $el->is_todo, "#$num_test_items is a todo ($v{NOTE})"); + } else { + ok(!$el->is_todo, "#$num_test_items not a todo ($v{NOTE})"); + } + if ($v{RES} =~ /done/) { + ok( $el->is_done, "#$num_test_items is a done ($v{NOTE})"); + } else { + ok(!$el->is_done, "#$num_test_items not a done ($v{NOTE})"); + } + } + + is($num_test_items, $NUM_TEST_ITEMS, "num_test_items"); + }, +); + +done_testing(); diff --git a/t/setting.t b/t/setting.t new file mode 100644 index 0000000..1cde9e8 --- /dev/null +++ b/t/setting.t @@ -0,0 +1,155 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'non-setting (missing +)', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#TODO: A B | C +_ + num => 0, +); + +test_parse( + name => 'non-setting (not on first column)', + filter_elements => 'Org::Element::Setting', + doc => <<'_', + #+TODO: A B | C +_ + num => 0, +); + +test_parse( + name => 'syntax error (missing colon, becomes comment)', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+TODO A B | C +_ + dies => 0, + num => 0, +); + +test_parse( + name => 'unknown setting', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+FOO: bar +_ + dies => 1, +); + +test_parse( + name => 'FILETAGS: argument syntax error', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+FILETAGS: a: +_ + dies => 1, +); + +test_parse( + name => 'FILETAGS: basic tests', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+FILETAGS: :tag1:tag2:tag3: +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is($elems->[0]->name, "FILETAGS", "name"); + is($elems->[0]->args->[0], ":tag1:tag2:tag3:", "args[0]"); + }, +); + +test_parse( + name => 'PRIORITIES: basic tests', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+PRIORITIES: A1 A2 B1 B2 C1 C2 +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is($elems->[0]->name, "PRIORITIES", "name"); + is_deeply($elems->[0]->args, [qw/A1 A2 B1 B2 C1 C2/], + "args"); + is_deeply($doc->priorities, [qw/A1 A2 B1 B2 C1 C2/], + "document's priorities attribute"); + }, +); + +test_parse( + name => 'DRAWERS: basic tests', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+DRAWERS: D1 D2 +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is($elems->[0]->name, "DRAWERS", "name"); + ok("D1" ~~ @{$doc->drawer_names}, + "D1 added to list of known drawers"); + ok("D2" ~~ @{$doc->drawer_names}, + "D2 added to list of known drawers"); + ok("CLOCK" ~~ @{$doc->drawer_names}, + "default drawers still known"); + }, +); + +test_parse( + name => 'indentable_elements (not indentable)', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+TODO: A | B C + #+TODO: D E | F +_ + num => 1, +); +test_parse( + name => 'indentable_elements (not indentable, test text)', + filter_elements => 'Org::Element::Text', + doc => <<'_', +#+TODO: A | B C + #+TODO: D E | F +_ + num => 1, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + is($elems->[0]->as_string, " #+TODO: D E | F\n", "text"); + }, +); + +test_parse( + name => 'indentable_elements (indentable)', + filter_elements => 'Org::Element::Setting', + doc => <<'_', +#+TBLFM: @2$1=@1$1 + #+tblfm: @3$1=@1$1 +_ + num => 2, + test_after_parse => sub { + my (%args) = @_; + my $elems = $args{elements}; + is($elems->[1]->indent, " ", "indent attribute"); + }, +); + +done_testing(); diff --git a/t/table.t b/t/table.t new file mode 100644 index 0000000..434b364 --- /dev/null +++ b/t/table.t @@ -0,0 +1,78 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'non-table (missing extra character)', + filter_elements => 'Org::Element::Table', + doc => <<'_', +| +_ + num => 0, +); + +test_parse( + name => 'table basic tests', + filter_elements => 'Org::Element::Table', + doc => <<'_', +#+CAPTION: test caption +#+LABEL: tbl:test +| a | b | c | +|---+-----+---| +| 1 | | 2 | +| 3 | abc | 4 | +| one <2011-03-17 > three +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my $t = $elems->[0]; + my ($r1, $r2, $r3, $r4, $r5) = @{ $t->children }; + isa_ok($r1, "Org::Element::TableRow"); + isa_ok($r2, "Org::Element::TableVLine"); + isa_ok($r3, "Org::Element::TableRow"); + isa_ok($r4, "Org::Element::TableRow"); + + my $c1a = $r1->children->[0]; + isa_ok($c1a, "Org::Element::TableCell"); + isa_ok($c1a->children->[0], "Org::Element::Text"); + + is($c1a->as_string, "a", "first cell's as_string"); + is($r1->as_string, "|a|b|c\n", "first row's as_string"); + + # test inline elements inside cell + my $c5a = $r5->children->[0]; + isa_ok($c5a->children->[0], "Org::Element::Text"); + isa_ok($c5a->children->[1], "Org::Element::Timestamp"); + isa_ok($c5a->children->[2], "Org::Element::Text"); + + is($t->row_count, 4, "row_count() method"); + is($t->column_count, 3, "column_count() method"); + isa_ok($t->rows->[0], "Org::Element::TableRow"); + isa_ok($t->rows->[0]->cells->[0], 'Org::Element::TableCell'); + + is_deeply($r1->as_array, ["a", "b", "c"], "row's as_array() method") + or diag explain $r1->as_array; + is_deeply($t->as_aoa, + [["a", "b", "c"], + [1, '', 2], + [3, "abc", 4], + ["one <2011-03-17 Thu> three"]], + "table's as_aoa() method") + or diag explain $t->as_aoa; + }, +); + +done_testing(); + diff --git a/t/testlib.pl b/t/testlib.pl new file mode 100644 index 0000000..f43bb45 --- /dev/null +++ b/t/testlib.pl @@ -0,0 +1,67 @@ +#!perl -T + +use 5.010; +use strict; +use warnings; + +use Org::Dump; + +sub test_parse { + my %args = @_; + + my $fe = $args{filter_elements}; + + subtest $args{name} => sub { + my $orgp = Org::Parser->new(); + my $res; + eval { + if ($args{doc}) { + $res = $orgp->parse($args{doc}, $args{parser_opts}); + } elsif ($args{parse_args}) { + $res = $orgp->parse(@{ $args{parse_args} }); + } elsif ($args{parse_file_args}) { + $res = $orgp->parse_file(@{ $args{parse_file_args} }); + } else { + die "Either doc/parse_args/parse_file_args must be specified"; + } + }; + my $eval_err = $@; + + if ($args{dies}) { + ok($eval_err, "dies") or diag(Org::Dump::dump_element($res)); + return; + } else { + ok(!$eval_err, "doesnt die") or diag("died with msg $eval_err"); + } + + my @elems; + $res->walk( + sub { + my ($el) = @_; + my $eltype = ref($el); + my $fetype = ref($fe); + if ($fetype eq 'Regexp') { + return unless $eltype =~ $args{filter_elements}; + } elsif ($fetype eq 'CODE') { + return unless $fe->($el); + } elsif (!$fetype) { + return unless $eltype eq $args{filter_elements}; + } else { + die "BUG: filter_elements cannot be a $fetype"; + } + push @elems, $el; + } + ) if $fe; + + if (defined $args{num}) { + is(scalar(@elems), $args{num}, "num=$args{num}"); + } + + if ($args{test_after_parse}) { + $args{test_after_parse}->(parser=>$orgp, result=>$res, + elements=>\@elems); + } + }; +} + +1; diff --git a/t/text.t b/t/text.t new file mode 100644 index 0000000..8561bcc --- /dev/null +++ b/t/text.t @@ -0,0 +1,110 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'text basic tests', + filter_elements => 'Org::Element::Text', + doc => <<'_', +* just some heading, not bold* +0) this is normal. +*1) this /is/ bold.* +/3) this *is* italic./ +_5) this is underline._ ++7) this is strike-through.+ +=9) this is code.= +~11) this is verbatim.~ + +unparsed: *ends with spaces *, / start with space/, =no ending. no starting.~ +_ + num => 13, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + #diag(explain [map {$_->as_string} @$elems]); + ok(!$elems->[ 0]->style, "elem 0 normal"); + is( $elems->[ 1]->style, "B", "elem 2 bold"); + is( $elems->[ 3]->style, "I", "elem 2 italic"); + is( $elems->[ 5]->style, "U", "elem 2 underline"); + is( $elems->[ 7]->style, "S", "elem 2 strike-through"); + is( $elems->[ 9]->style, "C", "elem 2 code"); + is( $elems->[11]->style, "V", "elem 2 verbatim"); + ok(!$elems->[12]->style, "elem 13 normal"); + + is( $elems->[ 0]->as_string, "0) this is normal.\n", + "normal as_string"); + is( $elems->[ 1]->as_string, "*1) this /is/ bold.*", + "bold as_string"); + is( $elems->[ 3]->as_string, "/3) this *is* italic./", + "italic as string"); + is( $elems->[ 5]->as_string, "_5) this is underline._", + "underline as_string"); + is( $elems->[ 7]->as_string, "+7) this is strike-through.+", + "strike-through as_string"); + is( $elems->[ 9]->as_string, "=9) this is code.=", + "code as_string"); + is( $elems->[11]->as_string, "~11) this is verbatim.~", + "verbatim as_string"); + }, +); + +# emacs only allows a single newline in markup +test_parse( + name => 'max newlines', + filter_elements => 'Org::Element::Text', + doc => <<'_', +=this is +still code= + +=this is +no longer +code= +_ + num => 2, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + #diag(explain [map {$_->as_string} @$elems]); + is( $elems->[0]->style, "C", "elem 0 code"); + ok(!$elems->[1]->style, "elem 1 normal"); + + is( $elems->[0]->as_string, "=this is\nstill code=", + "elem 0 as_string"); + is( $elems->[1]->as_string, "\n\n=this is\nno longer\ncode=\n", + "elem 1 as_string"); + }, +); + +# markup can contain links, even *[[link][description with * in it]]*. also +# timestamp, etc. +test_parse( + name => 'link inside markup', + filter_elements => 'Org::Element::Text', + doc => <<'_', +*bolded [[link]]* +_ + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is($elems->[0]->style, "B", "elem 0 bold"); + is($elems->[0]->children->[0]->as_string, "bolded ", + "bolded text"); + is(ref($elems->[0]->children->[1]), "Org::Element::Link", + "link inside bolded"); + }, +); + +done_testing(); + diff --git a/t/timerange.t b/t/timerange.t new file mode 100644 index 0000000..a0967c3 --- /dev/null +++ b/t/timerange.t @@ -0,0 +1,65 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use DateTime; +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'timerange basic tests', + filter_elements => sub { + $_[0]->isa('Org::Element::TimeRange') }, + doc => <<'_', +* TODO active timeranges +<2011-03-23 Wed>--<2011-03-24 Thu> +<2011-03-23 >--<2011-03-24 > +<2011-03-23 Wed 01:23>--<2011-03-23 Wed 03:59> + +* inactive timeranges +[2011-03-23 Wed]--[2011-03-24 Thu] +[2011-03-23 ]--[2011-03-24 ] +[2011-03-23 Wed 01:23]--[2011-03-23 Wed 03:59] + +* non-timeranges +[2011-03-22 ]--<2011-03-23 > # mixed active & inactive timestamp +<2011-03-22 >--[2011-03-23 ] # mixed active & inactive timestamp + +_ + num => 6, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + ok( $elems->[0]->ts1->is_active, "tr[0] is_active"); + ok(!$elems->[3]->ts1->is_active, "tr[3] !is_active"); + }, +); + +test_parse( + name => 'event duration not allowed in timerange', + filter_elements => sub { + $_[0]->isa('Org::Element::TimeRange') }, + doc => <<'_', +<2011-03-23 Wed 11:28-12:00>--<2011-03-24 Thu> +_ + dies => 1, +); + +test_parse( + name => 'repeater not allowed in timerange', + filter_elements => sub { + $_[0]->isa('Org::Element::TimeRange') }, + doc => <<'_', +<2011-03-23 Wed +1w>--<2011-03-24 Thu> +_ + dies => 1, +); + +done_testing(); diff --git a/t/timestamp.t b/t/timestamp.t new file mode 100644 index 0000000..ab12cb5 --- /dev/null +++ b/t/timestamp.t @@ -0,0 +1,134 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use DateTime; +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +test_parse( + name => 'timestamp basic tests', + filter_elements => sub { + $_[0]->isa('Org::Element::Timestamp') }, + doc => <<'_', +* TODO active timestamps + SCHEDULED: <2011-03-16 Wed> + TEST: <2011-03-16 > + TEST: <2011-03-16 Wed 01:23> + nontimestamps: <2011-03-23> + +* inactive timestamps + - [2011-03-23 Wed] + - [2011-03-23 ] + - [2011-03-23 Wed 01:23] + - nontimestamps: [2011-03-23] + +* additional tests + - <2012-01-11 Wed > # space after dow allowed + - [2012-01-11 ] [2012-01-11 Wed ] # multiple spaces allowed +_ + num => 9, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is(DateTime->compare(DateTime->new(year=>2011, month=>3, day=>16), + $elems->[0]->datetime), 0, "ts[0] datetime") + or diag("datetime=".$elems->[0]->datetime); + + is( $elems->[0]->as_string, "<2011-03-16 Wed>", "ts[0] as_string"); + is( $elems->[1]->as_string, "<2011-03-16 Wed>", "ts[1] as_string"); + is( $elems->[2]->as_string, "<2011-03-16 Wed 01:23>", + "ts[2] as_string"); + is( $elems->[3]->as_string, "[2011-03-23 Wed]", + "ts[2] as_string"); + + ok( $elems->[0]->is_active, "ts[0] is_active"); + ok(!$elems->[3]->is_active, "ts[3] !is_active"); + + # additional + is( $elems->[6]->as_string, "<2012-01-11 Wed>", "ts[6] as_string"); + is( $elems->[7]->as_string, "[2012-01-11 Wed]", "ts[7] as_string"); + is( $elems->[8]->as_string, "[2012-01-11 Wed]", "ts[8] as_string"); + }, +); + +test_parse( + name => 'event duration', + filter_elements => sub { + $_[0]->isa('Org::Element::Timestamp') }, + doc => <<'_', +[2011-03-23 Wed 10:12-11:23] +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my $ts = $elems->[0]; + is(DateTime->compare(DateTime->new(year=>2011, month=>3, day=>23, + hour=>10, minute=>12), + $ts->datetime), 0, "datetime") + or diag("datetime=".$ts->datetime); + is($elems->[0]->event_duration, 1*3600+11*60, "event_duration"); + }, +); + +test_parse( + name => 'repeater & warning period', + filter_elements => sub { + $_[0]->isa('Org::Element::Timestamp') }, + doc => <<'_', +[2011-03-23 Wed 10:12 +1d] +[2011-03-23 Wed 10:12-11:23 +2w] +[2011-03-23 Wed +3m] +[2011-03-23 Wed +4y] +<2011-05-25 Wed ++5m> +<2011-05-25 Wed .+6m> +<2011-05-25 Wed +17.1m -13.2d> +_ + num => 7, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + is($elems->[0]->_repeater, "+1d", "[0] _repeater"); + is($elems->[1]->_repeater, "+2w", "[1] _repeater"); + is($elems->[2]->_repeater, "+3m", "[2] _repeater"); + is($elems->[3]->_repeater, "+4y", "[3] _repeater"); + is($elems->[4]->_repeater, "++5m", "[4] _repeater"); + is($elems->[5]->_repeater, ".+6m", "[5] _repeater"); + is($elems->[6]->_repeater, "+17.1m", "[6] _repeater"); + is($elems->[6]->_warning_period, "-13.2d", "[6] _warning_period"); + + ok($elems->[0]->recurrence->isa('DateTime::Set::ICal'), + "[0] recurrence"); + }, +); + +test_parse( + name => 'time_zone', + filter_elements => sub { + $_[0]->isa('Org::Element::Timestamp') }, + parser_opts => {time_zone => 'Asia/Jakarta'}, + doc => <<'_', +[2011-09-23 Wed] +_ + num => 1, + test_after_parse => sub { + my %args = @_; + my $doc = $args{result}; + my $elems = $args{elements}; + my $dt = $elems->[0]->datetime; + my $tz = $dt->time_zone; + is($tz->short_name_for_datetime($dt), "WIT", "time zone's short name"); + }, +); + +done_testing(); diff --git a/t/various.t b/t/various.t new file mode 100644 index 0000000..b84f4db --- /dev/null +++ b/t/various.t @@ -0,0 +1,40 @@ +#!perl + +use 5.010; +use strict; +use warnings; + +use FindBin '$Bin'; +use lib $Bin, "$Bin/t"; + +use Org::Parser; +use Test::More 0.96; +require "testlib.pl"; + +my $NUM_TEST_ITEMS = 4+3+3; + +test_parse( + parse_file_args => ["t/data/various.org"], + name => 'various', + test_after_parse => sub { + my (%args) = @_; + my $doc = $args{result}; + + my $num_elems; + my %num_elems; + $doc->walk( + sub { + my $elem = shift; + my $class = ref($elem); + $num_elems{$class}++; + $num_elems++; + } + ); + + is($num_elems, 27, 'num_elems'); + is($num_elems{"Org::Element::Headline"}, 10, 'num_elems(Headline)'); + + }, +); + +done_testing(); diff --git a/todo.org b/todo.org new file mode 100644 index 0000000..487d282 --- /dev/null +++ b/todo.org @@ -0,0 +1,139 @@ +* parser +** TODO add line number information +perhaps _linenum_start and _linenum_end attributes to signify the starting and +ending line numbers of current element. so the parser can report: + +: syntax error in table (lines XX-YY): invalid line in table 'blah' + +and then instead of: + +: die "syntax error in table ..." + +the elements do something like this instead to report error: + +: $doc->_croak("invalid line in table"); + +and the document will provide the additional line number and element +information. + +** TODO parse horizontal rules +from the manual: "A line consisting of only dashes, and at least 5 of them, will +be exported as a horizzontal line (‘
’ in HTML and \hrule in LaTeX)." + +** TODO [2012-04-14 Sat] performance: lazy parsing +we can increase performance by doing lazy parsing. one of the heaviest parts is +parsing the text elements and constructing all the text element objects. not all +text is required in all cases. one of my most used application of org::parser is +app::orgutils's list-org-todos. it only needs a list of headlines (block +elements). we can skip parsing @text and all the text elements (_add_text() and +_add_text_container()) for example putting those in Org::RawText first. + +we could then add walk_block() which only walks block elements. +list-org-{headlines,todos} can utilize this instead of walk(). + +children() (and headline's title(), etc) should detect Org::RawText and parse it +into one or more elements, so we only parse the unparsed text when needed. + +i'd reckon, skimming at profiler's result for parsing my addressbook and todo +list, this could provide about 50% speedup or more, depending on how much +skipping you do. if you only look at headlines or other block elements, the +speedup will be more pronounced. +* Element::Base +** TODO set_property() +- should create a properties drawer if necessary +* table +** TODO caption(), label(), etc +Get it from settings: + +: #+CAPTION: A long table +: #+LABEL: tbl:long +: |...|...| +: |...|...| + +note: the setting can be interspersed with other lines/elements, they will be +apply to the next thing (table) that wants it, e.g.: + +: #+CAPTION: A long table +: some text +: #+LABEL: tbl:long +: some more text +: |...|...| +: |...|...| + +** TODO column group (manual: 3.3) +probably create Element::TableColGroup which is a special row that contains +column group instruction. or we can just assume it's a normal row and only +format() needs to worry about this (i prefer the latter). +* footnote +* link +* target +* radio target +* timestamp & time range +** what's the difference between SCHEDULED and DEADLINE timestamp? +** TODO parse sexp entries? +e.g. + +: ** Class 7:00pm-9:00pm +: <%%(and (= 1 (calendar-day-of-week date)) (diary-block 2 16 2009 4 20 2009))> + +: * Monthly meeting +: <%%(diary-float t 3 3)> + +* plain lists (ordered, unordered, description) +* headline +** TODO Parse headline percentages +** TODO next_todo_state() & prev_todo_state() +return undef if .document is undef. +** TODO cycle_todo_state($reverse // 0) +** TODO promoto_subtree() & demote_subtree() +* drawer & properties +** TODO check valid values of property (foo_ALL) +** TODO fix parsing of property values +need clarification first + +: :PROPERTY: +: :birthday: (5 7 1990) +: :END: + +* setting +** TODO [low] differentiate between TYP_TODO and TODO/SEQ_TODO +"TODO and SEQ_TODO are the same. TYP_TODO is slightly different in operation. +When you press C-c C-t in a line with the keyword defined by TYP_TODO, the task +will immediately switch to DONE, instead of to the next state in the sequence. I +do believe the manual explains this quite well, but I don't believe many people +use this." -- carsten + +this is probably useful if we already have next_todo_state() et al. We'll need +to note which todo keywords belong to TYP_TODO. +** TODO process includes (#+INCLUDE) + +** TODO parse buffer-wide header arguments (#+BABEL, 14.8.1) +** TODO parse link abbreviation (#+LINK) +into document's .link_abbrevs() +** TODO check tags in document against TAGS +"TAGS defines tags that will be used in the buffer and defines fast keyboard +shortcuts for them. Though you are allowed to also use tags that are not in tis +list." -- carsten + +we can introduce a strict mode, for example, where all tags must belong to the +list specified in TAGS. +** TODO TAGS/FILETAGS: parse keyboard shortcuts + #+TAGS: OFFICE(o) COMPUTER(c) HOME(h) PROJECT(p) READING(r) DVD(d) +the key should be discarded when checking for known tags + +* block +** TODO parse dynamic blocks +see org-mode manual on dynamic blocks. + +basically it's just blocks with a slightly different syntax and :param value as +args: + +: #BEGIN: dynblockname :param1 value1 :param2 value2 +: #END: + +* macro +** TODO parse macro +manual section 11.6 Macro replacement + +although the parser can also choose to ignore this and let the export handle the +parsing.