File Coverage

blib/lib/App/VOJournal/VOTL.pm
Criterion Covered Total %
statement 100 130 76.9
branch 27 42 64.2
condition 3 6 50.0
subroutine 18 22 81.8
pod 10 10 100.0
total 158 210 75.2


line stmt bran cond sub pod time code
1             package App::VOJournal::VOTL;
2             #
3             # vim: set sw=4 ts=4 tw=76 et ai si:
4             #
5             # Author Mathias Weidner
6             # Version 0.1
7             # Copyright (C) 2015 user
8             # Modified On 2015-05-15 22:18
9             # Created 2015-05-15 22:18
10             #
11 2     2   68151 use strict;
  2         16  
  2         59  
12 2     2   11 use warnings;
  2         4  
  2         54  
13              
14             =head1 NAME
15              
16             App::VOJournal::VOTL - deal with vimoutliner files
17              
18             =head1 VERSION
19              
20             Version v0.4.6
21              
22             =cut
23              
24 2     2   1015 use version; our $VERSION = qv('v0.4.6');
  2         4104  
  2         13  
25              
26             =head1 SYNOPSIS
27              
28             use App::VOJournal::VOTL;
29              
30             my $votl = App::VOJournal::VOTL->new();
31              
32             $votl->fetch_line($pos);
33             $votl->insert_line($pos,$line);
34              
35             $votl->read_file($infilename);
36              
37             $votl->write_file($outfilename);
38             $votl->write_file($outfilename, \&filter);
39              
40             $votl->write_file_no_checked_boxes($outfilename);
41             $votl->write_file_unchecked_boxes($outfilename);
42              
43             =head1 SUBROUTINES/METHODS
44              
45             =head2 new
46              
47             Creates a new object.
48              
49             my $votl = App::VOJournal::VOTL->new();
50              
51             =cut
52              
53             sub new
54             {
55 3     3 1 1188 my $class = shift;
56 3         6 my $arg = shift;
57 3         5 my $self = {};
58              
59 3         10 $self->{objects} = [];
60              
61 3         7 bless($self, $class);
62 3         20 return $self;
63             }
64              
65             =head2 fetch_line
66              
67             $votl->fetch_line( $pos );
68              
69             Fetches the value of the object at position C<$pos>. That means the line as it
70             would appear in the Vimoutliner file.
71              
72             The available positions start at 0 and at 1 before the number of objects.
73              
74             If C<$pos> is outside the available positions the function returns nothing.
75              
76             At the moment you can only retrieve the objcects in the top level.
77              
78             =cut
79              
80             sub fetch_line {
81 5     5 1 607 my ($self, $pos) = @_;
82 5         7 my $noobjs = $#{$self->{objects}};
  5         11  
83 5 100       16 my $position = (0 > $pos) ? $noobjs
    100          
84             : ($pos > $noobjs) ? -1
85             : $pos;
86 5 100       14 if (-1 == $position) {
87 3         13 return;
88             }
89 2         7 return $self->{objects}->[$position]->{value};
90             } # fetch_line()
91              
92             =head2 delete_line
93              
94             $votl->delete_line($pos);
95              
96             Deletes an object from the Vimoutliner file. That means the line itself and
97             all immediately following lines that are more indented.
98              
99             At the moment you can only delete objects in the top level.
100              
101             =cut
102              
103             sub delete_line {
104 1     1 1 292 my ($self, $pos) = @_;
105 1         3 my $objects = [];
106 1         3 my $noobjs = $#{$self->{objects}};
  1         3  
107 1 50       6 my $position = (0 > $pos) ? $noobjs
    50          
108             : ($pos > $noobjs) ? -1
109             : $pos;
110 1 50       4 if (-1 == $position) {
111 0         0 return;
112             }
113 1         4 while ($position) {
114 0         0 push @$objects, shift @{$self->{objects}};
  0         0  
115 0         0 $position--;
116             }
117 1         2 shift @{$self->{objects}};
  1         2  
118 1         3 push @$objects, @{$self->{objects}};
  1         3  
119 1         4 $self->{objects} = $objects;
120             } # delete_line()
121              
122             =head2 insert_line
123              
124             Inserts a line into a vimoutliner data structure.
125              
126             $votl->insert_line( $pos, $line );
127              
128             =over 4
129              
130             =item C<$pos>
131              
132             determines the position where the object shall be inserted.
133              
134             This could be a number telling the position:
135              
136             =over 4
137              
138             =item B<-1>
139              
140             means at the last position, i.e. after the last already existing element.
141              
142             =item B<0>
143              
144             means at position 0, i.e. before the first already existing element.
145              
146             =item B
147              
148             means at that position.
149             All already existing objects at that and the following positions will be
150             shifted to the next position.
151              
152             If the argument C<$pos> exceeds the number of already existing objects, the
153             object is inserted immediately following the last already existing object.
154              
155             =back
156              
157             At the moment all lines are inserted at the top level.
158              
159             =item C<$line>
160              
161             This may be a string which is inserted as is.
162              
163             =back
164              
165             =cut
166              
167             sub insert_line {
168 1     1 1 4 my ($self, $pos, $line) = @_;
169 1         3 my $objects = [];
170 1         2 my $noobjs = 1 + $#{$self->{objects}};
  1         3  
171 1 50       5 my $position = (0 > $pos) ? $noobjs
    50          
172             : ($pos > $noobjs) ? $noobjs
173             : $pos;
174 1         4 while ($position) {
175 0         0 push @$objects, shift @{$self->{objects}};
  0         0  
176 0         0 $position--;
177             }
178 1         3 push @$objects, {value => $line}, @{$self->{objects}};
  1         4  
179 1         4 $self->{objects} = $objects;
180             } # insert_line()
181              
182             =head2 read_file
183              
184             Reads a vimoutliner file.
185              
186             $votl->read_file( $filename );
187              
188             sub filter { ... }
189            
190             $votl->read_file( $filename, \&filter );
191              
192             C<$filename> is the name of the file read.
193              
194             It is possible to give a reference to a filter function that decides, which
195             objects / lines to read. This filter function is called back with the content
196             of the current line (after the indentation) and the depth of indentation as
197             arguments. If you need to manage some state you can use closures like this:
198              
199             my $in_checked_box = 0;
200             my $cbl = 0;
201              
202             my $filter = sub {
203             my ($object,$indent) = @_;
204             if ($in_checked_box && $indent > $cbl) {
205             return 0;
206             }
207             elsif (_checked_box($object)) {
208             $in_checked_box = 1;
209             $cbl = $indent;
210             return 0;
211             }
212             else {
213             $in_checked_box = 0;
214             return 1;
215             }
216             };
217              
218             $votl->read_file( $filename, $filter );
219              
220             =cut
221              
222             sub read_file {
223 2     2 1 9 my ($self,$filename,$filter) = @_;
224              
225 2 50       87 if (open my $input, '<', $filename) {
226 2         13 $self->{objects} = [];
227 2         77 while (<$input>) {
228 36 50       152 if (/^(\t*)(.*)$/) {
229 36         131 $self->_add_something($1, {
230             children => [],
231             value => $2
232             }, $filter);
233             }
234             else {
235 0         0 die "unknown line: $_";
236             }
237             }
238 2         24 close $input;
239 2         6 return 1 + $#{$self->{objects}};
  2         36  
240             }
241 0         0 return;
242             } # read_file()
243              
244             =head2 read_file_no_checked_boxes
245              
246             This is a convenience function that reads all lines except checked boxes
247             (lines starting with C<[X]>).
248              
249             $votl->read_file_no_checked_boxes( $filename );
250              
251             =cut
252              
253             sub read_file_no_checked_boxes {
254 1     1 1 7 my ($self,$filename) = @_;
255 1         2 my $in_checked_box = 0;
256 1         2 my $cbl = 0;
257             my $filter = sub {
258 18     18   28 my ($object,$indent) = @_;
259 18 100 100     54 if ($in_checked_box && $indent > $cbl) {
    100          
260 4         20 return 0;
261             }
262             elsif (_checked_box($object)) {
263 3         5 $in_checked_box = 1;
264 3         4 $cbl = $indent;
265 3         17 return 0;
266             }
267             else {
268 11         13 $in_checked_box = 0;
269 11         31 return 1;
270             }
271 1         6 };
272 1         4 $self->read_file( $filename, $filter );
273             } # read_file_no_checked_boxes()
274              
275             =head2 read_file_unchecked_boxes
276              
277             This is a convenience function that reads all lines with unchecked boxes
278             (lines starting with C<[_]>).
279              
280             $votl->read_file_unchecked_boxes( $filename );
281              
282             =cut
283              
284             sub read_file_unchecked_boxes {
285 0     0 1 0 my ($self,$filename) = @_;
286 0         0 my $unchecked_box = 0;
287 0         0 my $cbl = 0;
288             my $filter = sub {
289 0     0   0 my ($object,$indent) = @_;
290 0 0 0     0 if ($unchecked_box && $indent > $cbl) {
    0          
291 0         0 return 1;
292             }
293             elsif (_unchecked_box($object)) {
294 0         0 $unchecked_box = 1;
295 0         0 $cbl = $indent;
296 0         0 return 1;
297             }
298             else {
299 0         0 $unchecked_box = 0;
300 0         0 return 0;
301             }
302 0         0 };
303 0         0 $self->read_file( $filename, $filter );
304             } # read_file_unchecked_boxes()
305              
306             =head2 write_file
307              
308             Writes a vimoutliner file.
309              
310             $votl->write_file( $filename );
311              
312             sub filter { ... }
313              
314             $votl->write_file( $filename, \&filter);
315              
316             It is possible to give a reference to a filter function that decides, which
317             objects to write. This filter function is called back with the content
318             of the current line and the depth of indentation as arguments.
319             If you need to manage some state you can use closures as shown with the
320             C function.
321              
322             =cut
323              
324             sub write_file {
325 3     3 1 12 my ($self,$filename,$filter) = @_;
326              
327 3 50       612 if (open my $output, '>', $filename) {
328 3         10 foreach my $object (@{$self->{objects}}) {
  3         13  
329 3         9 _write_object($object,0,$output,$filter);
330             }
331 3         181 close $output;
332             }
333             } # write_file()
334              
335             =head2 write_file_no_checked_boxes
336              
337             Writes a vimoutliner file that contains no checked boxes.
338              
339             $votl->write_file_no_checked_boxes( $filename );
340              
341             This is a convenience function using C and a predifined
342             filter.
343              
344             =cut
345              
346             sub write_file_no_checked_boxes {
347 1     1 1 5 my ($self,$filename) = @_;
348             my $filter = sub {
349 14     14   23 my ($object) = @_;
350 14         23 return ! _checked_box($object);
351 1         7 };
352 1         4 $self->write_file( $filename, $filter );
353             } # write_file_no_checked_boxes()
354              
355             =head2 write_file_unchecked_boxes
356              
357             Writes a vimoutliner file that only consists of unchecked boxes at level
358             zero and their descendants.
359              
360             $votl->write_file_unchecked_boxes( $filename );
361              
362             This is a convenience function using C and a predifined
363             filter.
364              
365             =cut
366              
367             sub write_file_unchecked_boxes {
368 0     0 1 0 my ($self,$filename) = @_;
369             my $filter = sub {
370 0     0   0 my ($object,$indent) = @_;
371 0 0       0 return $indent ? 1 : _unchecked_box($object);
372 0         0 };
373 0         0 $self->write_file( $filename, $filter );
374             } # write_file_unchecked_boxes()
375              
376             sub _add_something {
377 36     36   95 my ($self,$tabs,$newobject,$filter) = @_;
378 36         60 my $indent = length $tabs;
379 36 100       65 if (defined $filter) {
380 18 100       29 return unless ($filter->($newobject,$indent));
381             }
382 29         50 my $objects = $self->_descend_objects($indent);
383 29         138 push @$objects, $newobject;
384             } # _add_something()
385              
386             sub _checked_box {
387 30     30   46 my ($object) = @_;
388              
389 30         103 return ($object->{value} =~ /^\[X\]/);
390             } # _checked_box()
391              
392             sub _descend_objects {
393 29     29   49 my ($self,$indent) = @_;
394 29         39 my $objects = $self->{objects};
395              
396 29         56 while (0 < $indent) {
397 42 50       88 if (0 > $#$objects) {
398 0         0 my $newobject = {
399             children => [],
400             };
401 0         0 push @$objects, $newobject;
402 0         0 $objects = $newobject->{children};
403             }
404             else {
405 42         64 $objects = $objects->[$#$objects]->{children};
406             }
407 42         80 $indent--;
408             }
409 29         48 return $objects;
410             } # _descend_objects()
411              
412             sub _unchecked_box {
413 2     2   6 my ($object) = @_;
414              
415 2         12 return ($object->{value} =~ /^\[_\]/);
416             } # _unchecked_box()
417              
418             sub _write_object {
419 43     43   104 my ($object,$indent,$outfh, $filter) = @_;
420              
421 43 100       75 if (defined $filter) {
422 14 100       25 return unless ($filter->($object,$indent));
423             }
424 40         108 print $outfh "\t" x $indent, $object->{value}, "\n";
425              
426 40         49 foreach my $co (@{$object->{children}}) {
  40         92  
427 40         70 _write_object($co,$indent + 1,$outfh,$filter);
428             }
429             } # _write_object()
430              
431             1;
432             # __END__
433              
434             =head1 FORMAT OF VIMOUTLINER FILES
435              
436             Vimoutliner files are text files with a hierarchical structure.
437              
438             The hierarchical structure is characterized by the number of tabulator
439             signs (0x09) at the beginning of the line.
440              
441             A line can be a simple-heading or an object, depending on the first
442             nontabulator sign of the line.
443              
444             A simple heading starts with any non-whitespace character except
445             C<< : ; | < > >>.
446             A checkbox is a special form of a heading that starts with either
447             C<< [_] >> or C<< [X] >> after the leading tabulator signs.
448             A checkbox may contain a percent sign (C<%>) as a placeholder for
449             the percentage completed.
450             This percent sign must follow the initial C<< [_] >> after a separating
451             whitespace.
452              
453             The following text objects are defined for vimoutliner files:
454              
455             =over 4
456              
457             =item C<:> - body text
458              
459             The text following the C<:> will be wrapped automatically.
460              
461             =item C<;> - preformatted body text
462              
463             This text won't be wrapped automatically.
464              
465             =item C<|> - table
466              
467             The table headings can be marked with C<||>.
468              
469             =item C<< > >> - user defined text.
470              
471             This text will also be wrapped automatically.
472              
473             =item C<< < >> - user defined preformatted text.
474              
475             This text won't be wrapped automatically.
476              
477             =back
478              
479             =head1 AUTHOR
480              
481             Mathias Weidner, C<< >>
482              
483             =head1 BUGS
484              
485             Please report any bugs or feature requests to C, or through
486             the web interface at L. I will be notified, and then you'll
487             automatically be notified of progress on your bug as I make changes.
488              
489             =head1 SUPPORT
490              
491             You can find documentation for this module with the perldoc command.
492              
493             perldoc App::VOJournal::VOTL
494              
495              
496             You can also look for information at:
497              
498             =over 4
499              
500             =item * RT: CPAN's request tracker (report bugs here)
501              
502             L
503              
504             =item * AnnoCPAN: Annotated CPAN documentation
505              
506             L
507              
508             =item * CPAN Ratings
509              
510             L
511              
512             =item * Search CPAN
513              
514             L
515              
516             =back
517              
518              
519             =head1 ACKNOWLEDGEMENTS
520              
521              
522             =head1 LICENSE AND COPYRIGHT
523              
524             Copyright 2015 Mathias Weidner.
525              
526             This program is free software; you can redistribute it and/or modify it
527             under the terms of the the Artistic License (2.0). You may obtain a
528             copy of the full license at:
529              
530             L
531              
532             Any use, modification, and distribution of the Standard or Modified
533             Versions is governed by this Artistic License. By using, modifying or
534             distributing the Package, you accept this license. Do not use, modify,
535             or distribute the Package, if you do not accept this license.
536              
537             If your Modified Version has been derived from a Modified Version made
538             by someone other than you, you are nevertheless required to ensure that
539             your Modified Version complies with the requirements of this license.
540              
541             This license does not grant you the right to use any trademark, service
542             mark, tradename, or logo of the Copyright Holder.
543              
544             This license includes the non-exclusive, worldwide, free-of-charge
545             patent license to make, have made, use, offer to sell, sell, import and
546             otherwise transfer the Package with respect to any patent claims
547             licensable by the Copyright Holder that are necessarily infringed by the
548             Package. If you institute patent litigation (including a cross-claim or
549             counterclaim) against any party alleging that the Package constitutes
550             direct or contributory patent infringement, then this Artistic License
551             to you shall terminate on the date that such litigation is filed.
552              
553             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
554             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
555             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
556             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
557             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
558             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
559             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
560             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
561