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