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