File Coverage

blib/lib/Text/Todo.pm
Criterion Covered Total %
statement 199 233 85.4
branch 70 110 63.6
condition 11 21 52.3
subroutine 27 27 100.0
pod 17 17 100.0
total 324 408 79.4


line stmt bran cond sub pod time code
1             package Text::Todo;
2              
3             # $AFresh1: Todo.pm,v 1.26 2010/02/14 06:08:07 andrew Exp $
4              
5 3     3   81646 use warnings;
  3         6  
  3         85  
6 3     3   13 use strict;
  3         3  
  3         67  
7 3     3   11 use Carp;
  3         7  
  3         171  
8              
9 3     3   1434 use Class::Std::Utils;
  3         6806  
  3         16  
10 3     3   1209 use Text::Todo::Entry;
  3         3  
  3         75  
11 3     3   13 use File::Spec;
  3         12  
  3         58  
12              
13 3     3   9 use version; our $VERSION = qv('0.2.2');
  3         3  
  3         9  
14              
15             {
16              
17             my @attr_refs = \(
18             my %path_of,
19              
20             my %list_of,
21             my %loaded_of,
22             my %known_tags_of,
23             );
24              
25             sub new {
26 5     5 1 1752 my ( $class, $options ) = @_;
27              
28 5         15 my $self = bless anon_scalar(), $class;
29 5         25 my $ident = ident($self);
30              
31 5         25 $path_of{$ident} = {
32             todo_dir => undef,
33             todo_file => 'todo.txt',
34             done_file => undef,
35             };
36              
37 5         14 my %tags = (
38             context => q{@},
39             project => q{+},
40             );
41              
42 5 100       12 if ($options) {
43 2 50       6 if ( ref $options eq 'HASH' ) {
44 0         0 foreach my $opt ( keys %{$options} ) {
  0         0  
45 0 0 0     0 if ( exists $path_of{$ident}{$opt} ) {
    0          
46 0         0 $self->_path_to( $opt, $options->{$opt} );
47             }
48             elsif ( $opt eq 'tags'
49             && ref $options->{$opt} eq 'HASH' )
50             {
51 0         0 %tags = ( %tags, %{ $options->{$opt} } );
  0         0  
52             }
53             else {
54              
55             #carp "Invalid option [$opt]";
56             }
57             }
58             }
59             else {
60 2 50       40 if ( -d $options ) {
    50          
61 0         0 $self->_path_to( 'todo_dir', $options );
62             }
63             elsif ( $options =~ /\.txt$/ixms ) {
64 2         5 $self->_path_to( 'todo_file', $options );
65             }
66             else {
67 0         0 carp "Unknown options [$options]";
68             }
69             }
70             }
71              
72 5         10 $known_tags_of{$ident} = \%tags;
73              
74 5         11 my $file = $self->_path_to('todo_file');
75 5 100 66     34 if ( defined $file && -e $file ) {
76 2         10 $self->load();
77             }
78              
79 5         13 return $self;
80             }
81              
82             sub _path_to {
83 36     36   43 my ( $self, $type, $path ) = @_;
84 36         67 my $ident = ident($self);
85              
86 36 50       77 if ( $type eq 'todo_dir' ) {
87 0 0       0 if ($path) {
88 0         0 $path_of{$ident}{$type} = $path;
89             }
90 0         0 return $path_of{$ident}{$type};
91             }
92              
93 36 100       60 if ($path) {
94 14         143 my ( $volume, $directories, $file )
95             = File::Spec->splitpath($path);
96 14         29 $path_of{$ident}{$type} = $file;
97              
98 14 50       19 if ($volume) {
99 0         0 $directories = File::Spec->catdir( $volume, $directories );
100             }
101              
102             # XXX Should we save complete paths to each file, mebbe only if
103             # the dirs are different?
104 14 50       26 if ($directories) {
105 14         24 $path_of{$ident}{todo_dir} = $directories;
106             }
107             }
108              
109 36 50       150 if ( $type =~ /(todo|done|report)_file/xms ) {
110 36 100       612 if ( my ( $pre, $post )
111             = $path_of{$ident}{$type} =~ /^(.*)$1(.*)\.txt$/ixms )
112             {
113 32         48 foreach my $f (qw( todo done report )) {
114 96 100       225 if ( !defined $path_of{$ident}{ $f . '_file' } ) {
115 10         28 $path_of{$ident}{ $f . '_file' }
116             = $pre . $f . $post . '.txt';
117             }
118             }
119             }
120             }
121              
122 36 100       82 if ( defined $path_of{$ident}{todo_dir} ) {
123 32         285 return File::Spec->catfile( $path_of{$ident}{todo_dir},
124             $path_of{$ident}{$type} );
125             }
126              
127 4         8 return;
128             }
129              
130             sub file {
131 29     29 1 1424 my ( $self, $file ) = @_;
132 29         49 my $ident = ident($self);
133              
134 29 100 100     128 if ( defined $file && exists $path_of{$ident}{$file} ) {
135 11         16 $file = $self->_path_to($file);
136             }
137             else {
138 18         27 $file = $self->_path_to( 'todo_file', $file );
139             }
140              
141 29         102 return $file;
142             }
143              
144             sub load {
145 6     6 1 995 my ( $self, $file ) = @_;
146 6         15 my $ident = ident($self);
147              
148 6         12 $loaded_of{$ident} = undef;
149              
150 6         10 $file = $self->file($file);
151              
152 6 50       11 if ( $list_of{$ident} = $self->listfile($file) ) {
153 6         14 $self->known_tags;
154 6         7 $loaded_of{$ident} = $file;
155 6         26 return 1;
156             }
157              
158 0         0 return;
159             }
160              
161             sub listfile {
162 7     7 1 11 my ( $self, $file ) = @_;
163              
164 7         11 $file = $self->file($file);
165              
166 7 50       19 if ( !defined $file ) {
167 0         0 carp q{file can't be found};
168 0         0 return;
169             }
170              
171 7 50       103 if ( !-e $file ) {
172 0         0 carp "file [$file] does not exist";
173 0         0 return;
174             }
175              
176 7         11 my @list;
177 7 50       177 open my $fh, '<', $file or croak "Couldn't open [$file]: $!";
178 7         89 while (<$fh>) {
179 35         152 s/\r?\n$//xms;
180 35         108 push @list, Text::Todo::Entry->new($_);
181             }
182 7 50       49 close $fh or croak "Couldn't close [$file]: $!";
183              
184 7 100       46 return wantarray ? @list : \@list;
185             }
186              
187             sub save {
188 3     3 1 333 my ( $self, $file ) = @_;
189 3         9 my $ident = ident($self);
190              
191 3         5 $file = $self->file($file);
192 3 50       9 if ( !defined $file ) {
193 0         0 croak q{todo file can't be found};
194             }
195              
196 3 50       182 open my $fh, '>', $file or croak "Couldn't open [$file]: $!";
197 3         5 foreach my $e ( @{ $list_of{$ident} } ) {
  3         10  
198 17 50       47 print {$fh} $e->text . "\n"
  17         39  
199             or croak "Couldn't print to [$file]: $!";
200             }
201 3 50       103 close $fh or croak "Couldn't close [$file]: $!";
202              
203 3         6 $loaded_of{$ident} = $file;
204              
205 3         15 return 1;
206             }
207              
208             sub list {
209 48     48 1 646 my ($self) = @_;
210 48         72 my $ident = ident($self);
211              
212 48 50       90 return if !$list_of{$ident};
213 48 100       92 return wantarray ? @{ $list_of{$ident} } : $list_of{$ident};
  41         118  
214             }
215              
216             sub listpri {
217 1     1 1 5 my ( $self, $pri ) = @_;
218              
219 1         1 my @list;
220 1 50       3 if ($pri) {
221 1         2 $pri = uc $pri;
222 1 50       6 if ( $pri !~ /^[A-Z]$/xms ) {
223 0         0 croak 'PRIORITY must a single letter from A to Z.';
224             }
225 1 100       2 @list = grep { defined $_->priority && $_->priority eq $pri }
  6         12  
226             $self->list;
227             }
228             else {
229 0         0 @list = grep { $_->priority } $self->list;
  0         0  
230             }
231              
232 1 50       6 return wantarray ? @list : \@list;
233             }
234              
235             sub add {
236 14     14 1 4809 my ( $self, $entry ) = @_;
237 14         78 my $ident = ident($self);
238              
239 14 100       40 if ( !ref $entry ) {
    50          
240 8         41 $entry = Text::Todo::Entry->new(
241             { text => $entry,
242             tags => $known_tags_of{$ident},
243             }
244             );
245             }
246             elsif ( ref $entry ne 'Text::Todo::Entry' ) {
247 0         0 croak(
248             'entry is a ' . ref($entry) . ' not a Text::Todo::Entry!' );
249             }
250              
251 14         16 push @{ $list_of{$ident} }, $entry;
  14         32  
252              
253 14         26 $self->known_tags;
254              
255 14         40 return $entry;
256             }
257              
258             sub del {
259 3     3 1 4 my ( $self, $src ) = @_;
260 3         6 my $ident = ident($self);
261              
262 3         4 my $id = $self->_find_entry_id($src);
263              
264 3         5 my @list = $self->list;
265 3         6 my $entry = splice @list, $id, 1;
266 3         5 $list_of{$ident} = \@list;
267              
268 3         11 return $entry;
269             }
270              
271             sub move {
272 2     2 1 2 my ( $self, $entry, $dst ) = @_;
273 2         5 my $ident = ident($self);
274              
275 2         5 my $src = $self->_find_entry_id($entry);
276 2         4 my @list = $self->list;
277              
278 2         6 splice @list, $dst, 0, splice @list, $src, 1;
279              
280 2         3 $list_of{$ident} = \@list;
281              
282 2         8 return 1;
283             }
284              
285             sub listproj {
286 2     2 1 3 my ($self) = @_;
287 2         4 return $self->listtag('project');
288             }
289              
290             sub listcon {
291 1     1 1 2 my ($self) = @_;
292 1         3 return $self->listtag('context');
293             }
294              
295             sub listtag {
296 3     3 1 3 my ( $self, $tag ) = @_;
297 3         7 my $ident = ident($self);
298              
299 3         5 my $accessor = $tag . 's';
300              
301 3         3 my %available;
302 3         4 foreach my $e ( $self->list ) {
303 16         31 foreach my $p ( $e->$accessor ) {
304 7         22 $available{$p} = 1;
305             }
306             }
307              
308 3         13 my @tags = sort keys %available;
309              
310 3 50       21 return wantarray ? @tags : \@tags;
311             }
312              
313             sub learn_tag {
314 1     1 1 2 my ( $self, $tag, $sigal ) = @_;
315              
316 1         6 $known_tags_of{ ident $self}{$tag} = $sigal;
317 1         2 $self->known_tags;
318              
319 1         3 return 1;
320             }
321              
322             sub known_tags {
323 23     23 1 25 my ($self) = @_;
324 23         34 my $ident = ident($self);
325              
326 23         39 my @list = $self->list;
327 23         22 my %tags = %{ $known_tags_of{$ident} };
  23         67  
328              
329 23         37 foreach my $e (@list) {
330 108         168 my $kt = $e->known_tags;
331 108         75 foreach my $t ( keys %{$kt} ) {
  108         144  
332 222 50       399 if ( !exists $tags{$t} ) {
333 0         0 $tags{$t} = $kt->{$t};
334             }
335             }
336             }
337              
338 23         26 foreach my $e (@list) {
339 108         166 my $kt = $e->known_tags;
340 108         138 foreach my $t ( keys %tags ) {
341 231 100 66     793 if ( !exists $kt->{$t} || $tags{$t} ne $kt->{$t} ) {
342 9         60 $e->learn_tag( $t, $tags{$t} );
343             }
344             }
345             }
346              
347 23         36 $known_tags_of{$ident} = \%tags;
348              
349 23         63 return $known_tags_of{$ident};
350             }
351              
352             sub archive {
353 1     1 1 2 my ($self) = @_;
354 1         4 my $ident = ident($self);
355              
356 1 50 33     8 if ( !defined $loaded_of{$ident}
357             || $loaded_of{$ident} ne $self->file('todo_file') )
358             {
359 0         0 carp 'todo_file not loaded';
360 0         0 return;
361             }
362              
363 1         2 my $changed = 0;
364 1         3 ENTRY: foreach my $e ( $self->list ) {
365 5 100       12 if ( $e->done ) {
    100          
366 1 50 33     3 if ( $self->addto( 'done_file', $e ) && $self->del($e) ) {
367 1         2 $changed++;
368             }
369             else {
370 0         0 carp q{Couldn't archive entry [} . $e->text . ']';
371 0         0 last ENTRY;
372             }
373             }
374             elsif ( $e->text eq q{} ) {
375 1 50       2 if ( $self->del($e) ) {
376 1         3 $changed++;
377             }
378             else {
379 0         0 carp q{Couldn't delete blank entry};
380 0         0 last ENTRY;
381             }
382             }
383             }
384              
385 1 50       3 if ($changed) {
386 1         3 $self->save;
387             }
388              
389 1         5 return $changed;
390             }
391              
392             sub addto {
393 2     2 1 3 my ( $self, $file, $entry ) = @_;
394 2         6 my $ident = ident($self);
395              
396 2         3 $file = $self->file($file);
397 2 50       9 if ( !defined $file ) {
398 0         0 croak q{file can't be found};
399             }
400              
401 2 100       5 if ( ref $entry ) {
402 1 50       3 if ( ref $entry eq 'Text::Todo::Entry' ) {
403 1         3 $entry = $entry->text;
404             }
405             else {
406 0         0 carp 'Unknown ref [' . ref($entry) . ']';
407 0         0 return;
408             }
409             }
410              
411 2 50       108 open my $fh, '>>', $file or croak "Couldn't open [$file]: $!";
412 2 50       3 print {$fh} $entry, "\n"
  2         14  
413             or croak "Couldn't print to [$file]: $!";
414 2 50       78 close $fh or croak "Couldn't close [$file]: $!";
415              
416 2 100 66     13 if ( defined $loaded_of{$ident} && $file eq $loaded_of{$ident} ) {
417 1         4 return $self->load($file);
418             }
419              
420 1         8 return 1;
421             }
422              
423             sub _find_entry_id {
424 5     5   7 my ( $self, $entry ) = @_;
425 5         7 my $ident = ident($self);
426              
427 5 100       17 if ( ref $entry ) {
    50          
428 4 50       11 if ( ref $entry ne 'Text::Todo::Entry' ) {
429 0         0 croak( 'entry is a '
430             . ref($entry)
431             . ' not a Text::Todo::Entry!' );
432             }
433              
434 4         6 my @list = $self->list;
435 4         10 foreach my $id ( 0 .. $#list ) {
436 14 100       33 if ( $list[$id] eq $entry ) {
437 4         10 return $id;
438             }
439             }
440             }
441             elsif ( $entry =~ /^\d+$/xms ) {
442 1         2 return $entry;
443             }
444              
445 0         0 croak "Invalid entry [$entry]!";
446             }
447              
448             sub DESTROY {
449 5     5   1198 my ($self) = @_;
450 5         15 my $ident = ident $self;
451              
452 5         10 foreach my $attr_ref (@attr_refs) {
453 20         62 delete $attr_ref->{$ident};
454             }
455              
456 5         64 return;
457             }
458             }
459              
460             1; # Magic true value required at end of module
461             __END__