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