Annotation of todotxt/Text-Todo/lib/Text/Todo/Entry.pm, Revision 1.21
1.1 andrew 1: package Text::Todo::Entry;
2:
1.21 ! andrew 3: # $AFresh1: Entry.pm,v 1.20 2010/01/12 20:09:02 andrew Exp $
1.1 andrew 4:
5: use warnings;
6: use strict;
7: use Carp;
8:
1.21 ! andrew 9: use Class::Std;
1.1 andrew 10: use List::Util qw/ first /;
11:
12: use version; our $VERSION = qv('0.0.1');
13:
14: {
1.21 ! andrew 15: my ( %text_of, %tags_of, %priority_of, %completion_status_of,
! 16: %known_tags_of, ) : ATTR;
1.3 andrew 17:
1.8 andrew 18: # XXX Should the completion (x) be case sensitive?
1.14 andrew 19: my $priority_completion_regex = qr{
1.8 andrew 20: ^ \s*
1.17 andrew 21: (?i:(x \s* [\d-]* ) \s*)?
22: (?i:\( ([A-Z]) \) \s*)?
1.14 andrew 23: }xms;
1.8 andrew 24:
1.21 ! andrew 25: sub BUILD {
! 26: my ( $self, $ident, $options ) = @_;
1.1 andrew 27:
1.13 andrew 28: if ( !ref $options ) {
29: $options = { text => $options };
30: }
31: elsif ( ref $options ne 'HASH' ) {
32: croak 'Invalid parameter passed!';
33: }
34:
35: $known_tags_of{$ident} = {
36: context => q{@},
37: project => q{+},
38: };
39:
40: if ( exists $options->{tags} && ref $options->{tags} eq 'HASH' ) {
41: foreach my $k ( keys %{ $options->{tags} } ) {
42: $known_tags_of{$ident}{$k} = $options->{tags}->{$k};
43: }
44: }
45:
46: for my $tag ( keys %{ $known_tags_of{$ident} } ) {
47: ## no critic strict
48: no strict
49: 'refs'; # Violates use strict, but allows code generation
50: ## use critic
51:
52: if ( !$self->can( $tag . 's' ) ) {
53: *{ $tag . 's' } = sub {
54: my ($self) = @_;
55: return $self->_tags($tag);
56: };
57: }
58:
59: if ( !$self->can( 'in_' . $tag ) ) {
60: *{ 'in_' . $tag } = sub {
61: my ( $self, $item ) = @_;
62: return $self->_is_in( $tag . 's', $item );
63: };
64: }
65: }
66:
1.14 andrew 67: $self->replace( $options->{text} );
1.1 andrew 68:
69: return $self;
70: }
71:
1.14 andrew 72: sub replace {
1.1 andrew 73: my ( $self, $text ) = @_;
74: my $ident = ident($self);
75:
76: $text = defined $text ? $text : q{};
77:
78: $text_of{$ident} = $text;
79:
1.13 andrew 80: foreach my $tag ( keys %{ $known_tags_of{$ident} } ) {
81: my $symbol = quotemeta $known_tags_of{$ident}{$tag};
1.6 andrew 82: $tags_of{$ident}{$tag} = { map { $_ => q{} }
1.16 andrew 83: $text =~ / (?:^|\s) $symbol (\S*)/gxms };
1.3 andrew 84: }
1.17 andrew 85: my ( $completed, $priority )
1.8 andrew 86: = $text =~ / $priority_completion_regex /xms;
1.1 andrew 87:
1.17 andrew 88: $completion_status_of{$ident} = _clean_completed($completed);
1.18 andrew 89: $priority_of{$ident} = $priority;
1.17 andrew 90:
1.1 andrew 91: return 1;
92: }
93:
1.17 andrew 94: sub _clean_completed {
95: my ($completed) = @_;
96:
97: $completed ||= q{};
98: $completed =~ s/^\s+|\s+$//gxms;
99:
1.18 andrew 100: if ( !$completed ) {
1.17 andrew 101: return;
102: }
103:
1.18 andrew 104: if ( $completed =~ s/(x)\s*//ixms ) {
1.17 andrew 105: my $status = $1;
106: if ($completed) {
107: return $completed;
108: }
109: else {
110: return $status;
111: }
112: }
113:
114: return;
115: }
116:
1.3 andrew 117: sub _tags {
118: my ( $self, $tag ) = @_;
1.1 andrew 119: my $ident = ident($self);
120:
1.3 andrew 121: my @tags = sort keys %{ $tags_of{$ident}{$tag} };
122: return wantarray ? @tags : \@tags;
1.1 andrew 123: }
124:
1.3 andrew 125: sub _is_in {
1.5 andrew 126: my ( $self, $tags, $item ) = @_;
127: return defined first { $_ eq $item } $self->$tags;
1.1 andrew 128: }
129:
1.3 andrew 130: sub text {
1.1 andrew 131: my ($self) = @_;
132: my $ident = ident($self);
133:
1.3 andrew 134: return $text_of{$ident};
1.1 andrew 135: }
136:
1.14 andrew 137: sub depri { my ($self) = @_; return $self->pri(q{}) }
1.11 andrew 138:
139: sub pri {
1.8 andrew 140: my ( $self, $new_pri ) = @_;
141: my $ident = ident($self);
142:
143: if ( $new_pri !~ /^[a-zA-Z]?$/xms ) {
144: croak "Invalid priority [$new_pri]";
145: }
146:
147: $priority_of{$ident} = $new_pri;
148:
149: return $self->prepend();
150: }
151:
1.1 andrew 152: sub priority {
1.8 andrew 153: my ( $self, $new_pri ) = @_;
1.1 andrew 154: my $ident = ident($self);
155:
156: return $priority_of{$ident};
157: }
158:
159: sub prepend {
160: my ( $self, $addition ) = @_;
161:
162: my $new = $self->text;
1.8 andrew 163: my @new;
164:
165: $new =~ s/$priority_completion_regex//xms;
1.1 andrew 166:
1.10 andrew 167: if ( $self->done ) {
1.20 andrew 168: if ( $self->done !~ /^x/ixms ) {
1.18 andrew 169: push @new, 'x';
170: }
1.9 andrew 171: push @new, $self->done;
1.1 andrew 172: }
1.8 andrew 173:
174: if ( $self->priority ) {
175: push @new, '(' . $self->priority . ')';
176: }
177:
178: if ( defined $addition && length $addition ) {
179: push @new, $addition;
1.1 andrew 180: }
181:
1.14 andrew 182: return $self->replace( join q{ }, @new, $new );
1.1 andrew 183: }
184:
185: sub append {
186: my ( $self, $addition ) = @_;
1.14 andrew 187: return $self->replace( join q{ }, $self->text, $addition );
1.1 andrew 188: }
189:
1.14 andrew 190: ## no critic 'homonym'
191: sub do { # This is what it is called in todo.sh
192: ## use critic
1.7 andrew 193: my ($self) = @_;
1.8 andrew 194: my $ident = ident($self);
1.7 andrew 195:
1.10 andrew 196: if ( $self->done ) {
1.7 andrew 197: return 1;
198: }
199:
1.18 andrew 200: $completion_status_of{$ident} = sprintf "%04d-%02d-%02d",
201: ( (localtime)[5] + 1900 ),
202: ( (localtime)[4] + 1 ),
203: ( (localtime)[3] );
1.8 andrew 204:
205: return $self->prepend();
1.7 andrew 206: }
207:
1.9 andrew 208: sub done {
209: my ($self) = @_;
210: my $ident = ident($self);
211:
212: return $completion_status_of{$ident};
213: }
214:
1.1 andrew 215: }
216: 1; # Magic true value required at end of module
217: __END__
218:
219: =head1 NAME
220:
1.12 andrew 221: Text::Todo::Entry - An object for manipulating an entry on a Text::Todo list
1.1 andrew 222:
223:
224: =head1 VERSION
225:
1.12 andrew 226: Since the $VERSION can't be automatically included,
227: here is the RCS Id instead, you'll have to look up $VERSION.
228:
1.21 ! andrew 229: $Id: Entry.pm,v 1.20 2010/01/12 20:09:02 andrew Exp $
1.1 andrew 230:
231:
232: =head1 SYNOPSIS
233:
234: use Text::Todo::Entry;
235:
1.12 andrew 236: my $entry = Text::Todo::Entry->new('text of entry');
237:
238: $entry->append('+project');
239:
240: if ($entry->in_project('project') && ! $entry->priority) {
241: print $entry->text, "\n";
242: }
243:
244:
1.1 andrew 245: =head1 DESCRIPTION
246:
1.12 andrew 247: This module creates entries in a Text::Todo list.
248: It allows you to retrieve information about them and modify them.
249:
250: For more information see L<http://todotxt.com>
1.1 andrew 251:
252:
253: =head1 INTERFACE
254:
1.21 ! andrew 255: =head2 BUILD
1.12 andrew 256:
257: Creates an entry that can be manipulated.
1.1 andrew 258:
1.13 andrew 259: my $entry = Text::Todo::Entry->new([
260: 'text of entry' | {
261: [ text => 'text of entry' ,]
262: [ tags => { additional_arg => 'identfier' }, ]
263: } ]);
1.12 andrew 264:
265: If you don't pass any text, creates a blank entry.
1.1 andrew 266:
1.13 andrew 267: See tags below for a description of additional tags.
268:
1.1 andrew 269: =head2 text
270:
1.12 andrew 271: Returns the text of the entry.
272:
273: print $entry->text, "\n";
274:
275: =head2 pri
276:
277: Sets the priority of an entry. If the priority is set to an empty string,
278: clears the priority.
279:
280: $entry->pri('B');
281:
282: Acceptible entries are an empty string, A-Z or a-z. Anything else will cause
283: an error.
284:
285: =head2 depri
286:
287: A convenience function that unsets priority by calling pri('').
288:
289: $entry->depri;
290:
1.1 andrew 291: =head2 priority
292:
1.12 andrew 293: Returns the priority of an entry which may be an empty string if it is
1.1 andrew 294:
1.12 andrew 295: my $priority = $entry->priority;
1.1 andrew 296:
1.12 andrew 297: =head2 tags
1.1 andrew 298:
1.12 andrew 299: Each tag type generates two accessor functions {tag}s and in_{tag}.
1.1 andrew 300:
1.12 andrew 301: Current tags are context (@) and project (+).
1.13 andrew 302:
303: When creating a new object you can pass in new tags to recognize.
304:
305: my $entry = Text::Todo::Entry->new({
306: text => 'do something DUE:2011-01-01',
307: tags => { due_date => 'DUE:' }
308: });
309:
310: my @due_dates = $entry->due_dates;
311:
312: then @due_dates eq ( '2011-01-01' );
313:
314: and you could also:
315:
316: if ($entry->in_due_date('2011-01-01')) {
317: # do something
318: }
319:
1.12 andrew 320:
321: =over
1.1 andrew 322:
1.12 andrew 323: =item {tag}s
1.1 andrew 324:
1.12 andrew 325: @tags = $entry->{tag}s;
1.7 andrew 326:
1.12 andrew 327: =item in_{tag}
1.7 andrew 328:
1.12 andrew 329: returns true if $entry is in the tag, false if not.
1.1 andrew 330:
1.12 andrew 331: if ($entry->in_{tag}('tag')) {
332: # do something
333: }
1.10 andrew 334:
1.12 andrew 335: =back
1.1 andrew 336:
1.12 andrew 337: =head3 context
1.1 andrew 338:
1.12 andrew 339: These are matched as a word beginning with @.
1.1 andrew 340:
341: =over
342:
1.12 andrew 343: =item contexts
1.1 andrew 344:
1.12 andrew 345: =item in_context
1.1 andrew 346:
1.12 andrew 347: =back
348:
349: =head3 project
350:
351: This is matched as a word beginning with +.
352:
353: =over
1.1 andrew 354:
1.12 andrew 355: =item projects
1.1 andrew 356:
1.12 andrew 357: =item in_project
1.1 andrew 358:
359: =back
360:
1.12 andrew 361: =head2 replace
362:
363: Replaces the text of an entry with completely new text. Useful if there has
364: been manual modification of the entry or just a new direction.
365:
366: $entry->replace('replacment text');
367:
368: =head2 prepend
369:
370: Attaches text (with a trailing space) to the beginning of an entry. Puts it
371: after the done() "x" and the priority() letter.
372:
373: $entry->prepend('NEED HELP');
374:
375: =head2 append
376:
377: Adds text to the end of an entry.
378: Useful for adding tags, or just additional information.
379:
380: $entry->append('@specific_store');
381:
382: =head2 do
383:
384: Marks an entry as completed.
385:
386: $entry->do;
387:
1.18 andrew 388: Does this by prepending "x `date '%Y-%m-%d'`" to the beginning of the entry.
1.12 andrew 389:
390: =head2 done
391:
392: Returns true if an entry is marked complete and false if not.
1.18 andrew 393:
394: if (!my $status = $entry->done) {
1.12 andrew 395: # remind me to do it
396: }
397:
1.18 andrew 398: If the entry starts as 'x date', for example 'x 2010-01-01', $status is now
399: '2010-01-01'.
400: If the entry just starts with 'x', then $status will be 'x'.
1.12 andrew 401:
402: =head1 DIAGNOSTICS
1.1 andrew 403:
404: =head1 CONFIGURATION AND ENVIRONMENT
405:
406: Text::Todo::Entry requires no configuration files or environment variables.
407:
408:
1.12 andrew 409: =head1 DEPENDENCIES
1.1 andrew 410:
1.12 andrew 411: Class::Std::Utils
412: List::Util
413: version
1.1 andrew 414:
415:
416: =head1 INCOMPATIBILITIES
417:
418: None reported.
419:
420:
421: =head1 BUGS AND LIMITATIONS
422:
1.12 andrew 423: No bugs have been reported.
424:
425: Known limitations:
1.1 andrew 426:
1.12 andrew 427: Sometimes leading whitespace may get screwed up when making changes. It
428: doesn't seem to be particularly a problem, but if you use whitespace to indent
429: entries for some reason it could be.
1.1 andrew 430:
431: Please report any bugs or feature requests to
432: C<bug-text-todo@rt.cpan.org>, or through the web interface at
433: L<http://rt.cpan.org>.
434:
435:
436: =head1 AUTHOR
437:
438: Andrew Fresh C<< <andrew@cpan.org> >>
439:
440:
441: =head1 LICENSE AND COPYRIGHT
442:
443: Copyright (c) 2009, Andrew Fresh C<< <andrew@cpan.org> >>. All rights reserved.
444:
445: This module is free software; you can redistribute it and/or
446: modify it under the same terms as Perl itself. See L<perlartistic>.
447:
448:
449: =head1 DISCLAIMER OF WARRANTY
450:
451: BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
452: FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
453: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
454: PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
455: EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
456: WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
457: ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
458: YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
459: NECESSARY SERVICING, REPAIR, OR CORRECTION.
460:
461: IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
462: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
463: REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
464: LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
465: OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
466: THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
467: RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
468: FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
469: SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
470: SUCH DAMAGES.
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>