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