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