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