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   87105 use warnings;
  3         5  
  3         124  
6 3     3   12 use strict;
  3         4  
  3         66  
7 3     3   11 use Carp;
  3         7  
  3         171  
8              
9 3     3   1328 use Class::Std::Utils;
  3         7110  
  3         14  
10 3     3   1348 use Text::Todo::Entry;
  3         6  
  3         89  
11 3     3   14 use File::Spec;
  3         10  
  3         58  
12              
13 3     3   9 use version; our $VERSION = qv('0.2.1');
  3         3  
  3         11  
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 1644 my ( $class, $options ) = @_;
27              
28 5         19 my $self = bless anon_scalar(), $class;
29 5         29 my $ident = ident($self);
30              
31 5         33 $path_of{$ident} = {
32             todo_dir => undef,
33             todo_file => 'todo.txt',
34             done_file => undef,
35             };
36              
37 5         16 my %tags = (
38             context => q{@},
39             project => q{+},
40             );
41              
42 5 100       15 if ($options) {
43 2 50       8 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       46 if ( -d $options ) {
    50          
61 0         0 $self->_path_to( 'todo_dir', $options );
62             }
63             elsif ( $options =~ /\.txt$/ixms ) {
64 2         7 $self->_path_to( 'todo_file', $options );
65             }
66             else {
67 0         0 carp "Unknown options [$options]";
68             }
69             }
70             }
71              
72 5         14 $known_tags_of{$ident} = \%tags;
73              
74 5         26 my $file = $self->_path_to('todo_file');
75 5 100 66     41 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   48 my ( $self, $type, $path ) = @_;
84 36         77 my $ident = ident($self);
85              
86 36 50       98 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       62 if ($path) {
94 14         171 my ( $volume, $directories, $file )
95             = File::Spec->splitpath($path);
96 14         36 $path_of{$ident}{$type} = $file;
97              
98 14 50       24 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       31 if ($directories) {
105 14         27 $path_of{$ident}{todo_dir} = $directories;
106             }
107             }
108              
109 36 50       166 if ( $type =~ /(todo|done|report)_file/xms ) {
110 36 100       606 if ( my ( $pre, $post )
111             = $path_of{$ident}{$type} =~ /^(.*)$1(.*)\.txt$/ixms )
112             {
113 32         46 foreach my $f (qw( todo done report )) {
114 96 100       239 if ( !defined $path_of{$ident}{ $f . '_file' } ) {
115 10         31 $path_of{$ident}{ $f . '_file' }
116             = $pre . $f . $post . '.txt';
117             }
118             }
119             }
120             }
121              
122 36 100       76 if ( defined $path_of{$ident}{todo_dir} ) {
123 32         310 return File::Spec->catfile( $path_of{$ident}{todo_dir},
124             $path_of{$ident}{$type} );
125             }
126              
127 4         10 return;
128             }
129              
130             sub file {
131 29     29 1 1045 my ( $self, $file ) = @_;
132 29         53 my $ident = ident($self);
133              
134 29 100 100     142 if ( defined $file && exists $path_of{$ident}{$file} ) {
135 11         21 $file = $self->_path_to($file);
136             }
137             else {
138 18         31 $file = $self->_path_to( 'todo_file', $file );
139             }
140              
141 29         105 return $file;
142             }
143              
144             sub load {
145 6     6 1 799 my ( $self, $file ) = @_;
146 6         56 my $ident = ident($self);
147              
148 6         13 $loaded_of{$ident} = undef;
149              
150 6         15 $file = $self->file($file);
151              
152 6 50       15 if ( $list_of{$ident} = $self->listfile($file) ) {
153 6         17 $self->known_tags;
154 6         9 $loaded_of{$ident} = $file;
155 6         30 return 1;
156             }
157              
158 0         0 return;
159             }
160              
161             sub listfile {
162 7     7 1 13 my ( $self, $file ) = @_;
163              
164 7         13 $file = $self->file($file);
165              
166 7 50       18 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         9 my @list;
177 7 50       187 open my $fh, '<', $file or croak "Couldn't open [$file]: $!";
178 7         90 while (<$fh>) {
179 35         182 s/\r?\n$//xms;
180 35         117 push @list, Text::Todo::Entry->new($_);
181             }
182 7 50       58 close $fh or croak "Couldn't close [$file]: $!";
183              
184 7 100       50 return wantarray ? @list : \@list;
185             }
186              
187             sub save {
188 3     3 1 1303 my ( $self, $file ) = @_;
189 3         9 my $ident = ident($self);
190              
191 3         7 $file = $self->file($file);
192 3 50       10 if ( !defined $file ) {
193 0         0 croak q{todo file can't be found};
194             }
195              
196 3 50       235 open my $fh, '>', $file or croak "Couldn't open [$file]: $!";
197 3         7 foreach my $e ( @{ $list_of{$ident} } ) {
  3         13  
198 17 50       42 print {$fh} $e->text . "\n"
  17         48  
199             or croak "Couldn't print to [$file]: $!";
200             }
201 3 50       109 close $fh or croak "Couldn't close [$file]: $!";
202              
203 3         7 $loaded_of{$ident} = $file;
204              
205 3         15 return 1;
206             }
207              
208             sub list {
209 48     48 1 384 my ($self) = @_;
210 48         90 my $ident = ident($self);
211              
212 48 50       114 return if !$list_of{$ident};
213 48 100       110 return wantarray ? @{ $list_of{$ident} } : $list_of{$ident};
  41         145  
214             }
215              
216             sub listpri {
217 1     1 1 10 my ( $self, $pri ) = @_;
218              
219 1         3 my @list;
220 1 50       6 if ($pri) {
221 1         4 $pri = uc $pri;
222 1 50       11 if ( $pri !~ /^[A-Z]$/xms ) {
223 0         0 croak 'PRIORITY must a single letter from A to Z.';
224             }
225 1 100       6 @list = grep { defined $_->priority && $_->priority eq $pri }
  6         21  
226             $self->list;
227             }
228             else {
229 0         0 @list = grep { $_->priority } $self->list;
  0         0  
230             }
231              
232 1 50       9 return wantarray ? @list : \@list;
233             }
234              
235             sub add {
236 14     14 1 3036 my ( $self, $entry ) = @_;
237 14         33 my $ident = ident($self);
238              
239 14 100       35 if ( !ref $entry ) {
    50          
240 8         40 $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         17 push @{ $list_of{$ident} }, $entry;
  14         30  
252              
253 14         23 $self->known_tags;
254              
255 14         41 return $entry;
256             }
257              
258             sub del {
259 3     3 1 5 my ( $self, $src ) = @_;
260 3         8 my $ident = ident($self);
261              
262 3         9 my $id = $self->_find_entry_id($src);
263              
264 3         6 my @list = $self->list;
265 3         9 my $entry = splice @list, $id, 1;
266 3         8 $list_of{$ident} = \@list;
267              
268 3         14 return $entry;
269             }
270              
271             sub move {
272 2     2 1 4 my ( $self, $entry, $dst ) = @_;
273 2         7 my $ident = ident($self);
274              
275 2         7 my $src = $self->_find_entry_id($entry);
276 2         8 my @list = $self->list;
277              
278 2         7 splice @list, $dst, 0, splice @list, $src, 1;
279              
280 2         7 $list_of{$ident} = \@list;
281              
282 2         12 return 1;
283             }
284              
285             sub listproj {
286 2     2 1 186 my ($self) = @_;
287 2         23 return $self->listtag('project');
288             }
289              
290             sub listcon {
291 1     1 1 4 my ($self) = @_;
292 1         4 return $self->listtag('context');
293             }
294              
295             sub listtag {
296 3     3 1 8 my ( $self, $tag ) = @_;
297 3         11 my $ident = ident($self);
298              
299 3         12 my $accessor = $tag . 's';
300              
301 3         9 my %available;
302 3         9 foreach my $e ( $self->list ) {
303 16         55 foreach my $p ( $e->$accessor ) {
304 7         21 $available{$p} = 1;
305             }
306             }
307              
308 3         15 my @tags = sort keys %available;
309              
310 3 50       32 return wantarray ? @tags : \@tags;
311             }
312              
313             sub learn_tag {
314 1     1 1 3 my ( $self, $tag, $sigal ) = @_;
315              
316 1         7 $known_tags_of{ ident $self}{$tag} = $sigal;
317 1         2 $self->known_tags;
318              
319 1         7 return 1;
320             }
321              
322             sub known_tags {
323 23     23 1 25 my ($self) = @_;
324 23         47 my $ident = ident($self);
325              
326 23         32 my @list = $self->list;
327 23         29 my %tags = %{ $known_tags_of{$ident} };
  23         78  
328              
329 23         42 foreach my $e (@list) {
330 108         197 my $kt = $e->known_tags;
331 108         87 foreach my $t ( keys %{$kt} ) {
  108         161  
332 222 50       435 if ( !exists $tags{$t} ) {
333 0         0 $tags{$t} = $kt->{$t};
334             }
335             }
336             }
337              
338 23         28 foreach my $e (@list) {
339 108         177 my $kt = $e->known_tags;
340 108         146 foreach my $t ( keys %tags ) {
341 231 100 66     850 if ( !exists $kt->{$t} || $tags{$t} ne $kt->{$t} ) {
342 9         25 $e->learn_tag( $t, $tags{$t} );
343             }
344             }
345             }
346              
347 23         36 $known_tags_of{$ident} = \%tags;
348              
349 23         71 return $known_tags_of{$ident};
350             }
351              
352             sub archive {
353 1     1 1 3 my ($self) = @_;
354 1         6 my $ident = ident($self);
355              
356 1 50 33     11 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       16 if ( $e->done ) {
    100          
366 1 50 33     21 if ( $self->addto( 'done_file', $e ) && $self->del($e) ) {
367 1         3 $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       3 if ( $self->del($e) ) {
376 1         4 $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       4 if ($changed) {
386 1         3 $self->save;
387             }
388              
389 1         5 return $changed;
390             }
391              
392             sub addto {
393 2     2 1 6 my ( $self, $file, $entry ) = @_;
394 2         8 my $ident = ident($self);
395              
396 2         7 $file = $self->file($file);
397 2 50       12 if ( !defined $file ) {
398 0         0 croak q{file can't be found};
399             }
400              
401 2 100       6 if ( ref $entry ) {
402 1 50       4 if ( ref $entry eq 'Text::Todo::Entry' ) {
403 1         4 $entry = $entry->text;
404             }
405             else {
406 0         0 carp 'Unknown ref [' . ref($entry) . ']';
407 0         0 return;
408             }
409             }
410              
411 2 50       182 open my $fh, '>>', $file or croak "Couldn't open [$file]: $!";
412 2 50       4 print {$fh} $entry, "\n"
  2         19  
413             or croak "Couldn't print to [$file]: $!";
414 2 50       91 close $fh or croak "Couldn't close [$file]: $!";
415              
416 2 100 66     16 if ( defined $loaded_of{$ident} && $file eq $loaded_of{$ident} ) {
417 1         4 return $self->load($file);
418             }
419              
420 1         9 return 1;
421             }
422              
423             sub _find_entry_id {
424 5     5   8 my ( $self, $entry ) = @_;
425 5         10 my $ident = ident($self);
426              
427 5 100       23 if ( ref $entry ) {
    50          
428 4 50       16 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         12 my @list = $self->list;
435 4         13 foreach my $id ( 0 .. $#list ) {
436 14 100       49 if ( $list[$id] eq $entry ) {
437 4         16 return $id;
438             }
439             }
440             }
441             elsif ( $entry =~ /^\d+$/xms ) {
442 1         4 return $entry;
443             }
444              
445 0         0 croak "Invalid entry [$entry]!";
446             }
447              
448             sub DESTROY {
449 5     5   984 my ($self) = @_;
450 5         21 my $ident = ident $self;
451              
452 5         10 foreach my $attr_ref (@attr_refs) {
453 20         68 delete $attr_ref->{$ident};
454             }
455              
456 5         53 return;
457             }
458             }
459              
460             1; # Magic true value required at end of module
461             __END__